module Evdev where

import Control.Exception
import Data.Int
import Data.List.Extra
import Data.Either.Combinators
import Data.Time.Clock
import Data.Tuple.Extra

import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import Foreign ((.|.))
import Foreign.C (CUInt)
import Foreign.C.Error (Errno(Errno),errnoToIOError)
import System.Posix.ByteString (RawFilePath)

import qualified Evdev.LowLevel as LL
import Evdev.Codes --TODO combine modules?

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

data Event = Event {
    Event -> EventType
evType :: EventType,
    Event -> EventCode
evCode :: EventCode,
    Event -> EventValue
evValue :: EventValue,
    Event -> DiffTime
evTime :: 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)

-- aligns with the pattern synonyms below
prettyEvent :: Event -> String
prettyEvent :: Event -> String
prettyEvent x :: Event
x = DiffTime -> String
forall a. Show a => a -> String
showTime (Event -> DiffTime
evTime Event
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ case Event
x of
        SyncEvent t :: SyncEventType
t -> SyncEventType -> String
forall a. Show a => a -> String
show SyncEventType
t
        KeyEvent k :: Key
k t :: KeyEventType
t -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " [Key -> String
forall a. Show a => a -> String
show Key
k, KeyEventType -> String
forall a. Show a => a -> String
show KeyEventType
t]
        RelativeEvent c :: RelativeAxis
c v :: EventValue
v -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " [RelativeAxis -> String
forall a. Show a => a -> String
show RelativeAxis
c, EventValue -> String
forall e. Enum e => e -> String
showE EventValue
v]
        AbsoluteEvent c :: AbsoluteAxis
c v :: EventValue
v -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " [AbsoluteAxis -> String
forall a. Show a => a -> String
show AbsoluteAxis
c, EventValue -> String
forall e. Enum e => e -> String
showE EventValue
v]
        MiscEvent c :: MiscEventType
c v :: EventValue
v -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " [MiscEventType -> String
forall a. Show a => a -> String
show MiscEventType
c, EventValue -> String
forall e. Enum e => e -> String
showE EventValue
v]
        SwitchEvent c :: SwitchEventType
c v :: EventValue
v -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " [SwitchEventType -> String
forall a. Show a => a -> String
show SwitchEventType
c, EventValue -> String
forall e. Enum e => e -> String
showE EventValue
v]
        LEDEvent c :: LEDEventType
c v :: EventValue
v -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " [LEDEventType -> String
forall a. Show a => a -> String
show LEDEventType
c, EventValue -> String
forall e. Enum e => e -> String
showE EventValue
v]
        SoundEvent c :: SoundEventType
c v :: EventValue
v -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " [SoundEventType -> String
forall a. Show a => a -> String
show SoundEventType
c, EventValue -> String
forall e. Enum e => e -> String
showE EventValue
v]
        RepeatEvent c :: RepeatEventType
c v :: EventValue
v -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " [RepeatEventType -> String
forall a. Show a => a -> String
show RepeatEventType
c, EventValue -> String
forall e. Enum e => e -> String
showE EventValue
v]
        ForceFeedbackEvent c :: EventCode
c v :: EventValue
v -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " [EventCode -> String
forall e. Enum e => e -> String
showE EventCode
c, EventValue -> String
forall e. Enum e => e -> String
showE EventValue
v]
        PowerEvent c :: EventCode
c v :: EventValue
v -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " [EventCode -> String
forall e. Enum e => e -> String
showE EventCode
c, EventValue -> String
forall e. Enum e => e -> String
showE EventValue
v]
        ForceFeedbackStatusEvent c :: EventCode
c v :: EventValue
v -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " [EventCode -> String
forall e. Enum e => e -> String
showE EventCode
c, EventValue -> String
forall e. Enum e => e -> String
showE EventValue
v]
        _ -> ShowS
forall a. HasCallStack => String -> a
error ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ "show: unrecognised Event: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " "
            [EventType -> Item [String]
forall e. Enum e => e -> String
showE (EventType -> Item [String]) -> EventType -> Item [String]
forall a b. (a -> b) -> a -> b
$ Event -> EventType
evType Event
x, EventCode -> Item [String]
forall e. Enum e => e -> String
showE (EventCode -> Item [String]) -> EventCode -> Item [String]
forall a b. (a -> b) -> a -> b
$ Event -> EventCode
evCode Event
x, EventValue -> Item [String]
forall e. Enum e => e -> String
showE (EventValue -> Item [String]) -> EventValue -> Item [String]
forall a b. (a -> b) -> a -> b
$ Event -> EventValue
evValue Event
x]
        where
            showE :: Enum e => e -> String
            showE :: e -> String
showE = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (e -> Int) -> e -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Int
forall a. Enum a => a -> Int
fromEnum
            showTime :: a -> String
showTime t :: a
t = -- fix time string to always have same length after '.', by adding 0s
                let (n :: String
n,r :: String
r) = ShowS -> (String, String) -> (String, String)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second ShowS
forall a. [a] -> [a]
tail ((String, String) -> (String, String))
-> (String, String) -> (String, String)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '.') (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
init ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
t
                in  String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ "." String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
forall a. Int -> [a] -> [a]
take 6 (String
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Item String
'0'..]) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "s"

pattern SyncEvent :: SyncEventType -> Event
pattern $mSyncEvent :: forall r. Event -> (SyncEventType -> r) -> (Void# -> r) -> r
SyncEvent c <- Event EvSyn (toEnum . fromEnum -> c) _ _

pattern KeyEvent :: Key -> KeyEventType -> Event
pattern $mKeyEvent :: forall r. Event -> (Key -> KeyEventType -> r) -> (Void# -> r) -> r
KeyEvent c v <- Event EvKey (toEnum . fromEnum -> c) (toEnum . fromEnum -> v) _

pattern RelativeEvent :: RelativeAxis -> EventValue -> Event
pattern $mRelativeEvent :: forall r.
Event -> (RelativeAxis -> EventValue -> r) -> (Void# -> r) -> r
RelativeEvent c v <- Event EvRel (toEnum . fromEnum -> c) v _

pattern AbsoluteEvent :: AbsoluteAxis -> EventValue -> Event
pattern $mAbsoluteEvent :: forall r.
Event -> (AbsoluteAxis -> EventValue -> r) -> (Void# -> r) -> r
AbsoluteEvent c v <- Event EvAbs (toEnum . fromEnum -> c) v _

pattern MiscEvent :: MiscEventType -> EventValue -> Event
pattern $mMiscEvent :: forall r.
Event -> (MiscEventType -> EventValue -> r) -> (Void# -> r) -> r
MiscEvent c v <- Event EvMsc (toEnum . fromEnum -> c) v _

pattern SwitchEvent :: SwitchEventType -> EventValue -> Event
pattern $mSwitchEvent :: forall r.
Event -> (SwitchEventType -> EventValue -> r) -> (Void# -> r) -> r
SwitchEvent c v <- Event EvSw (toEnum . fromEnum -> c) v _

pattern LEDEvent :: LEDEventType -> EventValue -> Event
pattern $mLEDEvent :: forall r.
Event -> (LEDEventType -> EventValue -> r) -> (Void# -> r) -> r
LEDEvent c v <- Event EvLed (toEnum . fromEnum -> c) v _

pattern SoundEvent :: SoundEventType -> EventValue -> Event
pattern $mSoundEvent :: forall r.
Event -> (SoundEventType -> EventValue -> r) -> (Void# -> r) -> r
SoundEvent c v <- Event EvSnd (toEnum . fromEnum -> c) v _

pattern RepeatEvent :: RepeatEventType -> EventValue -> Event
pattern $mRepeatEvent :: forall r.
Event -> (RepeatEventType -> EventValue -> r) -> (Void# -> r) -> r
RepeatEvent c v <- Event EvRep (toEnum . fromEnum -> c) v _

pattern ForceFeedbackEvent :: EventCode -> EventValue -> Event
pattern $mForceFeedbackEvent :: forall r.
Event -> (EventCode -> EventValue -> r) -> (Void# -> r) -> r
ForceFeedbackEvent c v <- Event EvFf c v _

pattern PowerEvent :: EventCode -> EventValue -> Event
pattern $mPowerEvent :: forall r.
Event -> (EventCode -> EventValue -> r) -> (Void# -> r) -> r
PowerEvent c v <- Event EvPwr c v _

pattern ForceFeedbackStatusEvent :: EventCode -> EventValue -> Event
pattern $mForceFeedbackStatusEvent :: forall r.
Event -> (EventCode -> EventValue -> r) -> (Void# -> r) -> r
ForceFeedbackStatusEvent c v <- Event EvFfStatus c v _

newtype EventCode = EventCode Int16 deriving (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, 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)
newtype EventValue = EventValue Int32 deriving (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, 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)

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

convertFlags :: Set LL.ReadFlags -> CUInt
convertFlags :: Set ReadFlags -> CUInt
convertFlags = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Set ReadFlags -> Int) -> Set ReadFlags -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadFlags -> Int -> Int) -> Int -> Set ReadFlags -> 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)
-> (ReadFlags -> Int) -> ReadFlags -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadFlags -> Int
forall a. Enum a => a -> Int
fromEnum) 0

defaultReadFlags :: Set LL.ReadFlags
defaultReadFlags :: Set ReadFlags
defaultReadFlags = [Item (Set ReadFlags)
ReadFlags
LL.Normal,Item (Set ReadFlags)
ReadFlags
LL.Blocking]

grabDevice :: Device -> IO ()
grabDevice :: Device -> IO ()
grabDevice = GrabMode -> Device -> IO ()
grabDevice' GrabMode
LL.LibevdevGrab
ungrabDevice :: Device -> IO ()
ungrabDevice :: Device -> IO ()
ungrabDevice = GrabMode -> Device -> IO ()
grabDevice' GrabMode
LL.LibevdevUngrab

nextEvent :: Device -> Set LL.ReadFlags -> IO Event
nextEvent :: Device -> Set ReadFlags -> IO Event
nextEvent dev :: Device
dev flags :: Set ReadFlags
flags = do
    (t :: Int
t,c :: Int16
c,v :: Int32
v,time :: DiffTime
time) <- Event -> IO (Int, Int16, Int32, DiffTime)
LL.convertEvent (Event -> IO (Int, Int16, Int32, DiffTime))
-> IO Event -> IO (Int, Int16, Int32, DiffTime)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
        String -> RawFilePath -> IO (Errno, Event) -> IO Event
forall a. String -> RawFilePath -> IO (Errno, a) -> IO a
throwCErrors "nextEvent" (Device -> RawFilePath
devicePath Device
dev) (Device -> CUInt -> IO (Errno, Event)
LL.nextEvent (Device -> Device
cDevice Device
dev) (Set ReadFlags -> CUInt
convertFlags Set ReadFlags
flags))
    Event -> IO Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Event -> IO Event) -> Event -> IO Event
forall a b. (a -> b) -> a -> b
$ EventType -> EventCode -> EventValue -> DiffTime -> Event
Event (Int -> EventType
forall a. Enum a => Int -> a
toEnum Int
t) (Int16 -> EventCode
EventCode Int16
c) (Int32 -> EventValue
EventValue Int32
v) DiffTime
time

newDevice :: RawFilePath -> IO Device
newDevice :: RawFilePath -> IO Device
newDevice path :: RawFilePath
path = do
    Device
dev <- String -> RawFilePath -> IO (Errno, Device) -> IO Device
forall a. String -> RawFilePath -> IO (Errno, a) -> IO a
throwCErrors "newDevice" 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

maybeNewDevice :: RawFilePath -> IO (Maybe Device)
maybeNewDevice :: RawFilePath -> IO (Maybe Device)
maybeNewDevice = (Either IOException Device -> Maybe Device)
-> IO (Either IOException Device) -> IO (Maybe Device)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either IOException Device -> Maybe Device
forall a b. Either a b -> Maybe b
rightToMaybe (IO (Either IOException Device) -> IO (Maybe Device))
-> (RawFilePath -> IO (Either IOException Device))
-> RawFilePath
-> IO (Maybe Device)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Device -> IO (Either IOException Device)
forall a. IO a -> IO (Either IOException a)
tryIO (IO Device -> IO (Either IOException Device))
-> (RawFilePath -> IO Device)
-> RawFilePath
-> IO (Either IOException Device)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawFilePath -> IO Device
newDevice

evdevDir :: RawFilePath
evdevDir :: RawFilePath
evdevDir = "/dev/input"

getDeviceName :: Device -> IO ByteString
getDeviceName :: Device -> IO RawFilePath
getDeviceName = (String -> RawFilePath) -> IO String -> IO RawFilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> RawFilePath
BS.pack (IO String -> IO RawFilePath)
-> (Device -> IO String) -> Device -> IO RawFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> IO String
LL.deviceName (Device -> IO String) -> (Device -> Device) -> Device -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> Device
cDevice

tryIO :: IO a -> IO (Either IOException a)
tryIO :: IO a -> IO (Either IOException a)
tryIO = IO a -> IO (Either IOException a)
forall e a. Exception e => IO a -> IO (Either e a)
try


{- Util -}

-- run the action, throwing an error if the C errno is not 0
throwCErrors :: String -> RawFilePath -> IO (Errno, a) -> IO a
throwCErrors :: String -> RawFilePath -> IO (Errno, a) -> IO a
throwCErrors loc :: String
loc path :: RawFilePath
path x :: IO (Errno, a)
x = do
    (errno :: Errno
errno, res :: a
res) <- IO (Errno, a)
x
    case Errno
errno of
        Errno 0 -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
        _ -> IOException -> IO a
forall a. IOException -> IO a
ioError (IOException -> IO a) -> IOException -> IO a
forall a b. (a -> b) -> a -> b
$ String -> Errno -> Maybe Handle -> Maybe String -> IOException
errnoToIOError String
loc Errno
errno Maybe Handle
forall a. Maybe a
Nothing (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' mode :: GrabMode
mode dev :: Device
dev = String -> RawFilePath -> IO (Errno, ()) -> IO ()
forall a. String -> RawFilePath -> IO (Errno, a) -> IO a
throwCErrors "grabDevice" (Device -> RawFilePath
devicePath 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