{-# 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,
    deviceFd,
    -- ** Grabbing
    grabDevice,
    ungrabDevice,

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

    -- * Lower-level 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,
    LL.CTimeVal(..),
    toCTimeVal,
    fromCTimeVal,
) where

import Control.Arrow ((&&&))
import Control.Monad (filterM,join)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
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.Word (Word16)
import Foreign ((.|.))
import Foreign.C (CUInt)
import Foreign.C.Error (Errno(Errno),errnoToIOError)
import System.Posix.ByteString (Fd,RawFilePath)
import System.Posix.IO.ByteString (fdToHandle)

import qualified Evdev.LowLevel as LL
import Evdev.Codes

-- 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 :: RawFilePath }
instance Show Device where
    show :: Device -> String
show = RawFilePath -> String
forall a. Show a => a -> String
show (RawFilePath -> String)
-> (Device -> RawFilePath) -> Device -> String
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
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: 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
min :: Event -> Event -> Event
$cmin :: Event -> Event -> Event
max :: Event -> Event -> Event
$cmax :: Event -> Event -> Event
>= :: Event -> Event -> Bool
$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
compare :: Event -> Event -> Ordering
$ccompare :: Event -> Event -> Ordering
$cp1Ord :: Eq Event
Ord, Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show)

--TODO name?
-- | 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
/= :: EventData -> EventData -> Bool
$c/= :: EventData -> EventData -> Bool
== :: EventData -> EventData -> Bool
$c== :: 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
min :: EventData -> EventData -> EventData
$cmin :: EventData -> EventData -> EventData
max :: EventData -> EventData -> EventData
$cmax :: EventData -> EventData -> EventData
>= :: EventData -> EventData -> Bool
$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
compare :: EventData -> EventData -> Ordering
$ccompare :: EventData -> EventData -> Ordering
$cp1Ord :: Eq EventData
Ord, 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
readListPrec :: ReadPrec [EventData]
$creadListPrec :: ReadPrec [EventData]
readPrec :: ReadPrec EventData
$creadPrec :: ReadPrec EventData
readList :: ReadS [EventData]
$creadList :: ReadS [EventData]
readsPrec :: Int -> ReadS EventData
$creadsPrec :: Int -> ReadS EventData
Read, Int -> EventData -> ShowS
[EventData] -> ShowS
EventData -> String
(Int -> EventData -> ShowS)
-> (EventData -> String)
-> ([EventData] -> ShowS)
-> Show EventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventData] -> ShowS
$cshowList :: [EventData] -> ShowS
show :: EventData -> String
$cshow :: EventData -> String
showsPrec :: Int -> EventData -> ShowS
$cshowsPrec :: Int -> EventData -> ShowS
Show)

-- | 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 stock (EventCode -> EventCode -> Bool
(EventCode -> EventCode -> Bool)
-> (EventCode -> EventCode -> Bool) -> Eq EventCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventCode -> EventCode -> Bool
$c/= :: EventCode -> EventCode -> Bool
== :: EventCode -> EventCode -> Bool
$c== :: 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
min :: EventCode -> EventCode -> EventCode
$cmin :: EventCode -> EventCode -> EventCode
max :: EventCode -> EventCode -> EventCode
$cmax :: EventCode -> EventCode -> EventCode
>= :: EventCode -> EventCode -> Bool
$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
compare :: EventCode -> EventCode -> Ordering
$ccompare :: EventCode -> EventCode -> Ordering
$cp1Ord :: Eq EventCode
Ord, 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
readListPrec :: ReadPrec [EventCode]
$creadListPrec :: ReadPrec [EventCode]
readPrec :: ReadPrec EventCode
$creadPrec :: ReadPrec EventCode
readList :: ReadS [EventCode]
$creadList :: ReadS [EventCode]
readsPrec :: Int -> ReadS EventCode
$creadsPrec :: Int -> ReadS EventCode
Read, Int -> EventCode -> ShowS
[EventCode] -> ShowS
EventCode -> String
(Int -> EventCode -> ShowS)
-> (EventCode -> String)
-> ([EventCode] -> ShowS)
-> Show EventCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventCode] -> ShowS
$cshowList :: [EventCode] -> ShowS
show :: EventCode -> String
$cshow :: EventCode -> String
showsPrec :: Int -> EventCode -> ShowS
$cshowsPrec :: Int -> EventCode -> ShowS
Show)
    deriving newtype (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
enumFromThenTo :: EventCode -> EventCode -> EventCode -> [EventCode]
$cenumFromThenTo :: EventCode -> EventCode -> EventCode -> [EventCode]
enumFromTo :: EventCode -> EventCode -> [EventCode]
$cenumFromTo :: EventCode -> EventCode -> [EventCode]
enumFromThen :: EventCode -> EventCode -> [EventCode]
$cenumFromThen :: EventCode -> EventCode -> [EventCode]
enumFrom :: EventCode -> [EventCode]
$cenumFrom :: EventCode -> [EventCode]
fromEnum :: EventCode -> Int
$cfromEnum :: EventCode -> Int
toEnum :: Int -> EventCode
$ctoEnum :: Int -> EventCode
pred :: EventCode -> EventCode
$cpred :: EventCode -> EventCode
succ :: EventCode -> EventCode
$csucc :: EventCode -> EventCode
Enum, Enum EventCode
Real EventCode
Real EventCode
-> Enum EventCode
-> (EventCode -> EventCode -> EventCode)
-> (EventCode -> EventCode -> EventCode)
-> (EventCode -> EventCode -> EventCode)
-> (EventCode -> EventCode -> EventCode)
-> (EventCode -> EventCode -> (EventCode, EventCode))
-> (EventCode -> EventCode -> (EventCode, EventCode))
-> (EventCode -> Integer)
-> Integral EventCode
EventCode -> Integer
EventCode -> EventCode -> (EventCode, EventCode)
EventCode -> EventCode -> EventCode
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: EventCode -> Integer
$ctoInteger :: EventCode -> Integer
divMod :: EventCode -> EventCode -> (EventCode, EventCode)
$cdivMod :: EventCode -> EventCode -> (EventCode, EventCode)
quotRem :: EventCode -> EventCode -> (EventCode, EventCode)
$cquotRem :: EventCode -> EventCode -> (EventCode, EventCode)
mod :: EventCode -> EventCode -> EventCode
$cmod :: EventCode -> EventCode -> EventCode
div :: EventCode -> EventCode -> EventCode
$cdiv :: EventCode -> EventCode -> EventCode
rem :: EventCode -> EventCode -> EventCode
$crem :: EventCode -> EventCode -> EventCode
quot :: EventCode -> EventCode -> EventCode
$cquot :: EventCode -> EventCode -> EventCode
$cp2Integral :: Enum EventCode
$cp1Integral :: Real EventCode
Integral, Num EventCode
Ord EventCode
Num EventCode
-> Ord EventCode -> (EventCode -> Rational) -> Real EventCode
EventCode -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: EventCode -> Rational
$ctoRational :: EventCode -> Rational
$cp2Real :: Ord EventCode
$cp1Real :: Num EventCode
Real, Integer -> EventCode
EventCode -> EventCode
EventCode -> EventCode -> EventCode
(EventCode -> EventCode -> EventCode)
-> (EventCode -> EventCode -> EventCode)
-> (EventCode -> EventCode -> EventCode)
-> (EventCode -> EventCode)
-> (EventCode -> EventCode)
-> (EventCode -> EventCode)
-> (Integer -> EventCode)
-> Num EventCode
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> EventCode
$cfromInteger :: Integer -> EventCode
signum :: EventCode -> EventCode
$csignum :: EventCode -> EventCode
abs :: EventCode -> EventCode
$cabs :: EventCode -> EventCode
negate :: EventCode -> EventCode
$cnegate :: EventCode -> EventCode
* :: EventCode -> EventCode -> EventCode
$c* :: EventCode -> EventCode -> EventCode
- :: EventCode -> EventCode -> EventCode
$c- :: EventCode -> EventCode -> EventCode
+ :: EventCode -> EventCode -> EventCode
$c+ :: EventCode -> EventCode -> EventCode
Num) --TODO all this baggage to make 'toEnum'' slightly easier?
-- | 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 stock (EventValue -> EventValue -> Bool
(EventValue -> EventValue -> Bool)
-> (EventValue -> EventValue -> Bool) -> Eq EventValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventValue -> EventValue -> Bool
$c/= :: EventValue -> EventValue -> Bool
== :: EventValue -> EventValue -> Bool
$c== :: 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
min :: EventValue -> EventValue -> EventValue
$cmin :: EventValue -> EventValue -> EventValue
max :: EventValue -> EventValue -> EventValue
$cmax :: EventValue -> EventValue -> EventValue
>= :: EventValue -> EventValue -> Bool
$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
compare :: EventValue -> EventValue -> Ordering
$ccompare :: EventValue -> EventValue -> Ordering
$cp1Ord :: Eq EventValue
Ord, 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
readListPrec :: ReadPrec [EventValue]
$creadListPrec :: ReadPrec [EventValue]
readPrec :: ReadPrec EventValue
$creadPrec :: ReadPrec EventValue
readList :: ReadS [EventValue]
$creadList :: ReadS [EventValue]
readsPrec :: Int -> ReadS EventValue
$creadsPrec :: Int -> ReadS EventValue
Read, Int -> EventValue -> ShowS
[EventValue] -> ShowS
EventValue -> String
(Int -> EventValue -> ShowS)
-> (EventValue -> String)
-> ([EventValue] -> ShowS)
-> Show EventValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventValue] -> ShowS
$cshowList :: [EventValue] -> ShowS
show :: EventValue -> String
$cshow :: EventValue -> String
showsPrec :: Int -> EventValue -> ShowS
$cshowsPrec :: Int -> EventValue -> ShowS
Show)
    deriving newtype (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
enumFromThenTo :: EventValue -> EventValue -> EventValue -> [EventValue]
$cenumFromThenTo :: EventValue -> EventValue -> EventValue -> [EventValue]
enumFromTo :: EventValue -> EventValue -> [EventValue]
$cenumFromTo :: EventValue -> EventValue -> [EventValue]
enumFromThen :: EventValue -> EventValue -> [EventValue]
$cenumFromThen :: EventValue -> EventValue -> [EventValue]
enumFrom :: EventValue -> [EventValue]
$cenumFrom :: EventValue -> [EventValue]
fromEnum :: EventValue -> Int
$cfromEnum :: EventValue -> Int
toEnum :: Int -> EventValue
$ctoEnum :: Int -> EventValue
pred :: EventValue -> EventValue
$cpred :: EventValue -> EventValue
succ :: EventValue -> EventValue
$csucc :: EventValue -> EventValue
Enum, Enum EventValue
Real EventValue
Real EventValue
-> Enum EventValue
-> (EventValue -> EventValue -> EventValue)
-> (EventValue -> EventValue -> EventValue)
-> (EventValue -> EventValue -> EventValue)
-> (EventValue -> EventValue -> EventValue)
-> (EventValue -> EventValue -> (EventValue, EventValue))
-> (EventValue -> EventValue -> (EventValue, EventValue))
-> (EventValue -> Integer)
-> Integral EventValue
EventValue -> Integer
EventValue -> EventValue -> (EventValue, EventValue)
EventValue -> EventValue -> EventValue
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: EventValue -> Integer
$ctoInteger :: EventValue -> Integer
divMod :: EventValue -> EventValue -> (EventValue, EventValue)
$cdivMod :: EventValue -> EventValue -> (EventValue, EventValue)
quotRem :: EventValue -> EventValue -> (EventValue, EventValue)
$cquotRem :: EventValue -> EventValue -> (EventValue, EventValue)
mod :: EventValue -> EventValue -> EventValue
$cmod :: EventValue -> EventValue -> EventValue
div :: EventValue -> EventValue -> EventValue
$cdiv :: EventValue -> EventValue -> EventValue
rem :: EventValue -> EventValue -> EventValue
$crem :: EventValue -> EventValue -> EventValue
quot :: EventValue -> EventValue -> EventValue
$cquot :: EventValue -> EventValue -> EventValue
$cp2Integral :: Enum EventValue
$cp1Integral :: Real EventValue
Integral, Num EventValue
Ord EventValue
Num EventValue
-> Ord EventValue -> (EventValue -> Rational) -> Real EventValue
EventValue -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: EventValue -> Rational
$ctoRational :: EventValue -> Rational
$cp2Real :: Ord EventValue
$cp1Real :: Num EventValue
Real, Integer -> EventValue
EventValue -> EventValue
EventValue -> EventValue -> EventValue
(EventValue -> EventValue -> EventValue)
-> (EventValue -> EventValue -> EventValue)
-> (EventValue -> EventValue -> EventValue)
-> (EventValue -> EventValue)
-> (EventValue -> EventValue)
-> (EventValue -> EventValue)
-> (Integer -> EventValue)
-> Num EventValue
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> EventValue
$cfromInteger :: Integer -> EventValue
signum :: EventValue -> EventValue
$csignum :: EventValue -> EventValue
abs :: EventValue -> EventValue
$cabs :: EventValue -> EventValue
negate :: EventValue -> EventValue
$cnegate :: EventValue -> EventValue
* :: EventValue -> EventValue -> EventValue
$c* :: EventValue -> EventValue -> EventValue
- :: EventValue -> EventValue -> EventValue
$c- :: EventValue -> EventValue -> EventValue
+ :: EventValue -> EventValue -> EventValue
$c+ :: EventValue -> EventValue -> EventValue
Num)

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

-- | 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
<$> String
-> Either RawFilePath Device -> IO (Errno, CEvent) -> IO CEvent
forall a.
String -> Either RawFilePath Device -> IO (Errno, a) -> IO a
throwCErrors String
"nextEvent" (Device -> Either RawFilePath Device
forall a b. b -> Either a b
Right Device
dev) (Device -> CUInt -> IO (Errno, CEvent)
LL.nextEvent (Device -> Device
cDevice Device
dev) (Set ReadFlag -> CUInt
convertFlags Set ReadFlag
defaultReadFlags))

fromCEvent :: LL.CEvent -> Event
fromCEvent :: CEvent -> Event
fromCEvent (LL.CEvent Word16
t (Word16 -> EventCode
EventCode -> EventCode
c) (Int32 -> EventValue
EventValue -> EventValue
v) CTimeVal
time) = EventData -> DiffTime -> Event
Event EventData
event (DiffTime -> Event) -> DiffTime -> Event
forall a b. (a -> b) -> a -> b
$ CTimeVal -> DiffTime
fromCTimeVal CTimeVal
time
  where
    event :: EventData
event = EventData -> Maybe EventData -> EventData
forall a. a -> Maybe a -> a
fromMaybe EventData
unknown (Maybe EventData -> EventData) -> Maybe EventData -> EventData
forall a b. (a -> b) -> a -> b
$ Word16 -> Maybe EventType
forall k a. (Integral k, Bounded a, Enum a) => k -> Maybe a
toEnum' Word16
t Maybe EventType
-> (EventType -> Maybe EventData) -> Maybe EventData
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. (Integral 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. (Integral k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c Maybe (KeyEvent -> EventData) -> Maybe KeyEvent -> Maybe EventData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EventValue -> Maybe KeyEvent
forall k a. (Integral 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. (Integral k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c Maybe (EventValue -> EventData)
-> Maybe EventValue -> Maybe EventData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EventValue -> Maybe EventValue
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. (Integral k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c Maybe (EventValue -> EventData)
-> Maybe EventValue -> Maybe EventData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EventValue -> Maybe EventValue
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. (Integral k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c Maybe (EventValue -> EventData)
-> Maybe EventValue -> Maybe EventData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EventValue -> Maybe EventValue
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. (Integral k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c Maybe (EventValue -> EventData)
-> Maybe EventValue -> Maybe EventData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EventValue -> Maybe EventValue
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. (Integral k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c Maybe (EventValue -> EventData)
-> Maybe EventValue -> Maybe EventData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EventValue -> Maybe EventValue
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. (Integral k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c Maybe (EventValue -> EventData)
-> Maybe EventValue -> Maybe EventData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EventValue -> Maybe EventValue
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. (Integral k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c Maybe (EventValue -> EventData)
-> Maybe EventValue -> Maybe EventData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EventValue -> Maybe EventValue
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
    unknown :: EventData
unknown = Word16 -> EventCode -> EventValue -> EventData
UnknownEvent Word16
t EventCode
c EventValue
v

toCEvent :: Event -> LL.CEvent
toCEvent :: Event -> CEvent
toCEvent (Event EventData
e DiffTime
time) = case EventData
e of
    -- 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 a b. (Enum a, Integral b) => a -> b
fe -> Word16
c) -> Word16 -> Word16 -> Int32 -> CTimeVal -> CEvent
LL.CEvent (EventType -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe EventType
EvSyn) Word16
c Int32
0 CTimeVal
cTime
    KeyEvent                 (Key -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe -> Word16
c) (KeyEvent -> Int32
forall a b. (Enum a, Integral b) => a -> b
fe -> Int32
v) -> Word16 -> Word16 -> Int32 -> CTimeVal -> CEvent
LL.CEvent (EventType -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe EventType
EvKey) Word16
c Int32
v CTimeVal
cTime
    RelativeEvent            (RelativeAxis -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe -> Word16
c) (EventValue -> Int32
forall a b. (Enum a, Integral b) => a -> b
fe -> Int32
v) -> Word16 -> Word16 -> Int32 -> CTimeVal -> CEvent
LL.CEvent (EventType -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe EventType
EvRel) Word16
c Int32
v CTimeVal
cTime
    AbsoluteEvent            (AbsoluteAxis -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe -> Word16
c) (EventValue -> Int32
forall a b. (Enum a, Integral b) => a -> b
fe -> Int32
v) -> Word16 -> Word16 -> Int32 -> CTimeVal -> CEvent
LL.CEvent (EventType -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe EventType
EvAbs) Word16
c Int32
v CTimeVal
cTime
    MiscEvent                (MiscEvent -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe -> Word16
c) (EventValue -> Int32
forall a b. (Enum a, Integral b) => a -> b
fe -> Int32
v) -> Word16 -> Word16 -> Int32 -> CTimeVal -> CEvent
LL.CEvent (EventType -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe EventType
EvMsc) Word16
c Int32
v CTimeVal
cTime
    SwitchEvent              (SwitchEvent -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe -> Word16
c) (EventValue -> Int32
forall a b. (Enum a, Integral b) => a -> b
fe -> Int32
v) -> Word16 -> Word16 -> Int32 -> CTimeVal -> CEvent
LL.CEvent (EventType -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe EventType
EvSw)  Word16
c Int32
v CTimeVal
cTime
    LEDEvent                 (LEDEvent -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe -> Word16
c) (EventValue -> Int32
forall a b. (Enum a, Integral b) => a -> b
fe -> Int32
v) -> Word16 -> Word16 -> Int32 -> CTimeVal -> CEvent
LL.CEvent (EventType -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe EventType
EvLed) Word16
c Int32
v CTimeVal
cTime
    SoundEvent               (SoundEvent -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe -> Word16
c) (EventValue -> Int32
forall a b. (Enum a, Integral b) => a -> b
fe -> Int32
v) -> Word16 -> Word16 -> Int32 -> CTimeVal -> CEvent
LL.CEvent (EventType -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe EventType
EvSnd) Word16
c Int32
v CTimeVal
cTime
    RepeatEvent              (RepeatEvent -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe -> Word16
c) (EventValue -> Int32
forall a b. (Enum a, Integral b) => a -> b
fe -> Int32
v) -> Word16 -> Word16 -> Int32 -> CTimeVal -> CEvent
LL.CEvent (EventType -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe EventType
EvRep) Word16
c Int32
v CTimeVal
cTime
    ForceFeedbackEvent       (EventCode -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe -> Word16
c) (EventValue -> Int32
forall a b. (Enum a, Integral b) => a -> b
fe -> Int32
v) -> Word16 -> Word16 -> Int32 -> CTimeVal -> CEvent
LL.CEvent (EventType -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe EventType
EvFf)  Word16
c Int32
v CTimeVal
cTime
    PowerEvent               (EventCode -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe -> Word16
c) (EventValue -> Int32
forall a b. (Enum a, Integral b) => a -> b
fe -> Int32
v) -> Word16 -> Word16 -> Int32 -> CTimeVal -> CEvent
LL.CEvent (EventType -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe EventType
EvPwr) Word16
c Int32
v CTimeVal
cTime
    ForceFeedbackStatusEvent (EventCode -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe -> Word16
c) (EventValue -> Int32
forall a b. (Enum a, Integral b) => a -> b
fe -> Int32
v) -> Word16 -> Word16 -> Int32 -> CTimeVal -> CEvent
LL.CEvent (EventType -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe EventType
EvFfStatus) Word16
c Int32
v CTimeVal
cTime
    UnknownEvent             (Word16 -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe -> Word16
t) (EventCode -> Word16
forall a b. (Enum a, Integral b) => a -> b
fe -> Word16
c) (EventValue -> Int32
forall a b. (Enum a, Integral b) => a -> b
fe -> Int32
v) -> Word16 -> Word16 -> Int32 -> CTimeVal -> CEvent
LL.CEvent Word16
t Word16
c Int32
v CTimeVal
cTime
  where
    --TODO this isn't entirely safe in general, though it's really no worse than 'fromEnum'
    -- if we could tell C2HS which int type each #defined enum corresponded to, we could check this statically
    fe :: (Enum a, Integral b) => a -> b
    fe :: a -> b
fe = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> b) -> (a -> Int) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum
    cTime :: CTimeVal
cTime = DiffTime -> CTimeVal
toCTimeVal DiffTime
time

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 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 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 /X/.
newDevice :: RawFilePath -> IO Device
newDevice :: RawFilePath -> IO Device
newDevice RawFilePath
path = do
    Device
dev <- String
-> Either RawFilePath Device -> IO (Errno, Device) -> IO Device
forall a.
String -> Either RawFilePath Device -> IO (Errno, a) -> IO a
throwCErrors String
"newDevice" (RawFilePath -> Either RawFilePath Device
forall a b. a -> Either a b
Left RawFilePath
path) (IO (Errno, Device) -> IO Device)
-> IO (Errno, Device) -> IO Device
forall a b. (a -> b) -> a -> b
$ RawFilePath -> IO (Errno, Device)
LL.newDevice RawFilePath
path
    Device -> IO Device
forall (m :: * -> *) a. Monad m => a -> m a
return (Device -> IO Device) -> Device -> IO Device
forall a b. (a -> b) -> a -> b
$ Device -> RawFilePath -> Device
Device Device
dev RawFilePath
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

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


{- Util -}

-- run the action, throwing a relevant exception if the C errno is not 0
throwCErrors :: String -> Either ByteString Device -> IO (Errno, a) -> IO a
throwCErrors :: String -> Either RawFilePath Device -> IO (Errno, a) -> IO a
throwCErrors String
func Either RawFilePath Device
pathOrDev IO (Errno, a)
x = do
    (Errno
errno, a
res) <- IO (Errno, a)
x
    case Errno
errno of
        Errno CInt
0 -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
        Errno CInt
n -> do
            (Maybe Handle
handle,RawFilePath
path) <- case Either RawFilePath Device
pathOrDev of
                Left RawFilePath
path -> (Maybe Handle, RawFilePath) -> IO (Maybe Handle, RawFilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Handle
forall a. Maybe a
Nothing,RawFilePath
path)
                Right Device
dev -> do
                    Handle
h <- Fd -> IO Handle
fdToHandle (Fd -> IO Handle) -> IO Fd -> IO Handle
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Device -> IO Fd
deviceFd Device
dev
                    (Maybe Handle, RawFilePath) -> IO (Maybe Handle, RawFilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
h, Device -> RawFilePath
devicePath Device
dev)
            IOError -> IO a
forall a. IOError -> IO a
ioError (IOError -> IO a) -> IOError -> IO a
forall a b. (a -> b) -> a -> b
$ String -> Errno -> Maybe Handle -> Maybe String -> IOError
errnoToIOError String
func (CInt -> Errno
Errno (CInt -> Errno) -> CInt -> Errno
forall a b. (a -> b) -> a -> b
$ CInt -> CInt
forall a. Num a => a -> a
abs CInt
n) Maybe Handle
handle (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ RawFilePath -> String
BS.unpack RawFilePath
path)

grabDevice' :: LL.GrabMode -> Device -> IO ()
grabDevice' :: GrabMode -> Device -> IO ()
grabDevice' GrabMode
mode Device
dev = String -> Either RawFilePath Device -> IO (Errno, ()) -> IO ()
forall a.
String -> Either RawFilePath Device -> IO (Errno, a) -> IO a
throwCErrors String
"grabDevice" (Device -> Either RawFilePath Device
forall a b. b -> Either a b
Right Device
dev) (IO (Errno, ()) -> IO ()) -> IO (Errno, ()) -> IO ()
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. (Integral k, Bounded a, Enum a) => k -> Maybe a
toEnum' :: k -> Maybe a
toEnum' = (Map k a
enumMap Map k a -> k -> Maybe a
forall k a. Ord k => Map k a -> k -> Maybe a
!?)
  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 b. (Integral a, Num b) => a -> b
fromIntegral (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 (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