evdev 1.3.0.0 → 2.0.0.0

raw patch · 8 files changed

+289/−361 lines, 8 filesdep −eitherdep −hinotifydep −pathsdep ~basedep ~extradep ~timesetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies removed: either, hinotify, paths, posix-paths, process, rawfilepath, safe, streamly, streamly-fsnotify

Dependency ranges changed: base, extra, time

API changes (from Hackage documentation)

Files

• CHANGELOG.md +17/−17
• README.md +6/−24
• Setup.hs +0/−2
• evdev.cabal +41/−45
• src/Evdev.hs +154/−116
• src/Evdev/Codes.chs +40/−18
• src/Evdev/LowLevel.chs +31/−12
• src/Evdev/Stream.hs +0/−127

@@ -1,27 +1,27 @@ # Revision history for evdev -## 0.1.0.0 -- 2019-07-20--* First version. Released on an unsuspecting world.--## 1.0.0.0 -- 2019-12-15--* First stable release.+## 2.0.0.0 -- 2020-05-30+* This is really what should have been the `1.0` release, had I had a better understanding of the PVP when starting off.+* Split Streamly integration into a separate package, `evdev-streamly`.+* Safety improvements - `UnknownEvent` is used to handle a number of what were previously potential crashes.+* Lots of other, minor improvements, including simplifying the API in places, and exposing lower-level functionality where it is likely to be useful. -## 1.1.0.0 -- 2019-12-16+## 1.3.0.0 -- 2020-03-03+* Fix memory management issues and file descriptor leaks.+* Rename 'ReadFlags' to 'ReadFlag' as the type clearly represents just one flag. -* Hide LowLevel.+## 1.2.0.0 -- 2019-12-19+* Add `newDevices` stream.+* More robust error handling when reading from multiple devices.  ## 1.1.0.1 -- 2019-12-18- * Add `pkgconfig-depends` field to cabal file. -## 1.2.0.0 -- 2019-12-19--* Add `newDevices` stream.-* More robust error handling when reading from multiple devices.+## 1.1.0.0 -- 2019-12-16+* Hide LowLevel. -## 1.3.0.0 -- 2020-03-03+## 1.0.0.0 -- 2019-12-15+* First stable release. -* Fix memory management issues and file descriptor leaks.-* Rename 'ReadFlags' to 'ReadFlag' as the type clearly represents just one flag.+## 0.1.0.0 -- 2019-07-20+* First version. Released on an unsuspecting world.

@@ -1,22 +1,9 @@-Haskell evdev library-=====================--http://hackage.haskell.org/package/evdev+Evdev+=====  This library provides access to the Linux [evdev](https://en.wikipedia.org/wiki/Evdev) interface, for reading input events from devices. It uses [c2hs](https://github.com/haskell/c2hs/wiki/User-Guide)-generated bindings to [libevdev](https://www.freedesktop.org/wiki/Software/libevdev/), which should be available on almost any modern Linux distro. -Modules---------- `Evdev` provides the basic functionality for initialising devices, reading events etc.-- `Evdev.Codes` contains datatypes corresponding to the constants in `input-event-codes.h`, such as keys and device properties.-- `Evdev.Stream` provides a higher-level [Streamly](https://hackage.haskell.org/package/streamly)-based interface, for obtaining a stream of events.---Why streamly?---------------Compared to other Haskell streaming libraries, I've found `streamly` to have a remarkably easy-to-use API, and the best, simplest support for concurrency. For example, merging concurrent streams of events, from different devices, is trivial.--If you wish to use this library alongside `conduit`, `pipes` etc. then see [here](https://hackage.haskell.org/package/streamly-0.7.0/docs/Streamly-Tutorial.html#g:39) for a guide on interoperation.+It aims to expose the full set of functionality exposed by `libevdev`, while providing stronger types, and a higher level of abstraction - no worrying about memory management, ordering of operations etc.  Getting started ---------------@@ -26,12 +13,7 @@  The [evdev-examples](https://github.com/georgefst/evdev/tree/master/evdev-examples) folder contains a basic `evtest` clone, with the added ability to read events from multiple devices concurrently. -See [Hackage](http://hackage.haskell.org/package/evdev) for further documentation.--Still to come---------------Haddock documentation for the non-stream interface. I intend to redesign the interface in some minor ways first. Until then, everything maps quite directly to the C library, while taking care of the nitty-gritty low-level stuff.--There are many more methods in the C library that I'd like to expose. So far the emphasis has very much been on squeezing out the functionality I personally needed.+Streamly+-------- -Some of the streaming functions print exceptions straight to `stderr`. Again, this was convenient at the time, but it would be cleaner to allow specifying a `Writer`, or passing callbacks.+For a higher-level, more functional API based on event streams, see [evdev-streamly](http://hackage.haskell.org/package/evdev-streamly).

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -1,57 +1,53 @@-cabal-version:       2.2+cabal-version:       3.0 name:                evdev-version:             1.3.0.0+version:             2.0.0.0 author:              George Thomas maintainer:          George Thomas-description:         Provides access to the Linux event device interface, with an optional high-level Streamly-based API.+description:         Provides access to the Linux event device interface. synopsis:            Bindings to libevdev homepage:            https://github.com/georgefst/evdev license:             BSD-3-Clause license-file:        LICENSE category:            System-extra-source-files:  CHANGELOG.md-                     README.md+extra-source-files:+    CHANGELOG.md+    README.md  source-repository head-  type:     git-  location: git://github.com/georgefst/evdev.git+    type: git+    location: git://github.com/georgefst/evdev.git  library-  exposed-modules:     Evdev-                       Evdev.Codes-                       Evdev.Stream-  other-modules:       Evdev.LowLevel-  hs-source-dirs:      src-  ghc-options:         -Wall-  build-depends:       base                 ^>= 4.11 || ^>= 4.12 || ^>= 4.13,-                       bytestring           ^>= 0.10,-                       containers           ^>= 0.6.2,-                       either               ^>= 5.0.1,-                       time                 ^>= 1.9.3,-                       unix                 ^>= 2.7.2,-                       process              ^>= 1.6.5,-                       extra                ^>= 1.6.18,-                       hinotify             ^>= 0.4,-                       posix-paths          ^>= 0.2.1,-                       rawfilepath          ^>= 0.2.4,-                       streamly             ^>= 0.6.1 || ^>= 0.7,-                       safe                 ^>= 0.3.18,-                       monad-loops          ^>= 0.4.3,-                       streamly-fsnotify    ^>= 1.0,-                       paths                ^>= 0.2,-  build-tool-depends:  c2hs:c2hs-  default-language:    Haskell2010-  default-extensions:  FlexibleContexts-                       GeneralizedNewtypeDeriving-                       LambdaCase-                       NumericUnderscores-                       OverloadedLists-                       OverloadedStrings-                       PatternSynonyms-                       TupleSections-                       ViewPatterns-  includes:            libevdev-1.0/libevdev/libevdev.h-                       linux/input.h-                       errno.h-  c-sources:           src-c/evdev-hs.c-  pkgconfig-depends:   libevdev+    exposed-modules:+        Evdev+        Evdev.Codes+    other-modules:+        Evdev.LowLevel+    hs-source-dirs: src+    c-sources:+        src-c/evdev-hs.c+    pkgconfig-depends:+        libevdev+    ghc-options:+        -Wall+    build-depends:+        base                 >= 4.11 && < 5,+        bytestring           ^>= 0.10,+        containers           ^>= 0.6.2,+        extra                ^>= {1.6.18, 1.7},+        monad-loops          ^>= 0.4.3,+        time                 ^>= {1.9.3, 1.10},+        unix                 ^>= 2.7.2,+    build-tool-depends:+        c2hs:c2hs+    default-language: Haskell2010+    default-extensions:+        DerivingStrategies+        FlexibleContexts+        GeneralizedNewtypeDeriving+        LambdaCase+        NumericUnderscores+        OverloadedStrings+        ScopedTypeVariables+        TupleSections+        ViewPatterns

@@ -1,160 +1,188 @@+{-# OPTIONS_GHC -fno-state-hack #-}++-- | The main module for working with devices and events. module Evdev (-    pattern SyncEvent,-    pattern KeyEvent,-    pattern RelativeEvent,-    pattern AbsoluteEvent,-    pattern MiscEvent,-    pattern SwitchEvent,-    pattern LEDEvent,-    pattern SoundEvent,-    pattern RepeatEvent,-    pattern ForceFeedbackEvent,-    pattern PowerEvent,-    pattern ForceFeedbackStatusEvent,-    prettyEvent,-    defaultReadFlags,-    grabDevice,-    ungrabDevice,-    nextEvent,+    -- * Devices+    Device,     newDevice,+    nextEvent,     evdevDir,+    -- ** Properties     deviceName,-    deviceFd,     devicePath,     deviceProperties,-    Device,-    Event(..), --TODO provide access to Word16 etc...+    deviceFd,+    -- ** Grabbing+    grabDevice,+    ungrabDevice,++    -- * Events+    Event(..),+    EventData(..),+    KeyEvent(..),     EventCode(..),     EventValue(..),-    KeyEventType(..),-    ReadFlag(..),++    -- * 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 (second)+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 Data.Time.Clock (DiffTime,picosecondsToDiffTime)+import qualified Data.Set as Set+import Data.Time.Clock (DiffTime) import Data.Word (Word16) import Foreign ((.|.))-import Foreign.C (CInt(..),CUInt(..),CUShort(..))+import Foreign.C (CUInt) import Foreign.C.Error (Errno(Errno),errnoToIOError)-import Safe (initSafe,tailSafe) import System.Posix.ByteString (Fd,RawFilePath) import System.Posix.IO.ByteString (fdToHandle)  import qualified Evdev.LowLevel as LL-import Evdev.LowLevel (ReadFlag(..)) 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 { cDevice :: LL.Device, devicePath :: RawFilePath } instance Show Device where     show = show . devicePath -data Event = Event {-    evType :: EventType,-    evCode :: EventCode,-    evValue :: EventValue,-    evTime :: DiffTime}+-- | An input event, including the timestamp.+data Event = Event+    { eventData :: EventData+    , eventTime :: DiffTime+    }     deriving (Eq, Ord, Show) --- aligns with the pattern synonyms below-prettyEvent :: Event -> String-prettyEvent x = showTime (evTime x) ++ ":" ++ " " ++ case x of-        SyncEvent t -> show t-        KeyEvent k t -> unwords [show k, show t]-        RelativeEvent c v -> unwords [show c, showE v]-        AbsoluteEvent c v -> unwords [show c, showE v]-        MiscEvent c v -> unwords [show c, showE v]-        SwitchEvent c v -> unwords [show c, showE v]-        LEDEvent c v -> unwords [show c, showE v]-        SoundEvent c v -> unwords [show c, showE v]-        RepeatEvent c v -> unwords [show c, showE v]-        ForceFeedbackEvent c v -> unwords [showE c, showE v]-        PowerEvent c v -> unwords [showE c, showE v]-        ForceFeedbackStatusEvent c v -> unwords [showE c, showE v]-        _ -> error $ "show: unrecognised Event: " ++ unwords-            [showE $ evType x, showE $ evCode x, showE $ evValue x]-        where-            showE :: Enum x => x -> String-            showE = show . fromEnum-            showTime t = -- fix time string to always have same length after '.', by adding 0s-                let (n,r) = second tailSafe $ span (/= '.') $ initSafe $ show t-                in  n ++ "." ++ take 6 (r ++ ['0'..]) ++ "s"--pattern SyncEvent :: SyncEventType -> Event-pattern SyncEvent c <- Event EvSyn (convertEnum -> c) _ _--pattern KeyEvent :: Key -> KeyEventType -> Event-pattern KeyEvent c v <- Event EvKey (convertEnum -> c) (convertEnum -> v) _--pattern RelativeEvent :: RelativeAxis -> EventValue -> Event-pattern RelativeEvent c v <- Event EvRel (convertEnum -> c) v _--pattern AbsoluteEvent :: AbsoluteAxis -> EventValue -> Event-pattern AbsoluteEvent c v <- Event EvAbs (convertEnum -> c) v _--pattern MiscEvent :: MiscEventType -> EventValue -> Event-pattern MiscEvent c v <- Event EvMsc (convertEnum -> c) v _--pattern SwitchEvent :: SwitchEventType -> EventValue -> Event-pattern SwitchEvent c v <- Event EvSw (convertEnum -> c) v _--pattern LEDEvent :: LEDEventType -> EventValue -> Event-pattern LEDEvent c v <- Event EvLed (convertEnum -> c) v _--pattern SoundEvent :: SoundEventType -> EventValue -> Event-pattern SoundEvent c v <- Event EvSnd (convertEnum -> c) v _--pattern RepeatEvent :: RepeatEventType -> EventValue -> Event-pattern RepeatEvent c v <- Event EvRep (convertEnum -> c) v _--pattern ForceFeedbackEvent :: EventCode -> EventValue -> Event-pattern ForceFeedbackEvent c v <- Event EvFf c v _--pattern PowerEvent :: EventCode -> EventValue -> Event-pattern PowerEvent c v <- Event EvPwr c v _--pattern ForceFeedbackStatusEvent :: EventCode -> EventValue -> Event-pattern ForceFeedbackStatusEvent c v <- Event EvFfStatus c v _+--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 (Eq, Ord, Read, Show) -newtype EventCode = EventCode Word16 deriving (Enum, Eq, Ord, Read, Show)-newtype EventValue = EventValue Int32 deriving (Enum, Eq, Ord, Read, 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 (Eq, Ord, Read, Show)+    deriving newtype (Enum, Integral, Real, 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 (Eq, Ord, Read, Show)+    deriving newtype (Enum, Integral, Real, Num) -data KeyEventType+-- | The status of a key.+data KeyEvent     = Released     | Pressed     | Repeated-    deriving (Enum, Eq, Ord, Read, Show)+    deriving (Bounded, Enum, Eq, Ord, Read, Show) -convertFlags :: Set ReadFlag -> CUInt+convertFlags :: Set LL.ReadFlag -> CUInt convertFlags = fromIntegral . foldr ((.|.) . fromEnum) 0 -defaultReadFlags :: Set ReadFlag-defaultReadFlags = [Normal,Blocking]+defaultReadFlags :: Set LL.ReadFlag+defaultReadFlags = Set.fromList [LL.Normal, LL.Blocking] +-- | Prevent other clients (including kernel-internal ones) from receiving events. Often a bad idea. grabDevice :: Device -> IO () grabDevice = grabDevice' LL.LibevdevGrab+-- | Release a grabbed device. ungrabDevice :: Device -> IO () ungrabDevice = grabDevice' LL.LibevdevUngrab -nextEvent :: Device -> Set ReadFlag -> IO Event-nextEvent dev flags = do-    (CUShort t, CUShort c, CInt v, s, us) <--        throwCErrors "nextEvent" (Right dev) $ LL.nextEvent (cDevice dev) (convertFlags flags)-    return $ Event (convertEnum t) (EventCode c) (EventValue v) $-        picosecondsToDiffTime $ 1_000_000_000_000 * fromIntegral s + 1_000_000 * fromIntegral us+-- | Get the next event from the device.+nextEvent :: Device -> IO Event+nextEvent dev =+    fromCEvent <$> throwCErrors "nextEvent" (Right dev) (LL.nextEvent (cDevice dev) (convertFlags defaultReadFlags)) +fromCEvent :: LL.CEvent -> Event+fromCEvent (LL.CEvent t (EventCode -> c) (EventValue -> v) time) = Event event $ fromCTimeVal time+  where+    event = fromMaybe unknown $ toEnum' t >>= \case+        EvSyn -> SyncEvent     <$> toEnum' c+        EvKey -> KeyEvent      <$> toEnum' c <*> toEnum' v+        EvRel -> RelativeEvent <$> toEnum' c <*> pure v+        EvAbs -> AbsoluteEvent <$> toEnum' c <*> pure v+        EvMsc -> MiscEvent     <$> toEnum' c <*> pure v+        EvSw  -> SwitchEvent   <$> toEnum' c <*> pure v+        EvLed -> LEDEvent      <$> toEnum' c <*> pure v+        EvSnd -> SoundEvent    <$> toEnum' c <*> pure v+        EvRep -> RepeatEvent   <$> toEnum' c <*> pure v+        EvFf  -> Just $ ForceFeedbackEvent c v+        EvPwr -> Just $ PowerEvent c v+        EvFfStatus -> Just $ ForceFeedbackStatusEvent c v+    unknown = UnknownEvent t c v++toCEvent :: Event -> LL.CEvent+toCEvent (Event e time) = case e of+    -- from kernel docs, 'EV_SYN event values are undefined' - we always seem to see 0, so may as well use that+    SyncEvent                (fe -> c) -> LL.CEvent (fe EvSyn) c 0 cTime+    KeyEvent                 (fe -> c) (fe -> v) -> LL.CEvent (fe EvKey) c v cTime+    RelativeEvent            (fe -> c) (fe -> v) -> LL.CEvent (fe EvRel) c v cTime+    AbsoluteEvent            (fe -> c) (fe -> v) -> LL.CEvent (fe EvAbs) c v cTime+    MiscEvent                (fe -> c) (fe -> v) -> LL.CEvent (fe EvMsc) c v cTime+    SwitchEvent              (fe -> c) (fe -> v) -> LL.CEvent (fe EvSw)  c v cTime+    LEDEvent                 (fe -> c) (fe -> v) -> LL.CEvent (fe EvLed) c v cTime+    SoundEvent               (fe -> c) (fe -> v) -> LL.CEvent (fe EvSnd) c v cTime+    RepeatEvent              (fe -> c) (fe -> v) -> LL.CEvent (fe EvRep) c v cTime+    ForceFeedbackEvent       (fe -> c) (fe -> v) -> LL.CEvent (fe EvFf)  c v cTime+    PowerEvent               (fe -> c) (fe -> v) -> LL.CEvent (fe EvPwr) c v cTime+    ForceFeedbackStatusEvent (fe -> c) (fe -> v) -> LL.CEvent (fe EvFfStatus) c v cTime+    UnknownEvent             (fe -> t) (fe -> c) (fe -> v) -> LL.CEvent t c v 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 = fromIntegral . fromEnum+    cTime = toCTimeVal time++fromCTimeVal :: LL.CTimeVal -> DiffTime+fromCTimeVal (LL.CTimeVal s us) =+    fromRational $ fromIntegral s + (fromIntegral us % 1_000_000)++--TODO QuickCheck inverse+toCTimeVal :: DiffTime -> LL.CTimeVal+toCTimeVal t = LL.CTimeVal n (round $ f * 1_000_000)+    where (n,f) = properFraction t++-- | Create a device from a valid path - usually /\/dev\/input\/eventX/ for some /X/. newDevice :: RawFilePath -> IO Device newDevice path = do     dev <- throwCErrors "newDevice" (Left path) $ LL.newDevice path     return $ Device dev path +-- | The usual directory containing devices (/"\/dev\/input"/). evdevDir :: RawFilePath evdevDir = "/dev/input" @@ -187,15 +215,25 @@ grabDevice' :: LL.GrabMode -> Device -> IO () grabDevice' mode dev = throwCErrors "grabDevice" (Right dev) $ LL.grabDevice (cDevice dev) mode ---TODO ensure all uses are safe-    -- really, fromEnum should be :: e -> Integer-    -- and toEnum :: Integral a => a -> Maybe e-    -- the issues with Enum are great enough that it may be worth considering using something more bespoke than c2hs-    -- or it could be worth a PR-        -- auto-generate safe *toInt/*fromInt based on the current logic-        -- then implement Enum instance in terms of those-    -- note that we also use to/from-Enum in LowLevel--- obviously this isn't safe in general--- we use it only after matching on 'EventType', to get the corresponding 'EventCode' and 'EventValue'-convertEnum :: (Enum a, Enum b) => a -> b-convertEnum = toEnum . fromEnum++{-+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' = (enumMap !?)+  where+    --TODO HashMap, IntMap?+    enumMap :: Map k a+    enumMap = Map.fromList $ map (fromIntegral . fromEnum &&& id) enumerate

@@ -1,17 +1,19 @@+{-+TODO haddock doesn't quite work correctly with LINE pragmas+    https://github.com/haskell/haddock/issues/441+    for now we can work around this by deleting the pragmas before upload to hackage++seems to be on its way to being fixed with `.hie` files (enable `-fwrite-ide-info`)+    https://github.com/haskell/haddock/commit/8bc3c2990475a254e168fbdb005af93f9397b19c+-}++-- | Datatypes corresponding to the constants in [input-event-codes.h](https://github.com/torvalds/linux/blob/master/include/uapi/linux/input-event-codes.h).+-- See [the Linux Kernel documentation](https://www.kernel.org/doc/html/latest/input/event-codes.html) for full details, noting that all names have been mechanically transformed into CamelCase. module Evdev.Codes where  #include <linux/input-event-codes.h> -{#enum define DeviceProperty {-    INPUT_PROP_POINTER as InputPropPointer,-    INPUT_PROP_DIRECT as InputPropDirect,-    INPUT_PROP_BUTTONPAD as InputPropButtonpad,-    INPUT_PROP_SEMI_MT as InputPropSemiMt,-    INPUT_PROP_TOPBUTTONPAD as InputPropTopbuttonpad,-    INPUT_PROP_POINTING_STICK as InputPropPointingStick,-    INPUT_PROP_ACCELEROMETER as InputPropAccelerometer}-    deriving (Bounded, Eq, Ord, Read, Show) #}-+-- | Each of these corresponds to one of the contructors of 'Evdev.EventData'. So you're unlikely to need to use these directly (C doesn't have ADTs - we do). {#enum define EventType {     EV_SYN as EvSyn,     EV_KEY as EvKey,@@ -27,13 +29,15 @@     EV_FF_STATUS as EvFfStatus}     deriving (Bounded, Eq, Ord, Read, Show) #} -{#enum define SyncEventType {-    SYN_REPORT as SynReport,+-- | Synchronization events+{#enum define SyncEvent {+    SYN_REPORT as SynReport, -- | Used to separate packets of simultaneous events     SYN_CONFIG as SynConfig,     SYN_MT_REPORT as SynMtReport,-    SYN_DROPPED as SynDropped}+    SYN_DROPPED as SynDropped} --TODO handle SYN_DROPPED automatically for streams     deriving (Bounded, Eq, Ord, Read, Show) #} +-- | Keys and buttons {#enum define Key {     KEY_RESERVED as KeyReserved,     KEY_ESC as KeyEsc,@@ -577,6 +581,7 @@     BTN_TRIGGER_HAPPY40 as BtnTriggerHappy40}     deriving (Bounded, Eq, Ord, Read, Show) #} +-- | Relative changes {#enum define RelativeAxis {     REL_X as RelX,     REL_Y as RelY,@@ -590,6 +595,7 @@     REL_MISC as RelMisc}     deriving (Bounded, Eq, Ord, Read, Show) #} +-- | Absolute changes {#enum define AbsoluteAxis {     ABS_X as AbsX,     ABS_Y as AbsY,@@ -635,7 +641,8 @@     ABS_MT_TOOL_Y as AbsMtToolY}     deriving (Bounded, Eq, Ord, Read, Show) #} -{#enum define SwitchEventType {+-- | Stateful binary switches+{#enum define SwitchEvent {     SW_LID as SwLid,     SW_TABLET_MODE as SwTabletMode,     SW_HEADPHONE_INSERT as SwHeadphoneInsert,@@ -654,7 +661,8 @@     SW_MUTE_DEVICE as SwMuteDevice}     deriving (Bounded, Eq, Ord, Read, Show) #} -{#enum define MiscEventType {+-- | Miscellaneous+{#enum define MiscEvent {     MSC_SERIAL as MscSerial,     MSC_PULSELED as MscPulseled,     MSC_GESTURE as MscGesture,@@ -663,7 +671,8 @@     MSC_TIMESTAMP as MscTimestamp}     deriving (Bounded, Eq, Ord, Read, Show) #} -{#enum define LEDEventType {+-- | LEDs+{#enum define LEDEvent {     LED_NUML as LedNuml,     LED_CAPSL as LedCapsl,     LED_SCROLLL as LedScrolll,@@ -677,13 +686,26 @@     LED_CHARGING as LedCharging}     deriving (Bounded, Eq, Ord, Read, Show) #} -{#enum define RepeatEventType {+-- | Specifying autorepeating events+{#enum define RepeatEvent {     REP_DELAY as RepDelay,     REP_PERIOD as RepPeriod}     deriving (Bounded, Eq, Ord, Read, Show) #} -{#enum define SoundEventType {+-- | For simple sound output devices+{#enum define SoundEvent {     SND_CLICK as SndClick,     SND_BELL as SndBell,     SND_TONE as SndTone}+    deriving (Bounded, Eq, Ord, Read, Show) #}++-- | Device properties+{#enum define DeviceProperty {+    INPUT_PROP_POINTER as InputPropPointer,+    INPUT_PROP_DIRECT as InputPropDirect,+    INPUT_PROP_BUTTONPAD as InputPropButtonpad,+    INPUT_PROP_SEMI_MT as InputPropSemiMt,+    INPUT_PROP_TOPBUTTONPAD as InputPropTopbuttonpad,+    INPUT_PROP_POINTING_STICK as InputPropPointingStick,+    INPUT_PROP_ACCELEROMETER as InputPropAccelerometer}     deriving (Bounded, Eq, Ord, Read, Show) #}

@@ -2,8 +2,11 @@  import Control.Monad.Loops (iterateWhile) import Data.ByteString (ByteString,packCString)+import Data.Coerce (coerce)+import Data.Int (Int32,Int64)+import Data.Word (Word16) import Foreign (Ptr,allocaBytes)-import Foreign.C (CInt(..),CUInt(..),CUShort(..),CLong)+import Foreign.C (CInt(..),CLong(..),CUInt(..),CUShort(..)) import Foreign.C.Error (Errno(Errno)) import System.Posix.ByteString (RawFilePath) import System.Posix.IO.ByteString (OpenMode(ReadOnly),defaultFileFlags,openFd)@@ -32,20 +35,35 @@ void libevdev_hs_close(struct libevdev *dev); #endc +data CEvent = CEvent+    { cEventType :: Word16+    , cEventCode :: Word16+    , cEventValue :: Int32+    , cEventTime :: CTimeVal+    }+    deriving (Eq, Ord, Read, Show) +data CTimeVal = CTimeVal+    { tvSec :: Int64+    , tvUsec :: Int64+    }+    deriving (Eq, Ord, Read, Show)++ {- Conversions -}  {#fun libevdev_next_event { `Device', `CUInt', `Ptr ()' } -> `Errno' Errno #}-nextEvent :: Device -> CUInt -> IO (Errno, (CUShort,CUShort,CInt,CLong,CLong)) --TODO not CLong on all platforms+nextEvent :: Device -> CUInt -> IO (Errno, CEvent) nextEvent dev flags = allocaBytes {#sizeof input_event #} $ \evPtr ->     (,) <$> iterateWhile (== Errno (-{#const EAGAIN #})) (libevdev_next_event dev flags evPtr)-        <*> (-            (,,,,)-            <$> {#get input_event->type #} evPtr-            <*> {#get input_event->code #} evPtr-            <*> {#get input_event->value #} evPtr-            <*> {#get input_event->time.tv_sec #} evPtr-            <*> {#get input_event->time.tv_usec #} evPtr+        <*> ( CEvent+            <$> (coerce <$> {#get input_event->type #} evPtr)+            <*> (coerce <$> {#get input_event->code #} evPtr)+            <*> (coerce <$> {#get input_event->value #} evPtr)+            <*> ( CTimeVal+                <$> (coerce <$> {#get input_event->time.tv_sec #} evPtr)+                <*> (coerce <$> {#get input_event->time.tv_usec #} evPtr)+            )         )  {#fun libevdev_grab { `Device', `GrabMode' } -> `Errno' Errno #}@@ -65,14 +83,15 @@  {- Simpler functions -} -{#fun libevdev_has_property as hasProperty { `Device', convertEnum `DeviceProperty' } -> `Bool' #}+{#fun libevdev_has_property as hasProperty { `Device', devPropToInt `DeviceProperty' } -> `Bool' #} {#fun libevdev_get_fd as deviceFd { `Device' } -> `Fd' Fd #} {#fun libevdev_get_name as deviceName { `Device' } -> `IO ByteString' packCString #} + {- Util -} -convertEnum :: DeviceProperty -> CUInt-convertEnum = fromIntegral . fromEnum+devPropToInt :: DeviceProperty -> CUInt+devPropToInt = fromIntegral . fromEnum  (.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d (.:) = (.) . (.)

@@ -1,127 +0,0 @@--- | The high-level, stream-based API.--- Unless stated otherwise, these functions will throw exceptions if the underlying C calls fail.-module Evdev.Stream (-    allDevices,-    allEvents,-    makeDevices,-    newDevices,-    readEvents,-    readEventsMany,-) where--import Data.Bool-import Data.Either.Extra-import Data.Functor-import System.IO-import System.IO.Error--import Data.Set (Set)-import qualified Data.Set as Set-import qualified Data.ByteString.Char8 as BS-import RawFilePath.Directory (doesFileExist,listDirectory)-import qualified Streamly.FSNotify as N-import Streamly.FSNotify (EventPredicate(EventPredicate),FSEntryType(NotDir),watchDirectory)-import System.Path (Absolute,Path,fromFilePath,toFilePath)-import System.Posix.ByteString (RawFilePath)-import System.Posix.FilePath ((</>))--import Streamly-import qualified Streamly.Prelude as S--import Evdev----- | Read all events from a device.-readEvents :: Device -> SerialT IO Event-readEvents dev = S.repeatM $ nextEvent dev defaultReadFlags---- | Concurrently read events from multiple devices.--- If a read fails on one, the exception is printed to stderr and the stream continues to read from the others.-readEventsMany :: IsStream t => AsyncT IO Device -> t IO (Device, Event)-readEventsMany ds = asyncly $ do-    d <- ds-    S.map (d,) $ serially $ readEvents' d-    where-        -- catch all IO errors-        readEvents' :: Device -> SerialT IO Event-        readEvents' dev = unfoldM $ printIOError' $ nextEvent dev defaultReadFlags---- | Create devices for all paths in the stream.-makeDevices :: IsStream t => t IO RawFilePath -> t IO Device-makeDevices = S.mapM newDevice---- | All events on all valid devices (in /\/dev\/input/).--- Prints any exceptions.------ > allEvents == readEventsMany allDevices-allEvents :: IsStream t => t IO (Device, Event)-allEvents = readEventsMany allDevices----TODO call this 'oldDevices' or 'existingDevices', and have 'allDevices' include 'newDevices'?--- | All valid existing devices (in /\/dev\/input/).--- If a device can't be initialised for an individual path, then the exception is printed,--- and the function continues to try to initialise the others.-allDevices :: (IsStream t, Monad (t IO)) => t IO Device-allDevices =-    let paths = S.filterM doesFileExist $ S.map (evdevDir </>) $ S.fromFoldable =<< S.yieldM (listDirectory evdevDir)-    in  S.mapMaybeM (printIOError' . newDevice) paths---- | All new devices created (in /\/dev\/input/).--- Watches for new file paths (using \inotify\), and those corresponding to valid devices are added to the stream.-newDevices :: (IsStream t, Monad (t IO)) => t IO Device-newDevices =-    let -- 'watching' keeps track of the set of paths which have been added, but don't yet have the right permissions-        watch :: Set (Path Absolute) -> N.Event -> IO (Maybe Device, Set (Path Absolute))-        watch watching = \case-            N.Added p _ NotDir ->-                tryNewDevice p <&> \case-                    Right d -> -- success - return new device-                        (Just d, watching)-                    Left e -> -- fail - if it's only a permission error then watch for changes on device-                        (Nothing, applyWhen (isPermissionError e) (Set.insert p) watching)-            N.Modified p _ NotDir ->-                if p `elem` watching then-                    tryNewDevice p <&> \case-                        Right d -> -- success - no longer watch for changes-                            (Just d, Set.delete p watching)-                        Left _ -> -- fail - continue to watch-                            (Nothing, watching)-                else -- this isn't an event we care about-                    return (Nothing, watching)-            N.Removed p _ NotDir -> -- device is gone - no longer watch for changes-                return (Nothing, Set.delete p watching)-            _ -> return (Nothing, watching)-        tryNewDevice = printIOError . newDevice . BS.pack . toFilePath-    in do-        (_,es) <- S.yieldM $ watchDirectory (fromFilePath $ BS.unpack evdevDir) (EventPredicate $ const True)-        scanMaybe watch [] es---{- Util -}---- specialized form of S.scanlM'--- for each a, f updates s, and possibly produces a new b, to add to the output stream--- I really can't think of a good name for this...--- TODO perhaps some way to use State monad instead?-scanMaybe :: (IsStream t, Monad m) => (s -> a -> m (Maybe b, s)) -> s -> t m a -> t m b-scanMaybe f e  = S.mapMaybe fst . S.scanlM' (f . snd) (Nothing, e)---- specialised form of S.unfoldrM--- this should perhaps be in streamly (it's in monad-loops)---TODO this is rather ugly - can it be done in terms of the Unfold type?-unfoldM :: (IsStream t, MonadAsync m) => m (Maybe a) -> t m a-unfoldM x = S.unfoldrM (const $ fmap (,undefined) <$> x) undefined---- like tryIOError, but also prints the error to stderr-printIOError :: IO a -> IO (Either IOError a)-printIOError f = (Right <$> f) `catchIOError` \err -> do-    hPrint stderr err-    return $ Left err---- variant of printIOError which doesn't care what the exception was-printIOError' :: IO a -> IO (Maybe a)-printIOError' = fmap eitherToMaybe . printIOError---- apply the function iff the guard passes-applyWhen :: Bool -> (a -> a) -> a -> a-applyWhen = flip $ bool id