-- 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.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 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 Event = Event (C2HSImp.ForeignPtr (Event))
withEvent :: Event -> (C2HSImp.Ptr Event -> IO b) -> IO b
withEvent (Event fptr) = C2HSImp.withForeignPtr fptr
{-# LINE 30 "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 32 "src/Evdev/LowLevel.chs" #-}


newtype Device = Device (C2HSImp.Ptr (Device))
{-# LINE 34 "src/Evdev/LowLevel.chs" #-}



{- Conversions -}

convertEvent :: Event -> IO (Int,Int16,Int32,DiffTime)
convertEvent ev = (,,,)
    <$> getIntField (\ptr -> do {C2HSImp.peekByteOff ptr 16 :: IO C2HSImp.CUShort})
{-# LINE 41 "src/Evdev/LowLevel.chs" #-}

    <*> getIntField (\ptr -> do {C2HSImp.peekByteOff ptr 18 :: IO C2HSImp.CUShort})
{-# LINE 42 "src/Evdev/LowLevel.chs" #-}

    <*> getIntField (\ptr -> do {C2HSImp.peekByteOff ptr 20 :: IO C2HSImp.CInt})
{-# LINE 43 "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)
{-# LINE 52 "src/Evdev/LowLevel.chs" #-}

                usec = peekByteOff ptr (8)
{-# LINE 53 "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 58 "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 62 "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 71 "src/Evdev/LowLevel.chs" #-}

    err <- libevdev_set_fd dev n
    return (Errno err, dev)


{- Simpler functions -}

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

--TODO should really be ByteString


{- Util -}

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)))