{-# 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 = forall a. Show a => a -> FilePath
show 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
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
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
Ord, Int -> Event -> ShowS
[Event] -> ShowS
Event -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> FilePath
$cshow :: Event -> FilePath
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show)

-- | 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
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
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
Ord, Int -> EventData -> ShowS
[EventData] -> ShowS
EventData -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [EventData] -> ShowS
$cshowList :: [EventData] -> ShowS
show :: EventData -> FilePath
$cshow :: EventData -> FilePath
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 (EventCode -> EventCode -> Bool
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
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
Ord, Int -> EventCode -> ShowS
[EventCode] -> ShowS
EventCode -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [EventCode] -> ShowS
$cshowList :: [EventCode] -> ShowS
show :: EventCode -> FilePath
$cshow :: EventCode -> FilePath
showsPrec :: Int -> EventCode -> ShowS
$cshowsPrec :: Int -> EventCode -> ShowS
Show, Int -> EventCode
EventCode -> Int
EventCode -> [EventCode]
EventCode -> EventCode
EventCode -> EventCode -> [EventCode]
EventCode -> EventCode -> EventCode -> [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)
-- | 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
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
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
Ord, Int -> EventValue -> ShowS
[EventValue] -> ShowS
EventValue -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [EventValue] -> ShowS
$cshowList :: [EventValue] -> ShowS
show :: EventValue -> FilePath
$cshow :: EventValue -> FilePath
showsPrec :: Int -> EventValue -> ShowS
$cshowsPrec :: Int -> EventValue -> ShowS
Show, Int -> EventValue
EventValue -> Int
EventValue -> [EventValue]
EventValue -> EventValue
EventValue -> EventValue -> [EventValue]
EventValue -> EventValue -> EventValue -> [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)

-- | The status of a key.
data KeyEvent
    = Released
    | Pressed
    | Repeated
    deriving (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]
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
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
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
Ord, ReadPrec [KeyEvent]
ReadPrec KeyEvent
Int -> ReadS KeyEvent
ReadS [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 -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [KeyEvent] -> ShowS
$cshowList :: [KeyEvent] -> ShowS
show :: KeyEvent -> FilePath
$cshow :: KeyEvent -> FilePath
showsPrec :: Int -> KeyEvent -> ShowS
$cshowsPrec :: Int -> KeyEvent -> ShowS
Show)

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

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

nonBlockingReadFlags :: Set LL.ReadFlag
nonBlockingReadFlags :: Set ReadFlag
nonBlockingReadFlags = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a info.
(CErrCall a, CErrInfo info) =>
FilePath -> info -> IO a -> IO (CErrCallRes a)
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 =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CEvent -> Event
fromCEvent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a info.
(CErrCall a, CErrInfo info) =>
FilePath -> info -> IO a -> IO (CErrCallRes a)
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)) 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) = forall a. a -> Maybe a -> a
fromMaybe (Word16 -> EventCode -> EventValue -> EventData
UnknownEvent Word16
t EventCode
c EventValue
v) forall a b. (a -> b) -> a -> b
$ forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' Word16
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    EventType
EvSyn -> SyncEvent -> EventData
SyncEvent     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c
    EventType
EvKey -> Key -> KeyEvent -> EventData
KeyEvent      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventValue
v
    EventType
EvRel -> RelativeAxis -> EventValue -> EventData
RelativeEvent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventValue
v
    EventType
EvAbs -> AbsoluteAxis -> EventValue -> EventData
AbsoluteEvent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventValue
v
    EventType
EvMsc -> MiscEvent -> EventValue -> EventData
MiscEvent     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventValue
v
    EventType
EvSw  -> SwitchEvent -> EventValue -> EventData
SwitchEvent   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventValue
v
    EventType
EvLed -> LEDEvent -> EventValue -> EventData
LEDEvent      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventValue
v
    EventType
EvSnd -> SoundEvent -> EventValue -> EventData
SoundEvent    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventValue
v
    EventType
EvRep -> RepeatEvent -> EventValue -> EventData
RepeatEvent   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. (Ord k, Enum k, Bounded a, Enum a) => k -> Maybe a
toEnum' EventCode
c forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventValue
v
    EventType
EvFf  -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ EventCode -> EventValue -> EventData
ForceFeedbackEvent EventCode
c EventValue
v
    EventType
EvPwr -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ EventCode -> EventValue -> EventData
PowerEvent EventCode
c EventValue
v
    EventType
EvFfStatus -> forall a. a -> Maybe a
Just 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) = 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) 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                (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) -> (forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvSyn, Word16
c, Int32
0)
    KeyEvent                 (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvKey, Word16
c, Int32
v)
    RelativeEvent            (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvRel, Word16
c, Int32
v)
    AbsoluteEvent            (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvAbs, Word16
c, Int32
v)
    MiscEvent                (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvMsc, Word16
c, Int32
v)
    SwitchEvent              (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvSw,  Word16
c, Int32
v)
    LEDEvent                 (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvLed, Word16
c, Int32
v)
    SoundEvent               (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvSnd, Word16
c, Int32
v)
    RepeatEvent              (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvRep, Word16
c, Int32
v)
    ForceFeedbackEvent       (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvFf,  Word16
c, Int32
v)
    PowerEvent               (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvPwr, Word16
c, Int32
v)
    ForceFeedbackStatusEvent (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Int32
v) -> (forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
EvFfStatus, Word16
c, Int32
v)
    UnknownEvent             (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
t) (forall c a. (Num c, Enum a) => a -> c
fromEnum' -> Word16
c) (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) =
    forall a. Fractional a => Rational -> a
fromRational forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
s forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
us 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 (forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ DiffTime
f forall a. Num a => a -> a -> a
* DiffTime
1_000_000)
    where (Int64
n,DiffTime
f) = 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 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RawFilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd
openFd RawFilePath
path OpenMode
ReadWrite forall a. Maybe a
Nothing 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 <- forall a info.
(CErrCall a, CErrInfo info) =>
FilePath -> info -> IO a -> IO (CErrCallRes a)
cErrCall FilePath
"newDeviceFromFd" () 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 forall a b. (a -> b) -> a -> b
$ FilePath
"/proc/" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show ProcessID
pid forall a. Semigroup a => a -> a -> a
<> FilePath
"/fd/" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Fd
fd
    forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> IO (IO RawFilePath)
LL.deviceName 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> Device
cDevice
devicePhys :: Device -> IO (Maybe ByteString)
devicePhys :: Device -> IO (Maybe RawFilePath)
devicePhys = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> IO (IO (Maybe RawFilePath))
LL.devicePhys forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> Device
cDevice
deviceUniq :: Device -> IO (Maybe ByteString)
deviceUniq :: Device -> IO (Maybe RawFilePath)
deviceUniq = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> IO (IO (Maybe RawFilePath))
LL.deviceUniq 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 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 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> Device
cDevice

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

deviceEventTypes :: Device -> IO [EventType]
deviceEventTypes :: Device -> IO [EventType]
deviceEventTypes Device
dev = forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (Device -> EventType -> IO Bool
LL.hasEventType forall a b. (a -> b) -> a -> b
$ Device -> Device
cDevice Device
dev) 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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a info.
(CErrCall a, CErrInfo info) =>
FilePath -> info -> IO a -> IO (CErrCallRes a)
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 = forall a info.
(CErrCall a, CErrInfo info) =>
FilePath -> info -> IO a -> IO (CErrCallRes a)
cErrCall FilePath
"grabDevice" Device
dev 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 forall k a. Ord k => Map k a -> k -> Maybe a
!?)
  where
    --TODO HashMap, IntMap?
    enumMap :: Map k a
    enumMap :: Map k a
enumMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id) forall a. (Enum a, Bounded a) => [a]
enumerate

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