module Evdev.Uinput (
Device,
newDevice,
writeEvent,
writeBatch,
defaultDeviceOpts,
DeviceOpts (..),
deviceSyspath,
deviceDevnode,
AbsInfo (..),
Event(..),
EventData(..),
KeyEvent(..),
EventCode(..),
EventValue(..),
) where
import Control.Monad
import Data.Tuple.Extra
import Foreign
import Data.ByteString.Char8 (ByteString)
import Evdev hiding (Device, newDevice)
import Evdev.Codes
import qualified Evdev.LowLevel as LL
import Util
newtype Device = Device LL.UDevice
newDevice ::
ByteString ->
DeviceOpts ->
IO Device
newDevice :: ByteString -> DeviceOpts -> IO Device
newDevice ByteString
name DeviceOpts{[(RepeatEvent, Int)]
[(AbsoluteAxis, AbsInfo)]
[SoundEvent]
[LEDEvent]
[MiscEvent]
[SwitchEvent]
[RelativeAxis]
[Key]
[EventCode]
Maybe Int
Maybe ByteString
ffStats :: DeviceOpts -> [EventCode]
powers :: DeviceOpts -> [EventCode]
ffs :: DeviceOpts -> [EventCode]
reps :: DeviceOpts -> [(RepeatEvent, Int)]
sounds :: DeviceOpts -> [SoundEvent]
leds :: DeviceOpts -> [LEDEvent]
switchs :: DeviceOpts -> [SwitchEvent]
miscs :: DeviceOpts -> [MiscEvent]
absAxes :: DeviceOpts -> [(AbsoluteAxis, AbsInfo)]
relAxes :: DeviceOpts -> [RelativeAxis]
keys :: DeviceOpts -> [Key]
idVersion :: DeviceOpts -> Maybe Int
idBustype :: DeviceOpts -> Maybe Int
idVendor :: DeviceOpts -> Maybe Int
idProduct :: DeviceOpts -> Maybe Int
uniq :: DeviceOpts -> Maybe ByteString
phys :: DeviceOpts -> Maybe ByteString
ffStats :: [EventCode]
powers :: [EventCode]
ffs :: [EventCode]
reps :: [(RepeatEvent, Int)]
sounds :: [SoundEvent]
leds :: [LEDEvent]
switchs :: [SwitchEvent]
miscs :: [MiscEvent]
absAxes :: [(AbsoluteAxis, AbsInfo)]
relAxes :: [RelativeAxis]
keys :: [Key]
idVersion :: Maybe Int
idBustype :: Maybe Int
idVendor :: Maybe Int
idProduct :: Maybe Int
uniq :: Maybe ByteString
phys :: Maybe ByteString
..} = do
Device
dev <- IO Device
LL.libevdev_new
Device -> ByteString -> IO ()
LL.setDeviceName Device
dev ByteString
name
let maybeSet :: (LL.Device -> a -> IO ()) -> Maybe a -> IO ()
maybeSet :: forall a. (Device -> a -> IO ()) -> Maybe a -> IO ()
maybeSet Device -> a -> IO ()
setter Maybe a
x = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Device -> a -> IO ()
setter Device
dev) Maybe a
x
forall a. (Device -> a -> IO ()) -> Maybe a -> IO ()
maybeSet Device -> ByteString -> IO ()
LL.setDevicePhys Maybe ByteString
phys
forall a. (Device -> a -> IO ()) -> Maybe a -> IO ()
maybeSet Device -> ByteString -> IO ()
LL.setDeviceUniq Maybe ByteString
uniq
forall a. (Device -> a -> IO ()) -> Maybe a -> IO ()
maybeSet Device -> Int -> IO ()
LL.libevdev_set_id_product Maybe Int
idProduct
forall a. (Device -> a -> IO ()) -> Maybe a -> IO ()
maybeSet Device -> Int -> IO ()
LL.libevdev_set_id_vendor Maybe Int
idVendor
forall a. (Device -> a -> IO ()) -> Maybe a -> IO ()
maybeSet Device -> Int -> IO ()
LL.libevdev_set_id_bustype Maybe Int
idBustype
forall a. (Device -> a -> IO ()) -> Maybe a -> IO ()
maybeSet Device -> Int -> IO ()
LL.libevdev_set_id_version Maybe Int
idVersion
let enable :: Ptr () -> EventType -> [Word16] -> IO ()
enable :: Ptr () -> EventType -> [Word16] -> IO ()
enable Ptr ()
ptr EventType
t [Word16]
cs = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Word16]
cs) forall a b. (a -> b) -> a -> b
$ forall a. CErrCall a => IO a -> IO (CErrCallRes a)
cec forall a b. (a -> b) -> a -> b
$ Device -> Word16 -> IO Errno
LL.enableType Device
dev Word16
t'
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Word16]
cs forall a b. (a -> b) -> a -> b
$ \Word16
c -> forall a. CErrCall a => IO a -> IO (CErrCallRes a)
cec forall a b. (a -> b) -> a -> b
$ Device -> Word16 -> Word16 -> Ptr () -> IO Errno
LL.enableCode Device
dev Word16
t' Word16
c Ptr ()
ptr
where
t' :: Word16
t' = forall c a. (Num c, Enum a) => a -> c
fromEnum' EventType
t
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
(forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ Ptr () -> EventType -> [Word16] -> IO ()
enable forall a. Ptr a
nullPtr)
[ (EventType
EvKey, forall a b. (a -> b) -> [a] -> [b]
map forall c a. (Num c, Enum a) => a -> c
fromEnum' [Key]
keys)
, (EventType
EvRel, forall a b. (a -> b) -> [a] -> [b]
map forall c a. (Num c, Enum a) => a -> c
fromEnum' [RelativeAxis]
relAxes)
, (EventType
EvMsc, forall a b. (a -> b) -> [a] -> [b]
map forall c a. (Num c, Enum a) => a -> c
fromEnum' [MiscEvent]
miscs)
, (EventType
EvSw, forall a b. (a -> b) -> [a] -> [b]
map forall c a. (Num c, Enum a) => a -> c
fromEnum' [SwitchEvent]
switchs)
, (EventType
EvLed, forall a b. (a -> b) -> [a] -> [b]
map forall c a. (Num c, Enum a) => a -> c
fromEnum' [LEDEvent]
leds)
, (EventType
EvSnd, forall a b. (a -> b) -> [a] -> [b]
map forall c a. (Num c, Enum a) => a -> c
fromEnum' [SoundEvent]
sounds)
, (EventType
EvFf, forall a b. (a -> b) -> [a] -> [b]
map forall c a. (Num c, Enum a) => a -> c
fromEnum' [EventCode]
ffs)
, (EventType
EvPwr, forall a b. (a -> b) -> [a] -> [b]
map forall c a. (Num c, Enum a) => a -> c
fromEnum' [EventCode]
powers)
, (EventType
EvFfStatus, forall a b. (a -> b) -> [a] -> [b]
map forall c a. (Num c, Enum a) => a -> c
fromEnum' [EventCode]
ffStats)
]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(RepeatEvent, Int)]
reps forall a b. (a -> b) -> a -> b
$ \(RepeatEvent
rep, Int
n) -> do
ForeignPtr Int
pf <- forall a. Storable a => IO (ForeignPtr a)
mallocForeignPtr
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Int
pf \Ptr Int
p -> do
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Int
p Int
n
Ptr () -> EventType -> [Word16] -> IO ()
enable (forall a b. Ptr a -> Ptr b
castPtr Ptr Int
p) EventType
EvRep [forall c a. (Num c, Enum a) => a -> c
fromEnum' RepeatEvent
rep]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(AbsoluteAxis, AbsInfo)]
absAxes forall a b. (a -> b) -> a -> b
$ \(AbsoluteAxis
axis, AbsInfo
absInfo) ->
forall a. AbsInfo -> (Ptr () -> IO a) -> IO a
LL.withAbsInfo AbsInfo
absInfo forall a b. (a -> b) -> a -> b
$ \Ptr ()
ptr ->
Ptr () -> EventType -> [Word16] -> IO ()
enable Ptr ()
ptr EventType
EvAbs [forall c a. (Num c, Enum a) => a -> c
fromEnum' AbsoluteAxis
axis]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UDevice -> Device
Device forall a b. (a -> b) -> a -> b
$ forall a. CErrCall a => IO a -> IO (CErrCallRes a)
cec forall a b. (a -> b) -> a -> b
$ Device -> Fd -> IO (Errno, UDevice)
LL.createFromDevice Device
dev forall a b. (a -> b) -> a -> b
$ forall c a. (Num c, Enum a) => a -> c
fromEnum' UInputOpenMode
LL.UOMManaged
where
cec :: CErrCall a => IO a -> IO (CErrCallRes a)
cec :: forall a. CErrCall a => IO a -> IO (CErrCallRes a)
cec = forall a info.
(CErrCall a, CErrInfo info) =>
String -> info -> IO a -> IO (CErrCallRes a)
cErrCall String
"newDevice" ()
data DeviceOpts = DeviceOpts
{ DeviceOpts -> Maybe ByteString
phys :: Maybe ByteString
, DeviceOpts -> Maybe ByteString
uniq :: Maybe ByteString
, DeviceOpts -> Maybe Int
idProduct :: Maybe Int
, DeviceOpts -> Maybe Int
idVendor :: Maybe Int
, DeviceOpts -> Maybe Int
idBustype :: Maybe Int
, DeviceOpts -> Maybe Int
idVersion :: Maybe Int
, DeviceOpts -> [Key]
keys :: [Key]
, DeviceOpts -> [RelativeAxis]
relAxes :: [RelativeAxis]
, DeviceOpts -> [(AbsoluteAxis, AbsInfo)]
absAxes :: [(AbsoluteAxis, LL.AbsInfo)]
, DeviceOpts -> [MiscEvent]
miscs :: [MiscEvent]
, DeviceOpts -> [SwitchEvent]
switchs :: [SwitchEvent]
, DeviceOpts -> [LEDEvent]
leds :: [LEDEvent]
, DeviceOpts -> [SoundEvent]
sounds :: [SoundEvent]
, DeviceOpts -> [(RepeatEvent, Int)]
reps :: [(RepeatEvent, Int)]
, DeviceOpts -> [EventCode]
ffs :: [EventCode]
, DeviceOpts -> [EventCode]
powers :: [EventCode]
, DeviceOpts -> [EventCode]
ffStats :: [EventCode]
}
defaultDeviceOpts :: DeviceOpts
defaultDeviceOpts :: DeviceOpts
defaultDeviceOpts =
DeviceOpts
{ uniq :: Maybe ByteString
uniq = forall a. Maybe a
Nothing
, phys :: Maybe ByteString
phys = forall a. Maybe a
Nothing
, idProduct :: Maybe Int
idProduct = forall a. Maybe a
Nothing
, idVendor :: Maybe Int
idVendor = forall a. Maybe a
Nothing
, idBustype :: Maybe Int
idBustype = forall a. Maybe a
Nothing
, idVersion :: Maybe Int
idVersion = forall a. Maybe a
Nothing
, keys :: [Key]
keys = []
, relAxes :: [RelativeAxis]
relAxes = []
, absAxes :: [(AbsoluteAxis, AbsInfo)]
absAxes = []
, miscs :: [MiscEvent]
miscs = []
, switchs :: [SwitchEvent]
switchs = []
, leds :: [LEDEvent]
leds = []
, sounds :: [SoundEvent]
sounds = []
, reps :: [(RepeatEvent, Int)]
reps = []
, ffs :: [EventCode]
ffs = []
, powers :: [EventCode]
powers = []
, ffStats :: [EventCode]
ffStats = []
}
writeEvent :: Device -> EventData -> IO ()
writeEvent :: Device -> EventData -> IO ()
writeEvent (Device UDevice
dev) EventData
e = do
forall a info.
(CErrCall a, CErrInfo info) =>
String -> info -> IO a -> IO (CErrCallRes a)
cErrCall String
"writeEvent" UDevice
dev forall a b. (a -> b) -> a -> b
$ forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 (UDevice -> Word16 -> Word16 -> Int32 -> IO Errno
LL.writeEvent UDevice
dev) forall a b. (a -> b) -> a -> b
$ EventData -> (Word16, Word16, Int32)
toCEventData EventData
e
writeBatch :: Foldable t => Device -> t EventData -> IO ()
writeBatch :: forall (t :: * -> *). Foldable t => Device -> t EventData -> IO ()
writeBatch Device
dev t EventData
es = do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t EventData
es forall a b. (a -> b) -> a -> b
$ Device -> EventData -> IO ()
writeEvent Device
dev
Device -> EventData -> IO ()
writeEvent Device
dev forall a b. (a -> b) -> a -> b
$ SyncEvent -> EventData
SyncEvent SyncEvent
SynReport
deviceSyspath :: Device -> IO (Maybe ByteString)
deviceSyspath :: Device -> IO (Maybe ByteString)
deviceSyspath = UDevice -> IO (Maybe ByteString)
LL.getSyspath forall b c a. (b -> c) -> (a -> b) -> a -> c
. \(Device UDevice
d) -> UDevice
d
deviceDevnode :: Device -> IO (Maybe ByteString)
deviceDevnode :: Device -> IO (Maybe ByteString)
deviceDevnode = UDevice -> IO (Maybe ByteString)
LL.getDevnode forall b c a. (b -> c) -> (a -> b) -> a -> c
. \(Device UDevice
d) -> UDevice
d