module Evdev (
pattern SyncEvent,
pattern KeyEvent,
pattern RelativeEvent,
pattern AbsoluteEvent,
pattern MiscEvent,
pattern SwitchEvent,
pattern LEDEvent,
pattern SoundEvent,
pattern RepeatEvent,
pattern ForceFeedbackEvent,
pattern PowerEvent,
pattern ForceFeedbackStatusEvent,
prettyEvent,
defaultReadFlags,
grabDevice,
ungrabDevice,
nextEvent,
newDevice,
evdevDir,
deviceName,
deviceFd,
devicePath,
deviceProperties,
Device,
Event,
EventCode(..),
EventValue(..),
KeyEventType(..),
ReadFlags (..),
) where
import Control.Arrow (second)
import Control.Monad (filterM)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Int (Int16,Int32)
import Data.List.Extra (enumerate)
import Data.Set (Set)
import Data.Time.Clock (DiffTime)
import Foreign ((.|.))
import Foreign.C (CUInt)
import Foreign.C.Error (Errno(Errno),errnoToIOError)
import Safe (initSafe,tailSafe)
import System.Posix.ByteString (Fd,RawFilePath)
import System.Posix.IO.ByteString (fdToHandle)
import qualified Evdev.LowLevel as LL
import Evdev.LowLevel (ReadFlags(..))
import Evdev.Codes
data Device = Device { cDevice :: LL.Device, devicePath :: RawFilePath }
instance Show Device where
show = show . devicePath
data Event = Event {
evType :: EventType,
evCode :: EventCode,
evValue :: EventValue,
evTime :: DiffTime}
deriving (Eq, Ord, Show)
prettyEvent :: Event -> String
prettyEvent x = showTime (evTime x) ++ ":" ++ " " ++ case x of
SyncEvent t -> show t
KeyEvent k t -> unwords [show k, show t]
RelativeEvent c v -> unwords [show c, showE v]
AbsoluteEvent c v -> unwords [show c, showE v]
MiscEvent c v -> unwords [show c, showE v]
SwitchEvent c v -> unwords [show c, showE v]
LEDEvent c v -> unwords [show c, showE v]
SoundEvent c v -> unwords [show c, showE v]
RepeatEvent c v -> unwords [show c, showE v]
ForceFeedbackEvent c v -> unwords [showE c, showE v]
PowerEvent c v -> unwords [showE c, showE v]
ForceFeedbackStatusEvent c v -> unwords [showE c, showE v]
_ -> error $ "show: unrecognised Event: " ++ unwords
[showE $ evType x, showE $ evCode x, showE $ evValue x]
where
showE :: Enum x => x -> String
showE = show . fromEnum
showTime t =
let (n,r) = second tailSafe $ span (/= '.') $ initSafe $ show t
in n ++ "." ++ take 6 (r ++ ['0'..]) ++ "s"
pattern SyncEvent :: SyncEventType -> Event
pattern SyncEvent c <- Event EvSyn (convertEnum -> c) _ _
pattern KeyEvent :: Key -> KeyEventType -> Event
pattern KeyEvent c v <- Event EvKey (convertEnum -> c) (convertEnum -> v) _
pattern RelativeEvent :: RelativeAxis -> EventValue -> Event
pattern RelativeEvent c v <- Event EvRel (convertEnum -> c) v _
pattern AbsoluteEvent :: AbsoluteAxis -> EventValue -> Event
pattern AbsoluteEvent c v <- Event EvAbs (convertEnum -> c) v _
pattern MiscEvent :: MiscEventType -> EventValue -> Event
pattern MiscEvent c v <- Event EvMsc (convertEnum -> c) v _
pattern SwitchEvent :: SwitchEventType -> EventValue -> Event
pattern SwitchEvent c v <- Event EvSw (convertEnum -> c) v _
pattern LEDEvent :: LEDEventType -> EventValue -> Event
pattern LEDEvent c v <- Event EvLed (convertEnum -> c) v _
pattern SoundEvent :: SoundEventType -> EventValue -> Event
pattern SoundEvent c v <- Event EvSnd (convertEnum -> c) v _
pattern RepeatEvent :: RepeatEventType -> EventValue -> Event
pattern RepeatEvent c v <- Event EvRep (convertEnum -> c) v _
pattern ForceFeedbackEvent :: EventCode -> EventValue -> Event
pattern ForceFeedbackEvent c v <- Event EvFf c v _
pattern PowerEvent :: EventCode -> EventValue -> Event
pattern PowerEvent c v <- Event EvPwr c v _
pattern ForceFeedbackStatusEvent :: EventCode -> EventValue -> Event
pattern ForceFeedbackStatusEvent c v <- Event EvFfStatus c v _
newtype EventCode = EventCode Int16 deriving (Enum, Eq, Ord, Read, Show)
newtype EventValue = EventValue Int32 deriving (Enum, Eq, Ord, Read, Show)
data KeyEventType
= Released
| Pressed
| Repeated
deriving (Enum, Eq, Ord, Read, Show)
convertFlags :: Set ReadFlags -> CUInt
convertFlags = fromIntegral . foldr ((.|.) . fromEnum) 0
defaultReadFlags :: Set ReadFlags
defaultReadFlags = [Normal,Blocking]
grabDevice :: Device -> IO ()
grabDevice = grabDevice' LL.LibevdevGrab
ungrabDevice :: Device -> IO ()
ungrabDevice = grabDevice' LL.LibevdevUngrab
nextEvent :: Device -> Set ReadFlags -> IO Event
nextEvent dev flags = do
(t,c,v,time) <- LL.convertEvent =<<
throwCErrors "nextEvent" (Right dev) (LL.nextEvent (cDevice dev) (convertFlags flags))
return $ Event (toEnum t) (EventCode c) (EventValue v) time
newDevice :: RawFilePath -> IO Device
newDevice path = do
dev <- throwCErrors "newDevice" (Left path) $ LL.newDevice path
return $ Device dev path
evdevDir :: RawFilePath
evdevDir = "/dev/input"
deviceName :: Device -> IO ByteString
deviceName = fmap BS.pack . LL.deviceName . cDevice
deviceFd :: Device -> IO Fd
deviceFd = LL.deviceFd . cDevice
deviceProperties :: Device -> IO [DeviceProperty]
deviceProperties dev = filterM (LL.hasProperty $ cDevice dev) enumerate
throwCErrors :: String -> Either ByteString Device -> IO (Errno, a) -> IO a
throwCErrors func pathOrDev x = do
(errno, res) <- x
case errno of
Errno 0 -> return res
Errno n -> do
(handle,path) <- case pathOrDev of
Left path -> return (Nothing,path)
Right dev -> do
h <- fdToHandle =<< deviceFd dev
return (Just h, devicePath dev)
ioError $ errnoToIOError func (Errno $ abs n) handle (Just $ BS.unpack path)
grabDevice' :: LL.GrabMode -> Device -> IO ()
grabDevice' mode dev = throwCErrors "grabDevice" (Right dev) $ LL.grabDevice (cDevice dev) mode
convertEnum :: (Enum a, Enum b) => a -> b
convertEnum = toEnum . fromEnum