-- GENERATED by C->Haskell Compiler, version 0.28.6 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# 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 (join)
import Data.ByteString (ByteString,packCString,useAsCString)
import Data.Coerce (coerce)
import Data.Int (Int32,Int64)
import Data.Word (Word16, Word32)
import Foreign (Ptr,allocaBytes,mallocBytes,mallocForeignPtrBytes,newForeignPtr_,nullPtr,peek,withForeignPtr)
import Foreign.C (CInt(..),CLong(..),CUInt(..),CUShort(..),CString)
import Foreign.C.Error (Errno(Errno), eOK, eAGAIN)
import System.Posix.Types (Fd(Fd))

import Evdev.Codes






data ReadFlag = Sync
              | Normal
              | ForceSync
              | Blocking
  deriving (Eq,Ord,Show)
instance Enum ReadFlag where
  succ :: ReadFlag -> ReadFlag
succ ReadFlag
Sync = ReadFlag
Normal
  pred :: GrabMode -> GrabMode
succ ReadFlag
Normal = ReadFlag
ForceSync
  succ ReadFlag
ForceSync = ReadFlag
Blocking
  succ ReadFlag
Blocking = forall a. HasCallStack => String -> a
error String
"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 :: ReadFlag -> Int
enumFrom :: UInputOpenMode -> [UInputOpenMode]
fromEnum UInputOpenMode
ReadFlag
Sync = Int
1
  fromEnum ReadFlag
Normal = Int
2
  fromEnum :: UInputOpenMode -> Int
fromEnum ReadFlag
ForceSync = Int
4
  fromEnum ReadFlag
Blocking = Int
8

  toEnum 1 = Sync
  toEnum 2 = Normal
  toEnum 4 = ForceSync
  toEnum 8 = Blocking
  toEnum unmatched = error ("ReadFlag.toEnum: Cannot match " ++ show unmatched)

{-# LINE 25 "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 27 "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 29 "src/Evdev/LowLevel.chs" #-}

--TODO any reason c2hs doesn't allow a haskell function as the finalizer?
    -- failing that, any reason not to have actual inline c?
--TODO expose this directly, seeing as the GC makes no guarantees of promptness
newtype UDevice = UDevice (C2HSImp.ForeignPtr (UDevice))
withUDevice :: UDevice -> (C2HSImp.Ptr UDevice -> IO b) -> IO b
withUDevice (UDevice fptr) = C2HSImp.withForeignPtr fptr
{-# LINE 36 "src/Evdev/LowLevel.chs" #-}


--TODO '{#enum libevdev_uinput_open_mode {} #}' results in malformed output - c2hs bug
data UInputOpenMode = UOMManaged
instance Enum UInputOpenMode where
  succ UOMManaged = error "UInputOpenMode.succ: UOMManaged has no successor"

  pred UOMManaged = error "UInputOpenMode.pred: UOMManaged 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 UOMManaged

  fromEnum UOMManaged = (-2)

  toEnum (-2) = UOMManaged
  toEnum unmatched = error ("UInputOpenMode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 39 "src/Evdev/LowLevel.chs" #-}



data CEvent = CEvent
    { cEventType :: Word16
    , cEventCode :: Word16
    , cEventValue :: Int32
    , cEventTime :: CTimeVal
    }
    deriving (Eq, Ord, Read, Show)

data CTimeVal = CTimeVal
    { tvSec :: Int64
    , tvUsec :: Int64
    }
    deriving (Eq, Ord, Read, Show)


{- Complex stuff -}

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 59 "src/Evdev/LowLevel.chs" #-}

nextEvent :: Device -> CUInt -> IO (Errno, CEvent)
nextEvent dev flags = allocaBytes 24 $ \evPtr ->
    (,) <$> libevdev_next_event dev flags evPtr <*> getEvent evPtr
nextEventMay :: Device -> CUInt -> IO (Errno, Maybe CEvent)
nextEventMay dev flags = allocaBytes 24 $ \evPtr -> do
    err <- libevdev_next_event dev flags evPtr
    if err /= eOK
        then return
            ( if negateErrno err == eAGAIN then eOK else err
            , Nothing
            )
        else (eOK,) . Just <$> getEvent evPtr
getEvent :: Ptr () -> IO CEvent
getEvent :: Ptr () -> IO CEvent
getEvent Ptr ()
evPtr = Word16 -> Word16 -> Int32 -> CTimeVal -> CEvent
CEvent
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (\Ptr ()
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr Int
16 :: IO C2HSImp.CUShort}) Ptr ()
evPtr)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (\Ptr ()
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr Int
18 :: IO C2HSImp.CUShort}) Ptr ()
evPtr)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (\Ptr ()
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr Int
20 :: IO C2HSImp.CInt}) Ptr ()
evPtr)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Int64 -> Int64 -> CTimeVal
CTimeVal
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (\Ptr ()
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr Int
0 :: IO C2HSImp.CLong}) Ptr ()
evPtr)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (\Ptr ()
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr Int
8 :: IO C2HSImp.CLong}) Ptr ()
evPtr)
        )

libevdev_grab :: (Device) -> (GrabMode) -> IO ((Errno))
libevdev_grab :: Device -> GrabMode -> IO Errno
libevdev_grab Device
a1 GrabMode
a2 =
  (forall b. Device -> (Ptr Device -> IO b) -> IO b
withDevice) Device
a1 forall a b. (a -> b) -> a -> b
$ \Ptr Device
a1' -> 
  let {a2' :: CInt
a2' = (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) GrabMode
a2} in 
  Ptr Device -> CInt -> IO CInt
libevdev_grab'_ Ptr Device
a1' CInt
a2' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
  let {res' :: Errno
res' = CInt -> Errno
Errno CInt
res} in
  forall (m :: * -> *) a. Monad m => a -> m a
return (Errno
res')

{-# LINE 82 "src/Evdev/LowLevel.chs" #-}

grabDevice :: Device -> GrabMode -> IO Errno
grabDevice = libevdev_grab

--TODO use 'libevdev_new_from_fd' when https://github.com/haskell/c2hs/issues/236 fixed
libevdev_new :: IO ((Device))
libevdev_new =
  libevdev_new'_ >>= \res ->
  (\x -> C2HSImp.newForeignPtr libevdev_hs_close x >>= (return . Device)) res >>= \res' ->
  return (res')

{-# LINE 87 "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 88 "src/Evdev/LowLevel.chs" #-}

newDeviceFromFd :: Fd -> IO (Errno, Device)
newDeviceFromFd fd = libevdev_new >>= \dev -> (, dev) <$> libevdev_set_fd dev fd

--TODO 'useAsCString' copies, which seems unnecessary due to the 'const' in the C function
libevdev_set_name :: (Device) -> (CString) -> IO ()
libevdev_set_name a1 a2 =
  (withDevice) a1 $ \a1' -> 
  (flip ($)) a2 $ \a2' -> 
  libevdev_set_name'_ a1' a2' >>
  return ()

{-# LINE 93 "src/Evdev/LowLevel.chs" #-}

setDeviceName :: Device -> ByteString -> IO ()
setDeviceName dev name = useAsCString name $ libevdev_set_name dev
libevdev_set_phys :: (Device) -> (CString) -> IO ()
libevdev_set_phys a1 a2 =
  (withDevice) a1 $ \a1' -> 
  (flip ($)) a2 $ \a2' -> 
  libevdev_set_phys'_ a1' a2' >>
  return ()

{-# LINE 96 "src/Evdev/LowLevel.chs" #-}

setDevicePhys :: Device -> ByteString -> IO ()
setDevicePhys dev phys = useAsCString phys $ libevdev_set_phys dev
libevdev_set_uniq :: (Device) -> (CString) -> IO ()
libevdev_set_uniq a1 a2 =
  (withDevice) a1 $ \a1' -> 
  (flip ($)) a2 $ \a2' -> 
  libevdev_set_uniq'_ a1' a2' >>
  return ()

{-# LINE 99 "src/Evdev/LowLevel.chs" #-}

setDeviceUniq :: Device -> ByteString -> IO ()
setDeviceUniq dev uniq = useAsCString uniq $ libevdev_set_uniq dev

--TODO c2hs can't seem to help us here due to the nested pointer
foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_uinput_create_from_device"
  libevdev_uinput_create_from_device :: Ptr Device -> CInt -> Ptr (Ptr UDevice) -> IO CInt
createFromDevice :: Device -> Fd -> IO (Errno, UDevice)
createFromDevice :: Device -> Fd -> IO (Errno, UDevice)
createFromDevice Device
dev (Fd CInt
fd) = forall b. Device -> (Ptr Device -> IO b) -> IO b
withDevice Device
dev forall a b. (a -> b) -> a -> b
$ \Ptr Device
devP -> do
    ForeignPtr (Ptr UDevice)
devFPP <- forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
0
    (CInt
e,Ptr UDevice
x) <- forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (Ptr UDevice)
devFPP forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr UDevice)
devPP ->
        (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Device -> CInt -> Ptr (Ptr UDevice) -> IO CInt
libevdev_uinput_create_from_device Ptr Device
devP CInt
fd Ptr (Ptr UDevice)
devPP forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr UDevice)
devPP
    ForeignPtr UDevice
devFP <- forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr UDevice
x
    forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Errno
Errno CInt
e, ForeignPtr UDevice -> UDevice
UDevice ForeignPtr UDevice
devFP)

--TODO since the same technique produces just one 'IO' for  'deviceName', is this another c2hs bug?
libevdev_uinput_get_syspath :: (UDevice) -> IO ((IO (Maybe ByteString)))
libevdev_uinput_get_syspath :: UDevice -> IO (IO (Maybe ByteString))
libevdev_uinput_get_syspath UDevice
a1 =
  (forall b. UDevice -> (Ptr UDevice -> IO b) -> IO b
withUDevice) UDevice
a1 forall a b. (a -> b) -> a -> b
$ \Ptr UDevice
a1' -> 
  Ptr UDevice -> IO CString
libevdev_uinput_get_syspath'_ Ptr UDevice
a1' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CString
res ->
  let {res' :: IO (Maybe ByteString)
res' = CString -> IO (Maybe ByteString)
packCString' CString
res} in
  forall (m :: * -> *) a. Monad m => a -> m a
return (IO (Maybe ByteString)
res')

{-# LINE 115 "src/Evdev/LowLevel.chs" #-}

getSyspath :: UDevice -> IO (Maybe ByteString)
getSyspath = join . libevdev_uinput_get_syspath
libevdev_uinput_get_devnode :: (UDevice) -> IO ((IO (Maybe ByteString)))
libevdev_uinput_get_devnode a1 =
  (withUDevice) a1 $ \a1' -> 
  libevdev_uinput_get_devnode'_ a1' >>= \res ->
  let {res' = packCString' res} in
  return (res')

{-# LINE 118 "src/Evdev/LowLevel.chs" #-}

getDevnode :: UDevice -> IO (Maybe ByteString)
getDevnode = join . libevdev_uinput_get_devnode

data AbsInfo = AbsInfo
    { absValue :: Int32
    , absMinimum :: Int32
    , absMaximum :: Int32
    , absFuzz :: Int32
    , absFlat :: Int32
    , absResolution :: Int32
    }
    deriving (Show)
withAbsInfo :: AbsInfo -> (Ptr () -> IO a) -> IO a
withAbsInfo :: forall a. AbsInfo -> (Ptr () -> IO a) -> IO a
withAbsInfo AbsInfo{Int32
absResolution :: AbsInfo -> Int32
absFlat :: AbsInfo -> Int32
absFuzz :: AbsInfo -> Int32
absMaximum :: AbsInfo -> Int32
absMinimum :: AbsInfo -> Int32
absValue :: AbsInfo -> Int32
absResolution :: Int32
absFlat :: Int32
absFuzz :: Int32
absMaximum :: Int32
absMinimum :: Int32
absValue :: Int32
..} Ptr () -> IO a
f = do
    Ptr ()
p <- forall a. Int -> IO (Ptr a)
mallocBytes Int
24
{-# LINE 133 "src/Evdev/LowLevel.chs" #-}

    (\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: C2HSImp.CInt)}) p $ CInt absValue
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 4 (val :: C2HSImp.CInt)}) p $ CInt absMinimum
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: C2HSImp.CInt)}) p $ CInt absMaximum
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 12 (val :: C2HSImp.CInt)}) p $ CInt absFuzz
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 16 (val :: C2HSImp.CInt)}) p $ CInt absFlat
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 20 (val :: C2HSImp.CInt)}) p $ CInt absResolution
    pf <- newForeignPtr_ p
    withForeignPtr pf f

--TODO can c2hs make this simpler at all?
foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_get_abs_info"
  libevdev_get_abs_info :: Ptr Device -> CUInt -> IO (Ptr ())
getAbsInfo :: Device -> Word32 -> IO (Maybe AbsInfo)
getAbsInfo :: Device -> Word32 -> IO (Maybe AbsInfo)
getAbsInfo Device
dev Word32
x = forall b. Device -> (Ptr Device -> IO b) -> IO b
withDevice Device
dev \Ptr Device
devPtr ->
    Ptr Device -> CUInt -> IO (Ptr ())
libevdev_get_abs_info Ptr Device
devPtr (Word32 -> CUInt
CUInt Word32
x) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (Ptr a -> b) -> Ptr a -> b
handleNull (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) \Ptr ()
absinfoPtr -> do
        CInt Int32
absValue <- (\Ptr ()
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr Int
0 :: IO C2HSImp.CInt}) Ptr ()
absinfoPtr
        CInt Int32
absMinimum <- (\Ptr ()
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr Int
4 :: IO C2HSImp.CInt}) Ptr ()
absinfoPtr
        CInt Int32
absMaximum <- (\Ptr ()
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr Int
8 :: IO C2HSImp.CInt}) Ptr ()
absinfoPtr
        CInt Int32
absFuzz <- (\Ptr ()
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr Int
12 :: IO C2HSImp.CInt}) Ptr ()
absinfoPtr
        CInt Int32
absFlat <- (\Ptr ()
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr Int
16 :: IO C2HSImp.CInt}) Ptr ()
absinfoPtr
        CInt Int32
absResolution <- (\Ptr ()
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr Int
20 :: IO C2HSImp.CInt}) Ptr ()
absinfoPtr
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just AbsInfo{Int32
absResolution :: Int32
absFlat :: Int32
absFuzz :: Int32
absMaximum :: Int32
absMinimum :: Int32
absValue :: Int32
absResolution :: Int32
absFlat :: Int32
absFuzz :: Int32
absMaximum :: Int32
absMinimum :: Int32
absValue :: Int32
..}


{- Simpler functions -}

hasProperty :: (Device) -> (DeviceProperty) -> IO ((Bool))
hasProperty :: Device -> DeviceProperty -> IO Bool
hasProperty Device
a1 DeviceProperty
a2 =
  (forall b. Device -> (Ptr Device -> IO b) -> IO b
withDevice) Device
a1 forall a b. (a -> b) -> a -> b
$ \Ptr Device
a1' -> 
  let {a2' :: CUInt
a2' = convertEnum a2} in 
  hasProperty'_ a1' a2' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 160 "src/Evdev/LowLevel.chs" #-}

hasEventType :: (Device) -> (EventType) -> IO ((Bool))
hasEventType a1 a2 =
  (withDevice) a1 $ \a1' -> 
  let {a2' = convertEnum a2} in 
  hasEventType'_ a1' a2' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 161 "src/Evdev/LowLevel.chs" #-}

hasEventCode :: (Device) -> (Word16) -> (Word16) -> IO ((Bool))
hasEventCode a1 a2 a3 =
  (withDevice) a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  hasEventCode'_ a1' a2' a3' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 162 "src/Evdev/LowLevel.chs" #-}

deviceFd :: (Device) -> IO ((Fd))
deviceFd a1 =
  (withDevice) a1 $ \a1' -> 
  deviceFd'_ a1' >>= \res ->
  let {res' = Fd res} in
  return (res')

{-# LINE 163 "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 164 "src/Evdev/LowLevel.chs" #-}

devicePhys :: (Device) -> IO ((IO (Maybe ByteString)))
devicePhys a1 =
  (withDevice) a1 $ \a1' -> 
  devicePhys'_ a1' >>= \res ->
  let {res' = packCString' res} in
  return (res')

{-# LINE 165 "src/Evdev/LowLevel.chs" #-}

deviceUniq :: (Device) -> IO ((IO (Maybe ByteString)))
deviceUniq a1 =
  (withDevice) a1 $ \a1' -> 
  deviceUniq'_ a1' >>= \res ->
  let {res' = packCString' res} in
  return (res')

{-# LINE 166 "src/Evdev/LowLevel.chs" #-}

deviceProduct :: (Device) -> IO ((Int))
deviceProduct a1 =
  (withDevice) a1 $ \a1' -> 
  deviceProduct'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 167 "src/Evdev/LowLevel.chs" #-}

deviceVendor :: (Device) -> IO ((Int))
deviceVendor a1 =
  (withDevice) a1 $ \a1' -> 
  deviceVendor'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 168 "src/Evdev/LowLevel.chs" #-}

deviceBustype :: (Device) -> IO ((Int))
deviceBustype a1 =
  (withDevice) a1 $ \a1' -> 
  deviceBustype'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 169 "src/Evdev/LowLevel.chs" #-}

deviceVersion :: (Device) -> IO ((Int))
deviceVersion a1 =
  (withDevice) a1 $ \a1' -> 
  deviceVersion'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 170 "src/Evdev/LowLevel.chs" #-}

libevdev_set_id_product :: (Device) -> (Int) -> IO ()
libevdev_set_id_product a1 a2 =
  (withDevice) a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  libevdev_set_id_product'_ a1' a2' >>
  return ()

{-# LINE 171 "src/Evdev/LowLevel.chs" #-}

libevdev_set_id_vendor :: (Device) -> (Int) -> IO ()
libevdev_set_id_vendor a1 a2 =
  (withDevice) a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  libevdev_set_id_vendor'_ a1' a2' >>
  return ()

{-# LINE 172 "src/Evdev/LowLevel.chs" #-}

libevdev_set_id_bustype :: (Device) -> (Int) -> IO ()
libevdev_set_id_bustype a1 a2 =
  (withDevice) a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  libevdev_set_id_bustype'_ a1' a2' >>
  return ()

{-# LINE 173 "src/Evdev/LowLevel.chs" #-}

libevdev_set_id_version :: (Device) -> (Int) -> IO ()
libevdev_set_id_version a1 a2 =
  (withDevice) a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  libevdev_set_id_version'_ a1' a2' >>
  return ()

{-# LINE 174 "src/Evdev/LowLevel.chs" #-}

enableType :: (Device) -> (Word16) -> IO ((Errno))
enableType a1 a2 =
  (withDevice) a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  enableType'_ a1' a2' >>= \res ->
  let {res' = Errno res} in
  return (res')

{-# LINE 175 "src/Evdev/LowLevel.chs" #-}

enableCode :: (Device) -> (Word16) -> (Word16) -> (Ptr ()) -> IO ((Errno))
enableCode a1 a2 a3 a4 =
  (withDevice) a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = id a4} in 
  enableCode'_ a1' a2' a3' a4' >>= \res ->
  let {res' = Errno res} in
  return (res')

{-# LINE 176 "src/Evdev/LowLevel.chs" #-}

writeEvent :: (UDevice) -> (Word16) -> (Word16) -> (Int32) -> IO ((Errno))
writeEvent a1 a2 a3 a4 =
  (withUDevice) a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  writeEvent'_ a1' a2' a3' a4' >>= \res ->
  let {res' = Errno res} in
  return (res')

{-# LINE 177 "src/Evdev/LowLevel.chs" #-}


-- | LEDs values
data LEDValue = LedOn
              | LedOff
  deriving (Bounded,Eq,Ord,Read,Show)
instance Enum LEDValue where
  succ LedOn = LedOff
  succ LedOff = error "LEDValue.succ: LedOff has no successor"

  pred LedOff = LedOn
  pred LedOn = error "LEDValue.pred: LedOn 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 LedOff

  fromEnum :: LEDValue -> Int
fromEnum LEDValue
LedOn = Int
3
  fromEnum LEDValue
LedOff = Int
4

  toEnum :: Int -> LEDValue
toEnum Int
3 = LEDValue
LedOn
  toEnum 4 = LedOff
  toEnum Int
unmatched = forall a. HasCallStack => String -> a
error (String
"LEDValue.toEnum: Cannot match " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
unmatched)

{-# LINE 183 "src/Evdev/LowLevel.chs" #-}

libevdev_kernel_set_led_value :: (Device) -> (LEDEvent) -> (LEDValue) -> IO ((Errno))
libevdev_kernel_set_led_value a1 a2 a3 =
  (withDevice) a1 $ \a1' -> 
  let {a2' = convertEnum a2} in 
  let {a3' = (fromIntegral . fromEnum) a3} in 
  libevdev_kernel_set_led_value'_ a1' a2' a3' >>= \res ->
  let {res' = Errno res} in
  return (res')

{-# LINE 184 "src/Evdev/LowLevel.chs" #-}


{- Util -}

convertEnum :: (Enum a, Integral b) => a -> b
convertEnum = fromIntegral . fromEnum

(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
(.:) = (.) . (.)

unFd :: Fd -> CInt
unFd (Fd n) = n

handleNull :: b -> (Ptr a -> b) -> Ptr a -> b
handleNull def f p = if p == nullPtr then def else f p

packCString' :: CString -> IO (Maybe ByteString)
packCString' = handleNull (return Nothing) (fmap Just . packCString)

negateErrno :: Errno -> Errno
negateErrno (Errno cint) = Errno (-cint)

foreign import ccall "Evdev/LowLevel.chs.h &libevdev_hs_close"
  libevdev_hs_close :: C2HSImp.FinalizerPtr Device

foreign import ccall "Evdev/LowLevel.chs.h &libevdev_uinput_destroy"
  libevdev_uinput_destroy :: C2HSImp.FinalizerPtr UDevice

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_set_name"
  libevdev_set_name'_ :: ((C2HSImp.Ptr (Device)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ())))

foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_set_phys"
  libevdev_set_phys'_ :: ((C2HSImp.Ptr (Device)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ())))

foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_set_uniq"
  libevdev_set_uniq'_ :: ((C2HSImp.Ptr (Device)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ())))

foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_uinput_get_syspath"
  libevdev_uinput_get_syspath'_ :: ((C2HSImp.Ptr (UDevice)) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_uinput_get_devnode"
  libevdev_uinput_get_devnode'_ :: ((C2HSImp.Ptr (UDevice)) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

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_has_event_type"
  hasEventType'_ :: ((C2HSImp.Ptr (Device)) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_has_event_code"
  hasEventCode'_ :: ((C2HSImp.Ptr (Device)) -> (C2HSImp.CUInt -> (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)))

foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_get_phys"
  devicePhys'_ :: ((C2HSImp.Ptr (Device)) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_get_uniq"
  deviceUniq'_ :: ((C2HSImp.Ptr (Device)) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_get_id_product"
  deviceProduct'_ :: ((C2HSImp.Ptr (Device)) -> (IO C2HSImp.CInt))

foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_get_id_vendor"
  deviceVendor'_ :: ((C2HSImp.Ptr (Device)) -> (IO C2HSImp.CInt))

foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_get_id_bustype"
  deviceBustype'_ :: ((C2HSImp.Ptr (Device)) -> (IO C2HSImp.CInt))

foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_get_id_version"
  deviceVersion'_ :: ((C2HSImp.Ptr (Device)) -> (IO C2HSImp.CInt))

foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_set_id_product"
  libevdev_set_id_product'_ :: ((C2HSImp.Ptr (Device)) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_set_id_vendor"
  libevdev_set_id_vendor'_ :: ((C2HSImp.Ptr (Device)) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_set_id_bustype"
  libevdev_set_id_bustype'_ :: ((C2HSImp.Ptr (Device)) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_set_id_version"
  libevdev_set_id_version'_ :: ((C2HSImp.Ptr (Device)) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_enable_event_type"
  enableType'_ :: ((C2HSImp.Ptr (Device)) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_enable_event_code"
  enableCode'_ :: ((C2HSImp.Ptr (Device)) -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))))

foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_uinput_write_event"
  writeEvent'_ :: ((C2HSImp.Ptr (UDevice)) -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))

foreign import ccall safe "Evdev/LowLevel.chs.h libevdev_kernel_set_led_value"
  libevdev_kernel_set_led_value'_ :: ((C2HSImp.Ptr (Device)) -> (C2HSImp.CUInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))