{-# LINE 1 "src/Evdev/LowLevel.chs" #-}
{-# OPTIONS_HADDOCK hide, prune, ignore-exports #-}
module Evdev.LowLevel where
import qualified Foreign.C.String as C2HSImp
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.ForeignPtr as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp
import Control.Monad.Loops (iterateWhile)
import Data.Int (Int16,Int32)
import Data.Time.Clock (DiffTime,picosecondsToDiffTime)
import Foreign (Ptr)
import Foreign.C (CInt,CUInt,CLong)
import Foreign.C.Error (Errno(Errno))
import Foreign.ForeignPtr (mallocForeignPtrBytes,withForeignPtr)
import Foreign.Storable (peekByteOff)
import System.Posix.ByteString (RawFilePath)
import System.Posix.IO.ByteString (OpenMode(ReadOnly),defaultFileFlags,openFd)
import System.Posix.Types (Fd(Fd))
import Evdev.Codes
data ReadFlags = Sync
| Normal
| ForceSync
| Blocking
deriving (Eq,Ord,Show)
instance Enum ReadFlags where
succ Sync = Normal
succ Normal = ForceSync
succ ForceSync = Blocking
succ Blocking = error "ReadFlags.succ: Blocking has no successor"
pred Normal = Sync
pred ForceSync = Normal
pred Blocking = ForceSync
pred Sync = error "ReadFlags.pred: Sync has no predecessor"
enumFromTo from to = go from
where
end = fromEnum to
go v = case compare (fromEnum v) end of
LT -> v : go (succ v)
EQ -> [v]
GT -> []
enumFrom from = enumFromTo from Blocking
fromEnum Sync = 1
fromEnum Normal = 2
fromEnum ForceSync = 4
fromEnum Blocking = 8
toEnum 1 = Sync
toEnum 2 = Normal
toEnum 4 = ForceSync
toEnum 8 = Blocking
toEnum unmatched = error ("ReadFlags.toEnum: Cannot match " ++ show unmatched)
{-# LINE 28 "src/Evdev/LowLevel.chs" #-}
data GrabMode = LibevdevGrab
| LibevdevUngrab
deriving (Show)
instance Enum GrabMode where
succ LibevdevGrab = LibevdevUngrab
succ LibevdevUngrab = error "GrabMode.succ: LibevdevUngrab has no successor"
pred LibevdevUngrab = LibevdevGrab
pred LibevdevGrab = error "GrabMode.pred: LibevdevGrab has no predecessor"
enumFromTo from to = go from
where
end = fromEnum to
go v = case compare (fromEnum v) end of
LT -> v : go (succ v)
EQ -> [v]
GT -> []
enumFrom from = enumFromTo from LibevdevUngrab
fromEnum LibevdevGrab = 3
fromEnum LibevdevUngrab = 4
toEnum 3 = LibevdevGrab
toEnum 4 = LibevdevUngrab
toEnum unmatched = error ("GrabMode.toEnum: Cannot match " ++ show unmatched)
{-# LINE 30 "src/Evdev/LowLevel.chs" #-}
newtype Event = Event (C2HSImp.ForeignPtr (Event))
withEvent :: Event -> (C2HSImp.Ptr Event -> IO b) -> IO b
withEvent (Event fptr) = C2HSImp.withForeignPtr fptr
{-# LINE 32 "src/Evdev/LowLevel.chs" #-}
newtype Time = Time (C2HSImp.ForeignPtr (Time))
withTime :: Time -> (C2HSImp.Ptr Time -> IO b) -> IO b
withTime (Time fptr) = C2HSImp.withForeignPtr fptr
{-# LINE 34 "src/Evdev/LowLevel.chs" #-}
newtype Device = Device (C2HSImp.Ptr (Device))
{-# LINE 36 "src/Evdev/LowLevel.chs" #-}
convertEvent :: Event -> IO (Int,Int16,Int32,DiffTime)
convertEvent ev = (,,,)
<$> getIntField (\ptr -> do {C2HSImp.peekByteOff ptr 16 :: IO C2HSImp.CUShort})
{-# LINE 43 "src/Evdev/LowLevel.chs" #-}
<*> getIntField (\ptr -> do {C2HSImp.peekByteOff ptr 18 :: IO C2HSImp.CUShort})
{-# LINE 44 "src/Evdev/LowLevel.chs" #-}
<*> getIntField (\ptr -> do {C2HSImp.peekByteOff ptr 20 :: IO C2HSImp.CInt})
{-# LINE 45 "src/Evdev/LowLevel.chs" #-}
<*> withEvent ev getTime
where
convertTime s us = picosecondsToDiffTime $ 1000000000000 * fromIntegral s + 1000000 * fromIntegral us
getIntField :: (Integral a,Integral b) => (Ptr Event -> IO a) -> IO b
getIntField f = withEvent ev (fmap fromIntegral . f)
getTime :: Ptr Event -> IO DiffTime
getTime ptr =
let sec, usec :: IO CLong
sec = peekByteOff ptr 0
usec = peekByteOff ptr 8
{-# LINE 55 "src/Evdev/LowLevel.chs" #-}
in convertTime <$> sec <*> usec
nextEvent :: Device -> CUInt -> IO (Errno, Event)
nextEvent dev flags = iterateWhile ((== Errno (-11)) . fst) $ do
ptr <- mallocForeignPtrBytes 24
{-# LINE 60 "src/Evdev/LowLevel.chs" #-}
err <- withForeignPtr ptr $ libevdev_next_event dev flags
return (Errno err, Event ptr)
libevdev_grab :: (Device) -> (GrabMode) -> IO ((CInt))
libevdev_grab a1 a2 =
let {a1' = id a1} in
let {a2' = (fromIntegral . fromEnum) a2} in
libevdev_grab'_ a1' a2' >>= \res ->
let {res' = fromIntegral res} in
return (res')
{-# LINE 64 "src/Evdev/LowLevel.chs" #-}
grabDevice :: Device -> GrabMode -> IO (Errno, ())
grabDevice dev mode = do
err <- libevdev_grab dev mode
return (Errno err, ())
newDevice :: RawFilePath -> IO (Errno, Device)
newDevice path = do
Fd n <- openFd path ReadOnly Nothing $ defaultFileFlags
dev <- libevdev_new
{-# LINE 73 "src/Evdev/LowLevel.chs" #-}
err <- libevdev_set_fd dev n
return (Errno err, dev)
hasProperty :: (Device) -> (DeviceProperty) -> IO ((Bool))
hasProperty a1 a2 =
let {a1' = id a1} in
let {a2' = convertEnum a2} in
hasProperty'_ a1' a2' >>= \res ->
let {res' = C2HSImp.toBool res} in
return (res')
{-# LINE 80 "src/Evdev/LowLevel.chs" #-}
deviceFd :: (Device) -> IO ((Fd))
deviceFd a1 =
let {a1' = id a1} in
deviceFd'_ a1' >>= \res ->
let {res' = Fd res} in
return (res')
{-# LINE 81 "src/Evdev/LowLevel.chs" #-}
deviceName :: (Device) -> IO ((String))
deviceName a1 =
let {a1' = id a1} in
deviceName'_ a1' >>= \res ->
C2HSImp.peekCString res >>= \res' ->
return (res')
{-# LINE 82 "src/Evdev/LowLevel.chs" #-}
convertEnum :: (Enum a, Integral b) => a -> b
convertEnum = fromIntegral . fromEnum
foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_next_event"
libevdev_next_event :: ((Device) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (Event)) -> (IO C2HSImp.CInt))))
foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_grab"
libevdev_grab'_ :: ((Device) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))
foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_new"
libevdev_new :: (IO (Device))
foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_set_fd"
libevdev_set_fd :: ((Device) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))
foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_has_property"
hasProperty'_ :: ((Device) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))
foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_get_fd"
deviceFd'_ :: ((Device) -> (IO C2HSImp.CInt))
foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_get_name"
deviceName'_ :: ((Device) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))