content: {-# LANGUAGE CPP            #-}
  {-# LANGUAGE DeriveAnyClass #-}
  {-|
  Module      : KMonad.Keyboard.IO.Linux.DeviceSource
  Description : Load and acquire a linux /dev/input device
  Copyright   : (c) David Janssen, 2019
  License     : MIT
  Maintainer  : janssen.dhj@gmail.com
  Stability   : experimental
  Portability : portable
  
  -}
  module KMonad.Keyboard.IO.Linux.DeviceSource
    ( deviceSource
    , deviceSource64
  
    , KeyEventParser
    , decode64
    )
  where
  
  import KMonad.Prelude
  import Foreign.C.Types
  import System.Posix
  
  import KMonad.Keyboard.IO.Linux.Types
  import KMonad.Util
  
  import qualified Data.Serialize as B (decode)
  import qualified RIO.ByteString as B
  
  --------------------------------------------------------------------------------
  -- $err
  
  data DeviceSourceError
    = IOCtlGrabError    FilePath
    | IOCtlReleaseError FilePath
    | KeyIODecodeError  String
    deriving Exception
  
  instance Show DeviceSourceError where
    show (IOCtlGrabError pth)    = "Could not perform IOCTL grab on: "    <> pth
    show (IOCtlReleaseError pth) = "Could not perform IOCTL release on: " <> pth
    show (KeyIODecodeError msg)  = "KeyEvent decode failed with msg: "    <> msg
  
  makeClassyPrisms ''DeviceSourceError
  
  --------------------------------------------------------------------------------
  -- $ffi
  foreign import ccall "ioctl_keyboard"
    c_ioctl_keyboard :: CInt -> CInt -> IO CInt
  
  -- | Perform an IOCTL operation on an open keyboard handle
  ioctl_keyboard :: MonadIO m
    => Fd      -- ^ Descriptor to open keyboard file (like /dev/input/eventXX)
    -> Bool    -- ^ True to grab, False to ungrab
    -> m Int   -- ^ Return the exit code
  ioctl_keyboard (Fd h) b = fromIntegral <$>
    liftIO (c_ioctl_keyboard h (if b then 1 else 0))
  
  
  --------------------------------------------------------------------------------
  -- $decoding
  
  -- | A 'KeyEventParser' describes how to read and parse 'LinuxKeyEvent's from
  -- the binary data-stream provided by the device-file.
  data KeyEventParser = KeyEventParser
    { _nbytes :: !Int
      -- ^ Size of 1 input event in bytes
    , _prs    :: !(B.ByteString -> Either String LinuxKeyEvent)
      -- ^ Function to convert bytestring to event
    }
  makeClassy ''KeyEventParser
  
  -- | Default configuration for parsing keyboard events
  defEventParser :: KeyEventParser
  defEventParser = KeyEventParser 24 decode64
  
  -- | The KeyEventParser that works on my 64-bit Linux environment
  decode64 :: B.ByteString -> Either String LinuxKeyEvent
  decode64 bs = linuxKeyEvent . fliptup <$> result
    where
      result :: Either String (Int32, Word16, Word16, Word64, Word64)
      result = B.decode . B.reverse $ bs
  
      fliptup (a, b, c, d, e) = (e, d, c, b, a)
  
  
  --------------------------------------------------------------------------------
  -- $types
  
  -- | Configurable components of a DeviceSource
  data DeviceSourceCfg = DeviceSourceCfg
    { _pth     :: !FilePath        -- ^ Path to the event-file
    , _parser  :: !KeyEventParser  -- ^ The method used to decode events
    }
  makeClassy ''DeviceSourceCfg
  
  -- | Collection of data used to read from linux input.h event stream
  data DeviceFile = DeviceFile
    { _cfg :: !DeviceSourceCfg -- ^ Configuration settings
    , _fd  :: !Fd              -- ^ Posix filedescriptor to the device file
    , _hdl :: !Handle          -- ^ Haskell handle to the device file
    }
  makeClassy ''DeviceFile
  
  instance HasDeviceSourceCfg DeviceFile where deviceSourceCfg = cfg
  instance HasKeyEventParser  DeviceFile where keyEventParser  = cfg.parser
  
  -- | Open a device file
  deviceSource :: HasLogFunc e
    => KeyEventParser -- ^ The method by which to read and decode events
    -> FilePath    -- ^ The filepath to the device file
    -> RIO e (Acquire KeySource)
  deviceSource pr pt = mkKeySource (lsOpen pr pt) lsClose lsRead
  
  -- | Open a device file on a standard linux 64 bit architecture
  deviceSource64 :: HasLogFunc e
    => FilePath  -- ^ The filepath to the device file
    -> RIO e (Acquire KeySource)
  deviceSource64 = deviceSource defEventParser
  
  
  --------------------------------------------------------------------------------
  -- $io
  
  -- | Open the keyboard, perform an ioctl grab and return a 'DeviceFile'. This
  -- can throw an 'IOException' if the file cannot be opened for reading, or an
  -- 'IOCtlGrabError' if an ioctl grab could not be properly performed.
  lsOpen :: (HasLogFunc e)
    => KeyEventParser   -- ^ The method by which to decode events
    -> FilePath      -- ^ The path to the device file
    -> RIO e DeviceFile
  lsOpen pr pt = do
    h  <- liftIO $ openFd pt
      ReadOnly
  #if !MIN_VERSION_unix(2,8,0)
      Nothing
  #endif
      defaultFileFlags
    hd <- liftIO $ fdToHandle h
    logInfo "Initiating ioctl grab"
    ioctl_keyboard h True `onErr` IOCtlGrabError pt
    return $ DeviceFile (DeviceSourceCfg pt pr) h hd
  
  -- | Release the ioctl grab and close the device file. This can throw an
  -- 'IOException' if the handle to the device cannot be properly closed, or an
  -- 'IOCtlReleaseError' if the ioctl release could not be properly performed.
  lsClose :: (HasLogFunc e) => DeviceFile -> RIO e ()
  lsClose src = do
    logInfo "Releasing ioctl grab"
    ioctl_keyboard (src^.fd) False `onErr` IOCtlReleaseError (src^.pth)
    liftIO . closeFd $ src^.fd
  
  -- | Read a bytestring from an open filehandle and return a parsed event. This
  -- can throw a 'KeyIODecodeError' if reading from the 'DeviceFile' fails to
  -- yield a parseable sequence of bytes.
  lsRead :: (HasLogFunc e) => DeviceFile -> RIO e KeyEvent
  lsRead src = do
    bts <- B.hGet (src^.hdl) (src^.nbytes)
    case src^.prs $ bts of
      Right p -> case fromLinuxKeyEvent p of
        Just e  -> return e
        Nothing -> lsRead src
      Left s -> throwIO $ KeyIODecodeError s
  