evdev 0.2.0.1 → 1.0.0.0

raw patch · 5 files changed

+85/−64 lines, 5 filesdep +monad-loopsdep −compositionPVP ok

version bump matches the API change (PVP)

Dependencies added: monad-loops

Dependencies removed: composition

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• evdev.cabal +3/−2
• src/Evdev.hs +48/−35
• src/Evdev/LowLevel.chs +10/−4
• src/Evdev/Stream.hs +20/−23

@@ -3,3 +3,7 @@ ## 0.1.0.0 -- 2019-07-20  * First version. Released on an unsuspecting world.++## 1.0.0.0 -- 2019-12-15++* First stable release.

@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                evdev-version:             0.2.0.1+version:             1.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.@@ -24,7 +24,6 @@   ghc-options:         -Wall   build-depends:       base                 ^>= 4.12.0 || ^>= 4.13,                        bytestring           ^>= 0.10,-                       composition          ^>= 1.0,                        containers           ^>= 0.6.2,                        either               ^>= 5.0.1,                        time                 ^>= 1.9.3,@@ -36,6 +35,7 @@                        rawfilepath          ^>= 0.2.4,                        streamly             ^>= 0.6.1 || ^>= 0.7,                        safe                 ^>= 0.3.18,+                       monad-loops          ^>= 0.4.3,   build-tool-depends:  c2hs:c2hs   default-language:    Haskell2010   default-extensions:  FlexibleContexts@@ -48,4 +48,5 @@                        ViewPatterns   includes:            libevdev-1.0/libevdev/libevdev.h                        linux/input.h+                       errno.h   extra-libraries:     evdev

@@ -17,10 +17,12 @@     ungrabDevice,     nextEvent,     newDevice,-    maybeNewDevice,     evdevDir,-    getDeviceName,-    Device (devicePath),+    deviceName,+    deviceFd,+    devicePath,+    deviceProperties,+    Device,     Event,     EventCode(..),     EventValue(..),@@ -28,20 +30,20 @@     ReadFlags (..), ) where -import Control.Exception-import Data.Int-import Data.Either.Combinators-import Data.Time.Clock-import Data.Tuple.Extra-import Safe-+import Control.Arrow (second)+import Control.Monad (filterM) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as BS+import Data.Int (Int16,Int32)+import Data.List.Extra (enumerate) import Data.Set (Set)+import Data.Time.Clock (DiffTime) import Foreign ((.|.)) import Foreign.C (CUInt) import Foreign.C.Error (Errno(Errno),errnoToIOError)-import System.Posix.ByteString (RawFilePath)+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 (ReadFlags(..))@@ -85,31 +87,31 @@                 in  n ++ "." ++ take 6 (r ++ ['0'..]) ++ "s"  pattern SyncEvent :: SyncEventType -> Event-pattern SyncEvent c <- Event EvSyn (toEnum . fromEnum -> c) _ _+pattern SyncEvent c <- Event EvSyn (convertEnum -> c) _ _  pattern KeyEvent :: Key -> KeyEventType -> Event-pattern KeyEvent c v <- Event EvKey (toEnum . fromEnum -> c) (toEnum . fromEnum -> v) _+pattern KeyEvent c v <- Event EvKey (convertEnum -> c) (convertEnum -> v) _  pattern RelativeEvent :: RelativeAxis -> EventValue -> Event-pattern RelativeEvent c v <- Event EvRel (toEnum . fromEnum -> c) v _+pattern RelativeEvent c v <- Event EvRel (convertEnum -> c) v _  pattern AbsoluteEvent :: AbsoluteAxis -> EventValue -> Event-pattern AbsoluteEvent c v <- Event EvAbs (toEnum . fromEnum -> c) v _+pattern AbsoluteEvent c v <- Event EvAbs (convertEnum -> c) v _  pattern MiscEvent :: MiscEventType -> EventValue -> Event-pattern MiscEvent c v <- Event EvMsc (toEnum . fromEnum -> c) v _+pattern MiscEvent c v <- Event EvMsc (convertEnum -> c) v _  pattern SwitchEvent :: SwitchEventType -> EventValue -> Event-pattern SwitchEvent c v <- Event EvSw (toEnum . fromEnum -> c) v _+pattern SwitchEvent c v <- Event EvSw (convertEnum -> c) v _  pattern LEDEvent :: LEDEventType -> EventValue -> Event-pattern LEDEvent c v <- Event EvLed (toEnum . fromEnum -> c) v _+pattern LEDEvent c v <- Event EvLed (convertEnum -> c) v _  pattern SoundEvent :: SoundEventType -> EventValue -> Event-pattern SoundEvent c v <- Event EvSnd (toEnum . fromEnum -> c) v _+pattern SoundEvent c v <- Event EvSnd (convertEnum -> c) v _  pattern RepeatEvent :: RepeatEventType -> EventValue -> Event-pattern RepeatEvent c v <- Event EvRep (toEnum . fromEnum -> c) v _+pattern RepeatEvent c v <- Event EvRep (convertEnum -> c) v _  pattern ForceFeedbackEvent :: EventCode -> EventValue -> Event pattern ForceFeedbackEvent c v <- Event EvFf c v _@@ -143,36 +145,47 @@ nextEvent :: Device -> Set ReadFlags -> IO Event nextEvent dev flags = do     (t,c,v,time) <- LL.convertEvent =<<-        throwCErrors "nextEvent" (devicePath dev) (LL.nextEvent (cDevice dev) (convertFlags flags))+        throwCErrors "nextEvent" (Right dev) (LL.nextEvent (cDevice dev) (convertFlags flags))     return $ Event (toEnum t) (EventCode c) (EventValue v) time  newDevice :: RawFilePath -> IO Device newDevice path = do-    dev <- throwCErrors "newDevice" path $ LL.newDevice path+    dev <- throwCErrors "newDevice" (Left path) $ LL.newDevice path     return $ Device dev path -maybeNewDevice :: RawFilePath -> IO (Maybe Device)-maybeNewDevice = fmap rightToMaybe . tryIO . newDevice- evdevDir :: RawFilePath evdevDir = "/dev/input" -getDeviceName :: Device -> IO ByteString-getDeviceName = fmap BS.pack . LL.deviceName . cDevice+deviceName :: Device -> IO ByteString+deviceName = fmap BS.pack . LL.deviceName . cDevice +deviceFd :: Device -> IO Fd+deviceFd = LL.deviceFd . cDevice -{- Util -}+deviceProperties :: Device -> IO [DeviceProperty]+deviceProperties dev = filterM (LL.hasProperty $ cDevice dev) enumerate -tryIO :: IO a -> IO (Either IOException a)-tryIO = try --- run the action, throwing an error if the C errno is not 0-throwCErrors :: String -> RawFilePath -> IO (Errno, a) -> IO a-throwCErrors loc path x = do+{- Util -}++-- run the action, throwing a relevant exception if the C errno is not 0+throwCErrors :: String -> Either ByteString Device -> IO (Errno, a) -> IO a+throwCErrors func pathOrDev x = do     (errno, res) <- x     case errno of         Errno 0 -> return res-        _ -> ioError $ errnoToIOError loc errno Nothing (Just $ BS.unpack path)+        Errno n -> do+            (handle,path) <- case pathOrDev of+                Left path -> return (Nothing,path)+                Right dev -> do+                    h <- fdToHandle =<< deviceFd dev+                    return (Just h, devicePath dev)+            ioError $ errnoToIOError func (Errno $ abs n) handle (Just $ BS.unpack path)  grabDevice' :: LL.GrabMode -> Device -> IO ()-grabDevice' mode dev = throwCErrors "grabDevice" (devicePath dev) $ LL.grabDevice (cDevice dev) mode+grabDevice' mode dev = throwCErrors "grabDevice" (Right dev) $ LL.grabDevice (cDevice dev) mode++-- 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

@@ -1,8 +1,10 @@-module Evdev.LowLevel where+{-# OPTIONS_HADDOCK hide, prune, ignore-exports #-} -import Data.Int-import Data.Time.Clock+module Evdev.LowLevel where +import Control.Monad.Loops (iterateWhile)+import Data.Int (Int16,Int32)+import Data.Time.Clock (DiffTime,picosecondsToDiffTime) import Foreign (Ptr) import Foreign.C (CInt,CUInt,CLong) import Foreign.C.Error (Errno(Errno))@@ -12,6 +14,9 @@ import System.Posix.IO.ByteString (OpenMode(ReadOnly),defaultFileFlags,openFd) import System.Posix.Types (Fd(Fd)) +import Evdev.Codes++#include <errno.h> #include <libevdev-1.0/libevdev/libevdev.h> #include <linux/input.h> @@ -51,7 +56,7 @@             in  convertTime <$> sec <*> usec  nextEvent :: Device -> CUInt -> IO (Errno, Event)-nextEvent dev flags = do+nextEvent dev flags = iterateWhile ((== Errno (-{#const EAGAIN #})) . fst) $ do     ptr <- mallocForeignPtrBytes {#sizeof input_event #}     err <- withForeignPtr ptr $ {#call libevdev_next_event #} dev flags     return (Errno err, Event ptr)@@ -72,6 +77,7 @@  {- Simpler functions -} +{#fun libevdev_has_property as hasProperty { `Device', convertEnum `DeviceProperty' } -> `Bool' #} {#fun libevdev_get_fd as deviceFd { `Device' } -> `Fd' Fd #} {#fun libevdev_get_name as deviceName { `Device' } -> `String' #} --TODO should really be ByteString

@@ -1,13 +1,14 @@ module Evdev.Stream (-    allDevicePaths,+    allDevices,     allEvents,-    filteredEvents,     makeDevices,     readEvents,     readEventsMany,     ) where +import Control.Exception import Control.Monad+import System.IO.Error  import RawFilePath.Directory (doesFileExist,listDirectory) import System.Posix.ByteString (RawFilePath)@@ -19,32 +20,28 @@ import Evdev  -allEvents :: (IsStream t, Monad (t IO)) => t IO (Device, Event)-allEvents = filteredEvents $ const True--filteredEvents :: (IsStream t, Monad (t IO)) => (Device -> Bool) -> t IO (Device, Event)-filteredEvents p = readEventsMany $ S.filter p $ makeDevices allDevicePaths--readEvents :: IsStream t => Device -> t IO Event+-- | Read all events from a device.+readEvents :: Device -> SerialT IO Event readEvents dev = S.repeatM $ nextEvent dev defaultReadFlags +-- | Concurrently read events from multiple devices. readEventsMany :: IsStream t => AsyncT IO Device -> t IO (Device, Event) readEventsMany ds = asyncly $ do     d <- ds-    S.map (d,) $ readEvents d--makeDevices :: (IsStream t, Functor (t IO)) => t IO RawFilePath -> t IO Device-makeDevices = S.mapMaybeM maybeNewDevice----TODO use Streamly directly-allDevicePaths :: (IsStream t, Monad (t IO)) => t IO RawFilePath-allDevicePaths = do-    fs <- S.yieldM $ lsFiles evdevDir-    S.fromFoldable fs+    S.map (d,) $ serially $ readEvents d +-- | Create devices for all paths in the stream.+-- | Will throw an exception if a path doesn't correspond to a valid input device.+makeDevices :: IsStream t => t IO RawFilePath -> t IO Device+makeDevices = S.mapM newDevice -{- Util -}+-- | All events on all valid devices (in /dev/input).+allEvents :: IsStream t => t IO (Device, Event)+allEvents = readEventsMany allDevices --- lists files only, and returns full paths.-lsFiles :: RawFilePath -> IO [RawFilePath]-lsFiles p = filterM doesFileExist =<< (map (p </>) <$> listDirectory p)+-- | All valid devices (in /dev/input).+allDevices :: (IsStream t, Monad (t IO)) => t IO Device+allDevices =+    let maybeNewDevice path = catchJust (guard . isIllegalOperation) (Just <$> newDevice path) (\() -> return Nothing)+        paths = S.filterM doesFileExist $ S.map (evdevDir </>) $ S.fromFoldable =<< S.yieldM (listDirectory evdevDir)+    in  S.mapMaybeM maybeNewDevice paths