-- 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.Loops (iterateWhile)
import Data.ByteString (ByteString,packCString)
import Data.Coerce (coerce)
import Data.Int (Int32,Int64)
import Data.Word (Word16)
import Foreign (Ptr,allocaBytes)
import Foreign.C (CInt(..),CLong(..),CUInt(..),CUShort(..))
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 :: ReadFlag -> ReadFlag -> [ReadFlag]
enumFromTo ReadFlag
from ReadFlag
to = ReadFlag -> [ReadFlag]
forall t. Enum t => t -> [t]
go ReadFlag
from
    where
      end :: Int
end = ReadFlag -> Int
forall a. Enum a => a -> Int
fromEnum ReadFlag
to
      go :: t -> [t]
go t
v = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (t -> Int
forall a. Enum a => a -> Int
fromEnum t
v) Int
end of
                 Ordering
LT -> t
v t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t]
go (t -> t
forall a. Enum a => a -> a
succ t
v)
                 Ordering
EQ -> [t
v]
                 Ordering
GT -> []

  enumFrom from = enumFromTo from Blocking

  fromEnum Sync = 1
  fromEnum Normal = 2
  fromEnum ForceSync = 4
  fromEnum Blocking = 8

  toEnum :: Int -> ReadFlag
toEnum Int
1 = ReadFlag
Sync
  toEnum Int
2 = ReadFlag
Normal
  toEnum Int
4 = ReadFlag
ForceSync
  toEnum Int
8 = Blocking
  toEnum Int
unmatched = String -> ReadFlag
forall a. HasCallStack => String -> a
error ("ReadFlag.toEnum: Cannot match " ++ show unmatched)

{-# LINE 26 "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 28 "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 30 "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
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)


{- Conversions -}

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

nextEvent :: Device -> CUInt -> IO (Errno, CEvent)
nextEvent dev flags = allocaBytes 24 $ \evPtr ->
    (,) <$> iterateWhile (== Errno (-11)) (libevdev_next_event dev flags evPtr)
        <*> ( CEvent
            <$> (coerce <$> (\ptr -> do {C2HSImp.peekByteOff ptr 16 :: IO C2HSImp.CUShort}) evPtr)
            <*> (coerce <$> (\ptr -> do {C2HSImp.peekByteOff ptr 18 :: IO C2HSImp.CUShort}) evPtr)
            <*> (coerce <$> (\ptr -> do {C2HSImp.peekByteOff ptr 20 :: IO C2HSImp.CInt}) evPtr)
            <*> ( CTimeVal
                <$> (coerce <$> (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CLong}) evPtr)
                <*> (coerce <$> (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO C2HSImp.CLong}) evPtr)
            )
        )

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

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

grabDevice :: Device -> GrabMode -> IO (Errno, ())
grabDevice = fmap (,()) .: 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 73 "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 74 "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)


{- Simpler functions -}

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

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

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

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



{- Util -}

devPropToInt :: DeviceProperty -> CUInt
devPropToInt = fromIntegral . fromEnum

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

unFd :: Fd -> CInt
unFd :: Fd -> CInt
unFd (Fd CInt
n) = CInt
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)))