{-# OPTIONS_GHC -fno-state-hack #-}

-- | The main module for working with devices and events.
module Evdev (
    -- * Devices
    Device,
    newDevice,
    nextEvent,
    evdevDir,
    -- ** Properties
    deviceName,
    devicePath,
    deviceProperties,
    deviceEventTypes,
    deviceHasEvent,
    deviceFd,
    devicePhys,
    deviceUniq,
    deviceProduct,
    deviceVendor,
    deviceBustype,
    deviceVersion,
    deviceAbsAxis,
    LL.AbsInfo (..),
    -- ** Grabbing
    grabDevice,
    ungrabDevice,

    -- * Events
    Event(..),
    EventData(..),
    KeyEvent(..),
    EventCode(..),
    EventValue(..),

    -- * Lower-level
    newDeviceFromFd,
    nextEventMay,
    LL.LEDValue(..),
    setDeviceLED,
    -- ** C-style types
    -- | These correspond more directly to C's /input_event/ and /timeval/.
    -- They are used internally, but may be useful for advanced users.
    LL.CEvent(..),
    toCEvent,
    fromCEvent,
    toCEventData,
    fromCEventData,
    LL.CTimeVal(..),
    toCTimeVal,
    fromCTimeVal,
) where

import Control.Arrow ((&&&))
import Control.Monad (filterM, join)
import Data.ByteString.Char8 (ByteString, pack)
import Data.Int (Int32)
import Data.List.Extra (enumerate)
import Data.Map ((!?), Map)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.Ratio ((%))
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Time.Clock (DiffTime)
import Data.Tuple.Extra (uncurry3)
import Data.Word (Word16)
import Foreign ((.|.))
import Foreign.C (CUInt)
import System.Posix.Process (getProcessID)
import System.Posix.Files (readSymbolicLink)
import System.Posix.ByteString (Fd, RawFilePath)
import System.Posix.IO.ByteString (OpenMode (..), defaultFileFlags, openFd)

import qualified Evdev.LowLevel as LL
import Evdev.Codes
import Util

-- stores path that was originally used, as it seems impossible to recover this later
-- We don't allow the user to access the underlying low-level C device.
-- | An input device.
data Device = Device { Device -> Device
cDevice :: LL.Device, Device -> RawFilePath
devicePath :: ByteString }


instance Show Device where
    show :: Device -> FilePath
show = RawFilePath -> FilePath
forall a. Show a => a -> FilePath
show (RawFilePath -> FilePath)
-> (Device -> RawFilePath) -> Device -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> RawFilePath
devicePath

-- | An input event, including the timestamp.
data Event = Event
    { Event -> EventData
eventData :: EventData
    , Event -> DiffTime
eventTime :: DiffTime
    }
    deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
/= :: Event -> Event -> Bool
Eq, Eq Event
Eq Event =>
(Event -> Event -> Ordering)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Event)
-> (Event -> Event -> Event)
-> Ord Event
Event -> Event -> Bool
Event -> Event -> Ordering
Event -> Event -> Event
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Event -> Event -> Ordering
compare :: Event -> Event -> Ordering
$c< :: Event -> Event -> Bool
< :: Event -> Event -> Bool
$c<= :: Event -> Event -> Bool
<= :: Event -> Event -> Bool
$c> :: Event -> Event -> Bool
> :: Event -> Event -> Bool
$c>= :: Event -> Event -> Bool
>= :: Event -> Event -> Bool
$cmax :: Event -> Event -> Event
max :: Event -> Event -> Event
$cmin :: Event -> Event -> Event
min :: Event -> Event -> Event
Ord, Int -> Event -> ShowS
[Event] -> ShowS
Event -> FilePath
(Int -> Event -> ShowS)
-> (Event -> FilePath) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Event -> ShowS
showsPrec :: Int -> Event -> ShowS
$cshow :: Event -> FilePath
show :: Event -> FilePath
$cshowList :: [Event] -> ShowS
showList :: [Event] -> ShowS
Show, ReadPrec [Event]
ReadPrec Event
Int -> ReadS Event
ReadS [Event]
(Int -> ReadS Event)
-> ReadS [Event]
-> ReadPrec Event
-> ReadPrec [Event]
-> Read Event
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Event
readsPrec :: Int -> ReadS Event
$creadList :: ReadS [Event]
readList :: ReadS [Event]
$creadPrec :: ReadPrec Event
readPrec :: ReadPrec Event
$creadListPrec :: ReadPrec [Event]
readListPrec :: ReadPrec [Event]
Read)

-- | An input event, without the timestamp.
-- Each constructor corresponds to one [event type](https://www.kernel.org/doc/html/latest/input/event-codes.html#event-types), except for 'UnknownEvent'.
data EventData
    = SyncEvent SyncEvent
    | KeyEvent Key KeyEvent
    | RelativeEvent RelativeAxis EventValue
    | AbsoluteEvent AbsoluteAxis EventValue
    | MiscEvent MiscEvent EventValue
    | SwitchEvent SwitchEvent EventValue
    | LEDEvent LEDEvent EventValue
    | SoundEvent SoundEvent EventValue
    | RepeatEvent RepeatEvent EventValue
    | ForceFeedbackEvent EventCode EventValue
    | PowerEvent EventCode EventValue
    | ForceFeedbackStatusEvent EventCode EventValue
    | UnknownEvent Word16 EventCode EventValue {- ^ We include this primarily so that 'fromCEvent' can be well-defined -
        let us know if you ever actually see one emitted by a device, as it would likely
        indicate a shortcoming in the library. -}
    deriving (EventData -> EventData -> Bool
(EventData -> EventData -> Bool)
-> (EventData -> EventData -> Bool) -> Eq EventData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventData -> EventData -> Bool
== :: EventData -> EventData -> Bool
$c/= :: EventData -> EventData -> Bool
/= :: EventData -> EventData -> Bool
Eq, Eq EventData
Eq EventData =>
(EventData -> EventData -> Ordering)
-> (EventData -> EventData -> Bool)
-> (EventData -> EventData -> Bool)
-> (EventData -> EventData -> Bool)
-> (EventData -> EventData -> Bool)
-> (EventData -> EventData -> EventData)
-> (EventData -> EventData -> EventData)
-> Ord EventData
EventData -> EventData -> Bool
EventData -> EventData -> Ordering
EventData -> EventData -> EventData
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EventData -> EventData -> Ordering
compare :: EventData -> EventData -> Ordering
$c< :: EventData -> EventData -> Bool
< :: EventData -> EventData -> Bool
$c<= :: EventData -> EventData -> Bool
<= :: EventData -> EventData -> Bool
$c> :: EventData -> EventData -> Bool
> :: EventData -> EventData -> Bool
$c>= :: EventData -> EventData -> Bool
>= :: EventData -> EventData -> Bool
$cmax :: EventData -> EventData -> EventData
max :: EventData -> EventData -> EventData
$cmin :: EventData -> EventData -> EventData
min :: EventData -> EventData -> EventData
Ord, Int -> EventData -> ShowS
[EventData] -> ShowS
EventData -> FilePath
(Int -> EventData -> ShowS)
-> (EventData -> FilePath)
-> ([EventData] -> ShowS)
-> Show EventData
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventData -> ShowS
showsPrec :: Int -> EventData -> ShowS
$cshow :: EventData -> FilePath
show :: EventData -> FilePath
$cshowList :: [EventData] -> ShowS
showList :: [EventData] -> ShowS
Show, ReadPrec [EventData]
ReadPrec EventData
Int -> ReadS EventData
ReadS [EventData]
(Int -> ReadS EventData)
-> ReadS [EventData]
-> ReadPrec EventData
-> ReadPrec [EventData]
-> Read EventData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS EventData
readsPrec :: Int -> ReadS EventData
$creadList :: ReadS [EventData]
readList :: ReadS [EventData]
$creadPrec :: ReadPrec EventData
readPrec :: ReadPrec EventData
$creadListPrec :: ReadPrec [EventData]
readListPrec :: ReadPrec [EventData]
Read)

-- | A direct representation of the /code/ field of the C /input_event/, for when there is no obvious meaningful sum type.
newtype EventCode = EventCode Word16
    deriving (EventCode -> EventCode -> Bool
(EventCode -> EventCode -> Bool)
-> (EventCode -> EventCode -> Bool) -> Eq EventCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventCode -> EventCode -> Bool
== :: EventCode -> EventCode -> Bool
$c/= :: EventCode -> EventCode -> Bool
/= :: EventCode -> EventCode -> Bool
Eq, Eq EventCode
Eq EventCode =>
(EventCode -> EventCode -> Ordering)
-> (EventCode -> EventCode -> Bool)
-> (EventCode -> EventCode -> Bool)
-> (EventCode -> EventCode -> Bool)
-> (EventCode -> EventCode -> Bool)
-> (EventCode -> EventCode -> EventCode)
-> (EventCode -> EventCode -> EventCode)
-> Ord EventCode
EventCode -> EventCode -> Bool
EventCode -> EventCode -> Ordering
EventCode -> EventCode -> EventCode
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EventCode -> EventCode -> Ordering
compare :: EventCode -> EventCode -> Ordering
$c< :: EventCode -> EventCode -> Bool
< :: EventCode -> EventCode -> Bool
$c<= :: EventCode -> EventCode -> Bool
<= :: EventCode -> EventCode -> Bool
$c> :: EventCode -> EventCode -> Bool
> :: EventCode -> EventCode -> Bool
$c>= :: EventCode -> EventCode -> Bool
>= :: EventCode -> EventCode -> Bool
$cmax :: EventCode -> EventCode -> EventCode
max :: EventCode -> EventCode -> EventCode
$cmin :: EventCode -> EventCode -> EventCode
min :: EventCode -> EventCode -> EventCode
Ord, Int -> EventCode -> ShowS
[EventCode] -> ShowS
EventCode -> FilePath
(Int -> EventCode -> ShowS)
-> (EventCode -> FilePath)
-> ([EventCode] -> ShowS)
-> Show EventCode
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventCode -> ShowS
showsPrec :: Int -> EventCode -> ShowS
$cshow :: EventCode -> FilePath
show :: EventCode -> FilePath
$cshowList :: [EventCode] -> ShowS
showList :: [EventCode] -> ShowS
Show, ReadPrec [EventCode]
ReadPrec EventCode
Int -> ReadS EventCode
ReadS [EventCode]
(Int -> ReadS EventCode)
-> ReadS [EventCode]
-> ReadPrec EventCode
-> ReadPrec [EventCode]
-> Read EventCode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS EventCode
readsPrec :: Int -> ReadS EventCode
$creadList :: ReadS [EventCode]
readList :: ReadS [EventCode]
$creadPrec :: ReadPrec EventCode
readPrec :: ReadPrec EventCode
$creadListPrec :: ReadPrec [EventCode]
readListPrec :: ReadPrec [EventCode]
Read, Int -> EventCode
EventCode -> Int
EventCode -> [EventCode]
EventCode -> EventCode
EventCode -> EventCode -> [EventCode]
EventCode -> EventCode -> EventCode -> [EventCode]
(EventCode -> EventCode)
-> (EventCode -> EventCode)
-> (Int -> EventCode)
-> (EventCode -> Int)
-> (EventCode -> [EventCode])
-> (EventCode -> EventCode -> [EventCode])
-> (EventCode -> EventCode -> [EventCode])
-> (EventCode -> EventCode -> EventCode -> [EventCode])
-> Enum EventCode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: EventCode -> EventCode
succ :: EventCode -> EventCode
$cpred :: EventCode -> EventCode
pred :: EventCode -> EventCode
$ctoEnum :: Int -> EventCode
toEnum :: Int -> EventCode
$cfromEnum :: EventCode -> Int
fromEnum :: EventCode -> Int
$cenumFrom :: EventCode -> [EventCode]
enumFrom :: EventCode -> [EventCode]
$cenumFromThen :: EventCode -> EventCode -> [EventCode]
enumFromThen :: EventCode -> EventCode -> [EventCode]
$cenumFromTo :: EventCode -> EventCode -> [EventCode]
enumFromTo :: EventCode -> EventCode -> [EventCode]
$cenumFromThenTo :: EventCode -> EventCode -> EventCode -> [EventCode]
enumFromThenTo :: EventCode -> EventCode -> EventCode -> [EventCode]
Enum)
-- | A direct representation of the /value/ field of the C /input_event/, for when there is no obvious meaningful sum type.
newtype EventValue = EventValue Int32
    deriving (EventValue -> EventValue -> Bool
(EventValue -> EventValue -> Bool)
-> (EventValue -> EventValue -> Bool) -> Eq EventValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventValue -> EventValue -> Bool
== :: EventValue -> EventValue -> Bool
$c/= :: EventValue -> EventValue -> Bool
/= :: EventValue -> EventValue -> Bool
Eq, Eq EventValue
Eq EventValue =>
(EventValue -> EventValue -> Ordering)
-> (EventValue -> EventValue -> Bool)
-> (EventValue -> EventValue -> Bool)
-> (EventValue -> EventValue -> Bool)
-> (EventValue -> EventValue -> Bool)
-> (EventValue -> EventValue -> EventValue)
-> (EventValue -> EventValue -> EventValue)
-> Ord EventValue
EventValue -> EventValue -> Bool
EventValue -> EventValue -> Ordering
EventValue -> EventValue -> EventValue
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EventValue -> EventValue -> Ordering
compare :: EventValue -> EventValue -> Ordering
$c< :: EventValue -> EventValue -> Bool
< :: EventValue -> EventValue -> Bool
$c<= :: EventValue -> EventValue -> Bool
<= :: EventValue -> EventValue -> Bool
$c> :: EventValue -> EventValue -> Bool
> :: EventValue -> EventValue -> Bool
$c>= :: EventValue -> EventValue -> Bool
>= :: EventValue -> EventValue -> Bool
$cmax :: EventValue -> EventValue -> EventValue
max :: EventValue -> EventValue -> EventValue
$cmin :: EventValue -> EventValue -> EventValue
min :: EventValue -> EventValue -> EventValue
Ord, Int -> EventValue -> ShowS
[EventValue] -> ShowS
EventValue -> FilePath
(Int -> EventValue -> ShowS)
-> (EventValue -> FilePath)
-> ([EventValue] -> ShowS)
-> Show EventValue
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventValue -> ShowS
showsPrec :: Int -> EventValue -> ShowS
$cshow :: EventValue -> FilePath
show :: EventValue -> FilePath
$cshowList :: [EventValue] -> ShowS
showList :: [EventValue] -> ShowS
Show, ReadPrec [EventValue]
ReadPrec EventValue
Int -> ReadS EventValue
ReadS [EventValue]
(Int -> ReadS EventValue)
-> ReadS [EventValue]
-> ReadPrec EventValue
-> ReadPrec [EventValue]
-> Read EventValue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS EventValue
readsPrec :: Int -> ReadS EventValue
$creadList :: ReadS [EventValue]
readList :: ReadS [EventValue]
$creadPrec :: ReadPrec EventValue
readPrec :: ReadPrec EventValue
$creadListPrec :: ReadPrec [EventValue]
readListPrec :: ReadPrec [EventValue]
Read, Int -> EventValue
EventValue -> Int
EventValue -> [EventValue]
EventValue -> EventValue
EventValue -> EventValue -> [EventValue]
EventValue -> EventValue -> EventValue -> [EventValue]
(EventValue -> EventValue)
-> (EventValue -> EventValue)
-> (Int -> EventValue)
-> (EventValue -> Int)
-> (EventValue -> [EventValue])
-> (EventValue -> EventValue -> [EventValue])
-> (EventValue -> EventValue -> [EventValue])
-> (EventValue -> EventValue -> EventValue -> [EventValue])
-> Enum EventValue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: EventValue -> EventValue
succ :: EventValue -> EventValue
$cpred :: EventValue -> EventValue
pred :: EventValue -> EventValue
$ctoEnum :: Int -> EventValue
toEnum :: Int -> EventValue
$cfromEnum :: EventValue -> Int
fromEnum :: EventValue -> Int
$cenumFrom :: EventValue -> [EventValue]
enumFrom :: EventValue -> [EventValue]
$cenumFromThen :: EventValue -> EventValue -> [EventValue]
enumFromThen :: EventValue -> EventValue -> [EventValue]
$cenumFromTo :: EventValue -> EventValue -> [EventValue]
enumFromTo :: EventValue -> EventValue -> [EventValue]
$cenumFromThenTo :: EventValue -> EventValue -> EventValue -> [EventValue]
enumFromThenTo :: EventValue -> EventValue -> EventValue -> [EventValue]
Enum)

-- | The status of a key.
data KeyEvent
    = Released
    | Pressed
    | Repeated
    deriving (KeyEvent
KeyEvent -> KeyEvent -> Bounded KeyEvent
forall a. a -> a -> Bounded a
$cminBound :: KeyEvent
minBound :: KeyEvent
$cmaxBound :: KeyEvent
maxBound :: KeyEvent
Bounded, Int -> KeyEvent
KeyEvent -> Int
KeyEvent -> [KeyEvent]
KeyEvent -> KeyEvent
KeyEvent -> KeyEvent -> [KeyEvent]
KeyEvent -> KeyEvent -> KeyEvent -> [KeyEvent]
(KeyEvent -> KeyEvent)
-> (KeyEvent -> KeyEvent)
-> (Int -> KeyEvent)
-> (KeyEvent -> Int)
-> (KeyEvent -> [KeyEvent])
-> (KeyEvent -> KeyEvent -> [KeyEvent])
-> (KeyEvent -> KeyEvent -> [KeyEvent])
-> (KeyEvent -> KeyEvent -> KeyEvent -> [KeyEvent])
-> Enum KeyEvent
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: KeyEvent -> KeyEvent
succ :: KeyEvent -> KeyEvent
$cpred :: KeyEvent -> KeyEvent
pred :: KeyEvent -> KeyEvent
$ctoEnum :: Int -> KeyEvent
toEnum :: Int -> KeyEvent
$cfromEnum :: KeyEvent -> Int
fromEnum :: KeyEvent -> Int
$cenumFrom :: KeyEvent -> [KeyEvent]
enumFrom :: KeyEvent -> [KeyEvent]
$cenumFromThen :: KeyEvent -> KeyEvent -> [KeyEvent]
enumFromThen :: KeyEvent -> KeyEvent -> [KeyEvent]
$cenumFromTo :: KeyEvent -> KeyEvent -> [KeyEvent]
enumFromTo :: KeyEvent -> KeyEvent -> [KeyEvent]
$cenumFromThenTo :: KeyEvent -> KeyEvent -> KeyEvent -> [KeyEvent]
enumFromThenTo :: KeyEvent -> KeyEvent -> KeyEvent -> [KeyEvent]
Enum, KeyEvent -> KeyEvent -> Bool
(KeyEvent -> KeyEvent -> Bool)
-> (KeyEvent -> KeyEvent -> Bool) -> Eq KeyEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyEvent -> KeyEvent -> Bool
== :: KeyEvent -> KeyEvent -> Bool
$c/= :: KeyEvent -> KeyEvent -> Bool
/= :: KeyEvent -> KeyEvent -> Bool
Eq, Eq KeyEvent
Eq KeyEvent =>
(KeyEvent -> KeyEvent -> Ordering)
-> (KeyEvent -> KeyEvent -> Bool)
-> (KeyEvent -> KeyEvent -> Bool)
-> (KeyEvent -> KeyEvent -> Bool)
-> (KeyEvent -> KeyEvent -> Bool)
-> (KeyEvent -> KeyEvent -> KeyEvent)
-> (KeyEvent -> KeyEvent -> KeyEvent)
-> Ord KeyEvent
KeyEvent -> KeyEvent -> Bool
KeyEvent -> KeyEvent -> Ordering
KeyEvent -> KeyEvent -> KeyEvent
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: KeyEvent -> KeyEvent -> Ordering
compare :: KeyEvent -> KeyEvent -> Ordering
$c< :: KeyEvent -> KeyEvent -> Bool
< :: KeyEvent -> KeyEvent -> Bool
$c<= :: KeyEvent -> KeyEvent -> Bool
<= :: KeyEvent -> KeyEvent -> Bool
$c> :: KeyEvent -> KeyEvent -> Bool
> :: KeyEvent -> KeyEvent -> Bool
$c>= :: KeyEvent -> KeyEvent -> Bool
>= :: KeyEvent -> KeyEvent -> Bool
$cmax :: KeyEvent -> KeyEvent -> KeyEvent
max :: KeyEvent -> KeyEvent -> KeyEvent
$cmin :: KeyEvent -> KeyEvent -> KeyEvent
min :: KeyEvent -> KeyEvent -> KeyEvent
Ord, ReadPrec [KeyEvent]
ReadPrec KeyEvent
Int -> ReadS KeyEvent
ReadS [KeyEvent]
(Int -> ReadS KeyEvent)
-> ReadS [KeyEvent]
-> ReadPrec KeyEvent
-> ReadPrec [KeyEvent]
-> Read KeyEvent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS KeyEvent
readsPrec :: Int -> ReadS KeyEvent
$creadList :: ReadS [KeyEvent]
readList :: ReadS [KeyEvent]
$creadPrec :: ReadPrec KeyEvent
readPrec :: ReadPrec KeyEvent
$creadListPrec :: ReadPrec [KeyEvent]
readListPrec :: ReadPrec [KeyEvent]
Read, Int -> KeyEvent -> ShowS
[KeyEvent] -> ShowS
KeyEvent -> FilePath
(Int -> KeyEvent -> ShowS)
-> (KeyEvent -> FilePath) -> ([KeyEvent] -> ShowS) -> Show KeyEvent
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyEvent -> ShowS
showsPrec :: Int -> KeyEvent -> ShowS
$cshow :: KeyEvent -> FilePath
show :: KeyEvent -> FilePath
$cshowList :: [KeyEvent] -> ShowS
showList :: [KeyEvent] -> ShowS
Show)

convertFlags :: Set LL.ReadFlag -> CUInt
convertFlags :: Set ReadFlag -> CUInt
convertFlags = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Set ReadFlag -> Int) -> Set ReadFlag -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadFlag -> Int -> Int) -> Int -> Set ReadFlag -> Int
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.|.) (Int -> Int -> Int) -> (ReadFlag -> Int) -> ReadFlag -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadFlag -> Int
forall a. Enum a => a -> Int
fromEnum) Int
0

defaultReadFlags :: Set LL.ReadFlag
defaultReadFlags :: Set ReadFlag
defaultReadFlags = [ReadFlag] -> Set ReadFlag
forall a. Ord a => [a] -> Set a
Set.fromList [ReadFlag
LL.Normal, ReadFlag
LL.Blocking]

nonBlockingReadFlags :: Set LL.ReadFlag
nonBlockingReadFlags :: Set ReadFlag
nonBlockingReadFlags = [ReadFlag] -> Set ReadFlag
forall a. Ord a => [a] -> Set a
Set.fromList [ReadFlag
LL.Normal]

-- | Prevent other clients (including kernel-internal ones) from receiving events. Often a bad idea.
grabDevice :: Device -> IO ()
grabDevice :: Device -> IO ()
grabDevice = GrabMode -> Device -> IO ()
grabDevice' GrabMode
LL.LibevdevGrab
-- | Release a grabbed device.
ungrabDevice :: Device -> IO ()
ungrabDevice :: Device -> IO ()
ungrabDevice = GrabMode -> Device -> IO ()
grabDevice' GrabMode
LL.LibevdevUngrab

-- | Get the next event from the device.
nextEvent :: Device -> IO Event
nextEvent :: Device -> IO Event
nextEvent Device
dev =
    CEvent -> Event
fromCEvent (CEvent -> Event) -> IO CEvent -> IO Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
-> Device -> IO (Errno, CEvent) -> IO (CErrCallRes (Errno, CEvent))
forall a info.
(CErrCall a, CErrInfo info) =>
FilePath -> info -> IO a -> IO (CErrCallRes a)
forall info.
CErrInfo info =>
FilePath
-> info -> IO (Errno, CEvent) -> IO (CErrCallRes (Errno, CEvent))
cErrCall FilePath
"nextEvent" Device
dev (Device -> CUInt -> IO (Errno, CEvent)
LL.nextEvent (Device -> Device
cDevice Device
dev) (Set ReadFlag -> CUInt
convertFlags Set ReadFlag
defaultReadFlags))

{- | Get the next event from the device, if one is available.
Designed for use with devices created from a non-blocking file descriptor. Otherwise equal to @fmap Just . nextEvent@.
-}
nextEventMay :: Device -> IO (Maybe Event)
nextEventMay :: Device -> IO (Maybe Event)
nextEventMay Device
dev =
    (CEvent -> Event) -> Maybe CEvent -> Maybe Event
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CEvent -> Event
fromCEvent (Maybe CEvent -> Maybe Event)
-> IO (Maybe CEvent) -> IO (Maybe Event)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
-> Device
-> IO (Errno, Maybe CEvent)
-> IO (CErrCallRes (Errno, Maybe CEvent))
forall a info.
(CErrCall a, CErrInfo info) =>
FilePath -> info -> IO a -> IO (CErrCallRes a)
forall info.
CErrInfo info =>
FilePath
-> info
-> IO (Errno, Maybe CEvent)
-> IO (CErrCallRes (Errno, Maybe CEvent))
cErrCall FilePath
"nextEventMay" Device
dev (Device -> CUInt -> IO (Errno, Maybe CEvent)
LL.nextEventMay (Device -> Device
cDevice Device
dev) (Set ReadFlag -> CUInt
convertFlags Set ReadFlag
nonBlockingReadFlags))

fromCEvent :: LL.CEvent -> Event
fromCEvent :: CEvent -> Event
fromCEvent (LL.CEvent Word16
t Word16
c Int32
v CTimeVal
time) = EventData -> DiffTime -> Event
Event ((Word16, Word16, Int32) -> EventData
fromCEventData (Word16
t,Word16
c,Int32
v)) (DiffTime -> Event) -> DiffTime -> Event
forall a b. (a -> b) -> a -> b
$ CTimeVal -> DiffTime
fromCTimeVal CTimeVal
time

fromCEventData :: (Word16, Word16, Int32) -> EventData
fromCEventData :: (Word16, Word16, Int32) -> EventData
fromCEventData (Word16
t, Word16 -> EventCode
EventCode -> EventCode
c, Int32 -> EventValue
EventValue -> EventValue
v) = EventData -> Maybe EventData -> EventData
forall a. a -> Maybe a -> a
fromMaybe (Word16 -> EventCode -> EventValue -> EventData
UnknownEvent Word16
t EventCode
c EventValue
v) (Maybe EventData -> EventData) -> Maybe EventData -> EventData
forall a b. (a -> b) -> a -> b
$ Word16 -> Maybe EventType
forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' Word16
t Maybe EventType
-> (EventType -> Maybe EventData) -> Maybe EventData
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    EventType
EvSyn -> SyncEvent -> EventData
SyncEvent     (SyncEvent -> EventData) -> Maybe SyncEvent -> Maybe EventData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EventCode -> Maybe SyncEvent
forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c
    EventType
EvKey -> Key -> KeyEvent -> EventData
KeyEvent      (Key -> KeyEvent -> EventData)
-> Maybe Key -> Maybe (KeyEvent -> EventData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EventCode -> Maybe Key
forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c Maybe (KeyEvent -> EventData) -> Maybe KeyEvent -> Maybe EventData
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EventValue -> Maybe KeyEvent
forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventValue
v
    EventType
EvRel -> RelativeAxis -> EventValue -> EventData
RelativeEvent (RelativeAxis -> EventValue -> EventData)
-> Maybe RelativeAxis -> Maybe (EventValue -> EventData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EventCode -> Maybe RelativeAxis
forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c Maybe (EventValue -> EventData)
-> Maybe EventValue -> Maybe EventData
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EventValue -> Maybe EventValue
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EventValue
v
    EventType
EvAbs -> AbsoluteAxis -> EventValue -> EventData
AbsoluteEvent (AbsoluteAxis -> EventValue -> EventData)
-> Maybe AbsoluteAxis -> Maybe (EventValue -> EventData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EventCode -> Maybe AbsoluteAxis
forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c Maybe (EventValue -> EventData)
-> Maybe EventValue -> Maybe EventData
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EventValue -> Maybe EventValue
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EventValue
v
    EventType
EvMsc -> MiscEvent -> EventValue -> EventData
MiscEvent     (MiscEvent -> EventValue -> EventData)
-> Maybe MiscEvent -> Maybe (EventValue -> EventData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EventCode -> Maybe MiscEvent
forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c Maybe (EventValue -> EventData)
-> Maybe EventValue -> Maybe EventData
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EventValue -> Maybe EventValue
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EventValue
v
    EventType
EvSw  -> SwitchEvent -> EventValue -> EventData
SwitchEvent   (SwitchEvent -> EventValue -> EventData)
-> Maybe SwitchEvent -> Maybe (EventValue -> EventData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EventCode -> Maybe SwitchEvent
forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c Maybe (EventValue -> EventData)
-> Maybe EventValue -> Maybe EventData
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EventValue -> Maybe EventValue
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EventValue
v
    EventType
EvLed -> LEDEvent -> EventValue -> EventData
LEDEvent      (LEDEvent -> EventValue -> EventData)
-> Maybe LEDEvent -> Maybe (EventValue -> EventData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EventCode -> Maybe LEDEvent
forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c Maybe (EventValue -> EventData)
-> Maybe EventValue -> Maybe EventData
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EventValue -> Maybe EventValue
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EventValue
v
    EventType
EvSnd -> SoundEvent -> EventValue -> EventData
SoundEvent    (SoundEvent -> EventValue -> EventData)
-> Maybe SoundEvent -> Maybe (EventValue -> EventData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EventCode -> Maybe SoundEvent
forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c Maybe (EventValue -> EventData)
-> Maybe EventValue -> Maybe EventData
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EventValue -> Maybe EventValue
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EventValue
v
    EventType
EvRep -> RepeatEvent -> EventValue -> EventData
RepeatEvent   (RepeatEvent -> EventValue -> EventData)
-> Maybe RepeatEvent -> Maybe (EventValue -> EventData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EventCode -> Maybe RepeatEvent
forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c Maybe (EventValue -> EventData)
-> Maybe EventValue -> Maybe EventData
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EventValue -> Maybe EventValue
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EventValue
v
    EventType
EvFf  -> EventData -> Maybe EventData
forall a. a -> Maybe a
Just (EventData -> Maybe EventData) -> EventData -> Maybe EventData
forall a b. (a -> b) -> a -> b
$ EventCode -> EventValue -> EventData
ForceFeedbackEvent EventCode
c EventValue
v
    EventType
EvPwr -> EventData -> Maybe EventData
forall a. a -> Maybe a
Just (EventData -> Maybe EventData) -> EventData -> Maybe EventData
forall a b. (a -> b) -> a -> b
$ EventCode -> EventValue -> EventData
PowerEvent EventCode
c EventValue
v
    EventType
EvFfStatus -> EventData -> Maybe EventData
forall a. a -> Maybe a
Just (EventData -> Maybe EventData) -> EventData -> Maybe EventData
forall a b. (a -> b) -> a -> b
$ EventCode -> EventValue -> EventData
ForceFeedbackStatusEvent EventCode
c EventValue
v

toCEvent :: Event -> LL.CEvent
toCEvent :: Event -> CEvent
toCEvent (Event EventData
e DiffTime
time) = (Word16 -> Word16 -> Int32 -> CTimeVal -> CEvent)
-> (Word16, Word16, Int32) -> CTimeVal -> CEvent
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 Word16 -> Word16 -> Int32 -> CTimeVal -> CEvent
LL.CEvent (EventData -> (Word16, Word16, Int32)
toCEventData EventData
e) (CTimeVal -> CEvent) -> CTimeVal -> CEvent
forall a b. (a -> b) -> a -> b
$ DiffTime -> CTimeVal
toCTimeVal DiffTime
time

toCEventData :: EventData -> (Word16, Word16, Int32)
toCEventData :: EventData -> (Word16, Word16, Int32)
toCEventData = \case
    -- from kernel docs, 'EV_SYN event values are undefined' - we always seem to see 0, so may as well use that
    SyncEvent                (SyncEvent -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) -> (EventType -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvSyn, Word16
c, Int32
0)
    KeyEvent                 (Key -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (KeyEvent -> Int32
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (EventType -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvKey, Word16
c, Int32
v)
    RelativeEvent            (RelativeAxis -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (EventValue -> Int32
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (EventType -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvRel, Word16
c, Int32
v)
    AbsoluteEvent            (AbsoluteAxis -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (EventValue -> Int32
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (EventType -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvAbs, Word16
c, Int32
v)
    MiscEvent                (MiscEvent -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (EventValue -> Int32
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (EventType -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvMsc, Word16
c, Int32
v)
    SwitchEvent              (SwitchEvent -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (EventValue -> Int32
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (EventType -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvSw,  Word16
c, Int32
v)
    LEDEvent                 (LEDEvent -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (EventValue -> Int32
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (EventType -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvLed, Word16
c, Int32
v)
    SoundEvent               (SoundEvent -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (EventValue -> Int32
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (EventType -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvSnd, Word16
c, Int32
v)
    RepeatEvent              (RepeatEvent -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (EventValue -> Int32
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (EventType -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvRep, Word16
c, Int32
v)
    ForceFeedbackEvent       (EventCode -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (EventValue -> Int32
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (EventType -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvFf,  Word16
c, Int32
v)
    PowerEvent               (EventCode -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (EventValue -> Int32
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (EventType -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvPwr, Word16
c, Int32
v)
    ForceFeedbackStatusEvent (EventCode -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (EventValue -> Int32
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (EventType -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvFfStatus, Word16
c, Int32
v)
    UnknownEvent             (Word16 -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
t) (EventCode -> Word16
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (EventValue -> Int32
forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (Word16
t, Word16
c, Int32
v)

fromCTimeVal :: LL.CTimeVal -> DiffTime
fromCTimeVal :: CTimeVal -> DiffTime
fromCTimeVal (LL.CTimeVal Int64
s Int64
us) =
    Rational -> DiffTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> DiffTime) -> Rational -> DiffTime
forall a b. (a -> b) -> a -> b
$ Int64 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
s Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
us Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1_000_000)

--TODO QuickCheck inverse
toCTimeVal :: DiffTime -> LL.CTimeVal
toCTimeVal :: DiffTime -> CTimeVal
toCTimeVal DiffTime
t = Int64 -> Int64 -> CTimeVal
LL.CTimeVal Int64
n (DiffTime -> Int64
forall b. Integral b => DiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (DiffTime -> Int64) -> DiffTime -> Int64
forall a b. (a -> b) -> a -> b
$ DiffTime
f DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
1_000_000)
    where (Int64
n,DiffTime
f) = DiffTime -> (Int64, DiffTime)
forall b. Integral b => DiffTime -> (b, DiffTime)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction DiffTime
t

{- | Create a device from a valid path - usually /\/dev\/input\/eventX/ for some numeric /X/.
Use 'newDeviceFromFd' if you need more control over how the device is created.
-}
newDevice :: RawFilePath -> IO Device
newDevice :: RawFilePath -> IO Device
newDevice RawFilePath
path = Fd -> IO Device
newDeviceFromFd (Fd -> IO Device) -> IO Fd -> IO Device
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RawFilePath -> OpenMode -> OpenFileFlags -> IO Fd
openFd RawFilePath
path OpenMode
ReadWrite OpenFileFlags
defaultFileFlags

{- | Generalisation of 'newDevice', in case one needs control over the file descriptor,
e.g. in order to set a particular 'System.Posix.FileMode', 'System.Posix.OpenMode', or 'System.Posix.OpenFileFlags'.
Note that:

> newDevice path = newDeviceFromFd =<< openFd path ReadOnly Nothing defaultFileFlags

__WARNING__: Don't attempt to reuse the 'Fd' - it will be closed when the 'Device' is garbage collected.
-}
newDeviceFromFd :: Fd -> IO Device
newDeviceFromFd :: Fd -> IO Device
newDeviceFromFd Fd
fd = do
    Device
dev <- FilePath
-> () -> IO (Errno, Device) -> IO (CErrCallRes (Errno, Device))
forall a info.
(CErrCall a, CErrInfo info) =>
FilePath -> info -> IO a -> IO (CErrCallRes a)
forall info.
CErrInfo info =>
FilePath
-> info -> IO (Errno, Device) -> IO (CErrCallRes (Errno, Device))
cErrCall FilePath
"newDeviceFromFd" () (IO (Errno, Device) -> IO (CErrCallRes (Errno, Device)))
-> IO (Errno, Device) -> IO (CErrCallRes (Errno, Device))
forall a b. (a -> b) -> a -> b
$ Fd -> IO (Errno, Device)
LL.newDeviceFromFd Fd
fd
    ProcessID
pid <- IO ProcessID
getProcessID
    FilePath
path <- FilePath -> IO FilePath
readSymbolicLink (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"/proc/" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> ProcessID -> FilePath
forall a. Show a => a -> FilePath
show ProcessID
pid FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"/fd/" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Fd -> FilePath
forall a. Show a => a -> FilePath
show Fd
fd
    Device -> IO Device
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Device -> IO Device) -> Device -> IO Device
forall a b. (a -> b) -> a -> b
$ Device{cDevice :: Device
cDevice = Device
dev, devicePath :: RawFilePath
devicePath = FilePath -> RawFilePath
pack FilePath
path}

-- | The usual directory containing devices (/"\/dev\/input"/).
evdevDir :: RawFilePath
evdevDir :: RawFilePath
evdevDir = RawFilePath
"/dev/input"

deviceName :: Device -> IO ByteString
deviceName :: Device -> IO RawFilePath
deviceName = IO (IO RawFilePath) -> IO RawFilePath
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO RawFilePath) -> IO RawFilePath)
-> (Device -> IO (IO RawFilePath)) -> Device -> IO RawFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> IO (IO RawFilePath)
LL.deviceName (Device -> IO (IO RawFilePath))
-> (Device -> Device) -> Device -> IO (IO RawFilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> Device
cDevice

deviceFd :: Device -> IO Fd
deviceFd :: Device -> IO Fd
deviceFd = Device -> IO Fd
LL.deviceFd (Device -> IO Fd) -> (Device -> Device) -> Device -> IO Fd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> Device
cDevice
devicePhys :: Device -> IO (Maybe ByteString)
devicePhys :: Device -> IO (Maybe RawFilePath)
devicePhys = IO (IO (Maybe RawFilePath)) -> IO (Maybe RawFilePath)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO (Maybe RawFilePath)) -> IO (Maybe RawFilePath))
-> (Device -> IO (IO (Maybe RawFilePath)))
-> Device
-> IO (Maybe RawFilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> IO (IO (Maybe RawFilePath))
LL.devicePhys (Device -> IO (IO (Maybe RawFilePath)))
-> (Device -> Device) -> Device -> IO (IO (Maybe RawFilePath))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> Device
cDevice
deviceUniq :: Device -> IO (Maybe ByteString)
deviceUniq :: Device -> IO (Maybe RawFilePath)
deviceUniq = IO (IO (Maybe RawFilePath)) -> IO (Maybe RawFilePath)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO (Maybe RawFilePath)) -> IO (Maybe RawFilePath))
-> (Device -> IO (IO (Maybe RawFilePath)))
-> Device
-> IO (Maybe RawFilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> IO (IO (Maybe RawFilePath))
LL.deviceUniq (Device -> IO (IO (Maybe RawFilePath)))
-> (Device -> Device) -> Device -> IO (IO (Maybe RawFilePath))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> Device
cDevice
deviceProduct :: Device -> IO Int
deviceProduct :: Device -> IO Int
deviceProduct = Device -> IO Int
LL.deviceProduct (Device -> IO Int) -> (Device -> Device) -> Device -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> Device
cDevice
deviceVendor :: Device -> IO Int
deviceVendor :: Device -> IO Int
deviceVendor = Device -> IO Int
LL.deviceVendor (Device -> IO Int) -> (Device -> Device) -> Device -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> Device
cDevice
deviceBustype :: Device -> IO Int
deviceBustype :: Device -> IO Int
deviceBustype = Device -> IO Int
LL.deviceBustype (Device -> IO Int) -> (Device -> Device) -> Device -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> Device
cDevice
deviceVersion :: Device -> IO Int
deviceVersion :: Device -> IO Int
deviceVersion = Device -> IO Int
LL.deviceVersion (Device -> IO Int) -> (Device -> Device) -> Device -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> Device
cDevice

deviceProperties :: Device -> IO [DeviceProperty]
deviceProperties :: Device -> IO [DeviceProperty]
deviceProperties Device
dev = (DeviceProperty -> IO Bool)
-> [DeviceProperty] -> IO [DeviceProperty]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (Device -> DeviceProperty -> IO Bool
LL.hasProperty (Device -> DeviceProperty -> IO Bool)
-> Device -> DeviceProperty -> IO Bool
forall a b. (a -> b) -> a -> b
$ Device -> Device
cDevice Device
dev) [DeviceProperty]
forall a. (Enum a, Bounded a) => [a]
enumerate

deviceEventTypes :: Device -> IO [EventType]
deviceEventTypes :: Device -> IO [EventType]
deviceEventTypes Device
dev = (EventType -> IO Bool) -> [EventType] -> IO [EventType]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (Device -> EventType -> IO Bool
LL.hasEventType (Device -> EventType -> IO Bool) -> Device -> EventType -> IO Bool
forall a b. (a -> b) -> a -> b
$ Device -> Device
cDevice Device
dev) [EventType]
forall a. (Enum a, Bounded a) => [a]
enumerate

--TODO this is an imperfect API since '_val' is ignored entirely
deviceHasEvent :: Device -> EventData -> IO Bool
deviceHasEvent :: Device -> EventData -> IO Bool
deviceHasEvent Device
dev EventData
e = Device -> Word16 -> Word16 -> IO Bool
LL.hasEventCode (Device -> Device
cDevice Device
dev) Word16
typ Word16
code
  where (Word16
typ,Word16
code,Int32
_val) = EventData -> (Word16, Word16, Int32)
toCEventData EventData
e

deviceAbsAxis :: Device -> AbsoluteAxis -> IO (Maybe LL.AbsInfo)
deviceAbsAxis :: Device -> AbsoluteAxis -> IO (Maybe AbsInfo)
deviceAbsAxis Device
dev = Device -> Word32 -> IO (Maybe AbsInfo)
LL.getAbsInfo (Device -> Device
cDevice Device
dev) (Word32 -> IO (Maybe AbsInfo))
-> (AbsoluteAxis -> Word32) -> AbsoluteAxis -> IO (Maybe AbsInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsoluteAxis -> Word32
forall c a. (Num c, Enum a) => a -> c
fromEnum'

-- | Set the state of a LED on a device.
setDeviceLED :: Device -> LEDEvent -> LL.LEDValue -> IO ()
setDeviceLED :: Device -> LEDEvent -> LEDValue -> IO ()
setDeviceLED Device
dev LEDEvent
led LEDValue
val = FilePath -> Device -> IO Errno -> IO (CErrCallRes Errno)
forall a info.
(CErrCall a, CErrInfo info) =>
FilePath -> info -> IO a -> IO (CErrCallRes a)
forall info.
CErrInfo info =>
FilePath -> info -> IO Errno -> IO (CErrCallRes Errno)
cErrCall FilePath
"setDeviceLED" Device
dev (Device -> LEDEvent -> LEDValue -> IO Errno
LL.libevdev_kernel_set_led_value (Device -> Device
cDevice Device
dev) LEDEvent
led LEDValue
val)

{- Util -}

grabDevice' :: LL.GrabMode -> Device -> IO ()
grabDevice' :: GrabMode -> Device -> IO ()
grabDevice' GrabMode
mode Device
dev = FilePath -> Device -> IO Errno -> IO (CErrCallRes Errno)
forall a info.
(CErrCall a, CErrInfo info) =>
FilePath -> info -> IO a -> IO (CErrCallRes a)
forall info.
CErrInfo info =>
FilePath -> info -> IO Errno -> IO (CErrCallRes Errno)
cErrCall FilePath
"grabDevice" Device
dev (IO Errno -> IO (CErrCallRes Errno))
-> IO Errno -> IO (CErrCallRes Errno)
forall a b. (a -> b) -> a -> b
$
    Device -> GrabMode -> IO Errno
LL.grabDevice (Device -> Device
cDevice Device
dev) GrabMode
mode

{-
TODO this is a workaround until c2hs has a better story for enum conversions
    when we remove it we can get rid of '-fno-state-hack'

based on profiling, and Debug.Trace, it seems that 'enumMap' is computed no more times than necessary
    (6 - number of combinations of a and k that it is called with)
    but based on https://www.reddit.com/r/haskell/comments/grskne/help_reasoning_about_performance_memoization/,
        it's possible that behaviour is worse without profiling on (argh...)

open c2hs issue
    we perhaps essentially want the `CEnum` class proposed at: https://github.com/haskell/c2hs/issues/78
        but perhaps belonging (at least initially) in c2hs rather than base, for expediency
        this doesn't necessarily consider enum defines though - discussion is around capturing the semantics of actual C enums
    alternatively, monomorphic functions for each type, as with c2hs's with* functions
-}
toEnum' :: forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' :: forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' = (Map k a
enumMap !?)
  where
    --TODO HashMap, IntMap?
    enumMap :: Map k a
    enumMap :: Map k a
enumMap = [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, a)] -> Map k a) -> [(k, a)] -> Map k a
forall a b. (a -> b) -> a -> b
$ (a -> (k, a)) -> [a] -> [(k, a)]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> k
forall a. Enum a => Int -> a
toEnum (Int -> k) -> (a -> Int) -> a -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum (a -> k) -> (a -> a) -> a -> (k, a)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& a -> a
forall a. a -> a
id) [a]
forall a. (Enum a, Bounded a) => [a]
enumerate

instance CErrInfo Device where
    cErrInfo :: Device -> IO (Maybe RawFilePath)
cErrInfo = Maybe RawFilePath -> IO (Maybe RawFilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe RawFilePath -> IO (Maybe RawFilePath))
-> (Device -> Maybe RawFilePath)
-> Device
-> IO (Maybe RawFilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawFilePath -> Maybe RawFilePath
forall a. a -> Maybe a
Just (RawFilePath -> Maybe RawFilePath)
-> (Device -> RawFilePath) -> Device -> Maybe RawFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> RawFilePath
devicePath