{-# LINE 1 "src/Evdev/LowLevel.chs" #-}
module Evdev.LowLevel where
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.ByteString (ByteString,packCString)
import Foreign (Ptr,allocaBytes)
import Foreign.C (CInt(..),CUInt(..),CUShort(..),CLong)
import Foreign.C.Error (Errno(Errno))
import System.Posix.ByteString (RawFilePath)
import System.Posix.IO.ByteString (OpenMode(ReadOnly),defaultFileFlags,openFd)
import System.Posix.Types (Fd(Fd))
import Evdev.Codes
data ReadFlag = Sync
| Normal
| ForceSync
| Blocking
deriving (Eq,Ord,Show)
instance Enum ReadFlag where
succ Sync = Normal
succ Normal = ForceSync
succ ForceSync = Blocking
succ Blocking = error "ReadFlag.succ: Blocking has no successor"
pred Normal = Sync
pred ForceSync = Normal
pred Blocking = ForceSync
pred Sync = error "ReadFlag.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 ("ReadFlag.toEnum: Cannot match " ++ show unmatched)
{-# LINE 23 "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 25 "src/Evdev/LowLevel.chs" #-}
newtype Device = Device (C2HSImp.ForeignPtr (Device))
withDevice :: Device -> (C2HSImp.Ptr Device -> IO b) -> IO b
withDevice (Device fptr) = C2HSImp.withForeignPtr fptr
{-# LINE 27 "src/Evdev/LowLevel.chs" #-}
libevdev_next_event :: (Device) -> (CUInt) -> (Ptr ()) -> IO ((Errno))
libevdev_next_event a1 a2 a3 =
(withDevice) a1 $ \a1' ->
let {a2' = fromIntegral a2} in
let {a3' = id a3} in
libevdev_next_event'_ a1' a2' a3' >>= \res ->
let {res' = Errno res} in
return (res')
{-# LINE 37 "src/Evdev/LowLevel.chs" #-}
nextEvent :: Device -> CUInt -> IO (Errno, (CUShort,CUShort,CInt,CLong,CLong))
nextEvent dev flags = allocaBytes 24 $ \evPtr ->
(,) <$> iterateWhile (== Errno (-11)) (libevdev_next_event dev flags evPtr)
<*> (
(,,,,)
<$> (\ptr -> do {C2HSImp.peekByteOff ptr 16 :: IO C2HSImp.CUShort}) evPtr
<*> (\ptr -> do {C2HSImp.peekByteOff ptr 18 :: IO C2HSImp.CUShort}) evPtr
<*> (\ptr -> do {C2HSImp.peekByteOff ptr 20 :: IO C2HSImp.CInt}) evPtr
<*> (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CLong}) evPtr
<*> (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO C2HSImp.CLong}) evPtr
)
libevdev_grab :: (Device) -> (GrabMode) -> IO ((Errno))
libevdev_grab a1 a2 =
(withDevice) a1 $ \a1' ->
let {a2' = (fromIntegral . fromEnum) a2} in
libevdev_grab'_ a1' a2' >>= \res ->
let {res' = Errno res} in
return (res')
{-# LINE 50 "src/Evdev/LowLevel.chs" #-}
grabDevice :: Device -> GrabMode -> IO (Errno, ())
grabDevice = fmap (,()) .: libevdev_grab
libevdev_new :: IO ((Device))
libevdev_new =
libevdev_new'_ >>= \res ->
(\x -> C2HSImp.newForeignPtr libevdev_hs_close x >>= (return . Device)) res >>= \res' ->
return (res')
{-# LINE 55 "src/Evdev/LowLevel.chs" #-}
libevdev_set_fd :: (Device) -> (Fd) -> IO ((Errno))
libevdev_set_fd a1 a2 =
(withDevice) a1 $ \a1' ->
let {a2' = unFd a2} in
libevdev_set_fd'_ a1' a2' >>= \res ->
let {res' = Errno res} in
return (res')
{-# LINE 56 "src/Evdev/LowLevel.chs" #-}
newDevice :: RawFilePath -> IO (Errno, Device)
newDevice path = do
fd <- openFd path ReadOnly Nothing defaultFileFlags
dev <- libevdev_new
err <- libevdev_set_fd dev fd
return (err, dev)
hasProperty :: (Device) -> (DeviceProperty) -> IO ((Bool))
hasProperty a1 a2 =
(withDevice) a1 $ \a1' ->
let {a2' = convertEnum a2} in
hasProperty'_ a1' a2' >>= \res ->
let {res' = C2HSImp.toBool res} in
return (res')
{-# LINE 67 "src/Evdev/LowLevel.chs" #-}
deviceFd :: (Device) -> IO ((Fd))
deviceFd a1 =
(withDevice) a1 $ \a1' ->
deviceFd'_ a1' >>= \res ->
let {res' = Fd res} in
return (res')
{-# LINE 68 "src/Evdev/LowLevel.chs" #-}
deviceName :: (Device) -> IO ((IO ByteString))
deviceName a1 =
(withDevice) a1 $ \a1' ->
deviceName'_ a1' >>= \res ->
let {res' = packCString res} in
return (res')
{-# LINE 69 "src/Evdev/LowLevel.chs" #-}
convertEnum :: DeviceProperty -> CUInt
convertEnum = fromIntegral . fromEnum
(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
(.:) = (.) . (.)
unFd :: Fd -> CInt
unFd (Fd n) = n
foreign import ccall "Evdev/LowLevel.chs.h &libevdev_hs_close"
libevdev_hs_close :: C2HSImp.FinalizerPtr Device
foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_next_event"
libevdev_next_event'_ :: ((C2HSImp.Ptr (Device)) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))
foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_grab"
libevdev_grab'_ :: ((C2HSImp.Ptr (Device)) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))
foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_new"
libevdev_new'_ :: (IO (C2HSImp.Ptr (Device)))
foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_set_fd"
libevdev_set_fd'_ :: ((C2HSImp.Ptr (Device)) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))
foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_has_property"
hasProperty'_ :: ((C2HSImp.Ptr (Device)) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))
foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_get_fd"
deviceFd'_ :: ((C2HSImp.Ptr (Device)) -> (IO C2HSImp.CInt))
foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_get_name"
deviceName'_ :: ((C2HSImp.Ptr (Device)) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))