evdev 0.1.0.1 → 0.2.0.0

raw patch · 4 files changed

+93/−83 lines, 4 filesdep +safedep ~basedep ~bytestringdep ~compositionPVP ok

version bump matches the API change (PVP)

Dependencies added: safe

Dependency ranges changed: base, bytestring, composition, containers, either, extra, hinotify, posix-paths, process, rawfilepath, streamly, time, unix

API changes (from Hackage documentation)

Files

• CHANGELOG.md +0/−4
• evdev.cabal +16/−15
• src/Evdev.hs +53/−23
• src/Evdev/Stream.hs +24/−41

@@ -3,7 +3,3 @@ ## 0.1.0.0 -- 2019-07-20  * First version. Released on an unsuspecting world.--## 0.1.0.1 -- 2019-10-06--* Documentation update only.

@@ -1,9 +1,9 @@ cabal-version:       2.4 name:                evdev-version:             0.1.0.1+version:             0.2.0.0 author:              George Thomas maintainer:          George Thomas-description:         Allows use of the linux event device interface, with an optional high-level Streamly API.+description:         Provides access to the Linux event device interface, with an optional high-level Streamly-based API. synopsis:            Bindings to libevdev homepage:            https://github.com/georgefst/evdev license:             BSD-3-Clause@@ -22,19 +22,20 @@                        Evdev.Stream   hs-source-dirs:      src   ghc-options:         -Wall-  build-depends:       base                 >= 4.13.0 && < 4.14,-                       bytestring           >= 0.10.9 && < 0.11,-                       composition          >= 1.0.2 && < 1.1,-                       containers           >= 0.6.2 && < 0.7,-                       either               >= 5.0.1 && < 5.1,-                       time                 >= 1.9.3 && < 1.10,-                       unix                 >= 2.7.2 && < 2.8,-                       process              >= 1.6.5 && < 1.7,-                       extra                >= 1.6.18 && < 1.7,-                       hinotify             >= 0.4 && < 0.5,-                       posix-paths          >= 0.2.1 && < 0.3,-                       rawfilepath          >= 0.2.4 && < 0.3,-                       streamly             >= 0.6.1 && < 0.7,+  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,+                       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,   build-tool-depends:  c2hs:c2hs   default-language:    Haskell2010   default-extensions:  FlexibleContexts

@@ -1,4 +1,32 @@-module Evdev where+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,+    newDevice,+    maybeNewDevice,+    evdevDir,+    getDeviceName,+    Device (devicePath),+    Event,+    EventCode(..),+    EventValue(..),+    KeyEventType(..),+    ReadFlags (..),+) where  import Control.Exception import Data.Int@@ -6,6 +34,7 @@ import Data.Either.Combinators import Data.Time.Clock import Data.Tuple.Extra+import Safe  import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as BS@@ -16,7 +45,8 @@ import System.Posix.ByteString (RawFilePath)  import qualified Evdev.LowLevel as LL-import Evdev.Codes --TODO combine modules?+import Evdev.LowLevel (ReadFlags(..))+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.@@ -35,24 +65,24 @@ prettyEvent :: Event -> String prettyEvent x = showTime (evTime x) ++ ":" ++ " " ++ case x of         SyncEvent t -> show t-        KeyEvent k t -> intercalate " " [show k, show t]-        RelativeEvent c v -> intercalate " " [show c, showE v]-        AbsoluteEvent c v -> intercalate " " [show c, showE v]-        MiscEvent c v -> intercalate " " [show c, showE v]-        SwitchEvent c v -> intercalate " " [show c, showE v]-        LEDEvent c v -> intercalate " " [show c, showE v]-        SoundEvent c v -> intercalate " " [show c, showE v]-        RepeatEvent c v -> intercalate " " [show c, showE v]-        ForceFeedbackEvent c v -> intercalate " " [showE c, showE v]-        PowerEvent c v -> intercalate " " [showE c, showE v]-        ForceFeedbackStatusEvent c v -> intercalate " " [showE c, showE v]-        _ -> error $ "show: unrecognised Event: " ++ intercalate " "+        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 e => e -> String+            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 tail $ span (/= '.') $ init $ show t+                let (n,r) = second tailSafe $ span (/= '.') $ initSafe $ show t                 in  n ++ "." ++ take 6 (r ++ ['0'..]) ++ "s"  pattern SyncEvent :: SyncEventType -> Event@@ -100,18 +130,18 @@     | Repeated     deriving (Enum, Eq, Ord, Read, Show) -convertFlags :: Set LL.ReadFlags -> CUInt+convertFlags :: Set ReadFlags -> CUInt convertFlags = fromIntegral . foldr ((.|.) . fromEnum) 0 -defaultReadFlags :: Set LL.ReadFlags-defaultReadFlags = [LL.Normal,LL.Blocking]+defaultReadFlags :: Set ReadFlags+defaultReadFlags = [Normal,Blocking]  grabDevice :: Device -> IO () grabDevice = grabDevice' LL.LibevdevGrab ungrabDevice :: Device -> IO () ungrabDevice = grabDevice' LL.LibevdevUngrab -nextEvent :: Device -> Set LL.ReadFlags -> IO Event+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))@@ -131,11 +161,11 @@ getDeviceName :: Device -> IO ByteString getDeviceName = fmap BS.pack . LL.deviceName . cDevice -tryIO :: IO a -> IO (Either IOException a)-tryIO = try - {- Util -}++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

@@ -1,67 +1,50 @@-module Evdev.Stream where+module Evdev.Stream (+    allDevicePaths,+    allEvents,+    filteredEvents,+    makeDevices,+    readEvents,+    readEventsMany,+    ) where -import Control.Concurrent-import Control.Exception.Extra import Control.Monad-import Control.Monad.IO.Class-import Data.Either.Combinators -import GHC.IO.Exception (IOErrorType(PermissionDenied),ioe_type) import RawFilePath.Directory (doesFileExist,listDirectory)-import System.INotify (addWatch,initINotify)-import qualified System.INotify as I import System.Posix.ByteString (RawFilePath)-import System.Posix.FilePath ((</>),combine)+import System.Posix.FilePath ((</>))  import Streamly import qualified Streamly.Prelude as S  import Evdev -allEvents :: IsStream t => t IO (Device, Event)++allEvents :: (IsStream t, Monad (t IO)) => t IO (Device, Event) allEvents = filteredEvents $ const True -filteredEvents :: IsStream t => (Device -> Bool) -> t IO (Device, Event)-filteredEvents p = readEventsMany $ S.filter p $ makeDevices $ existingDevicePaths <> newDevicePaths+filteredEvents :: (IsStream t, Monad (t IO)) => (Device -> Bool) -> t IO (Device, Event)+filteredEvents p = readEventsMany $ S.filter p $ makeDevices allDevicePaths --- reads until encountering an IOException readEvents :: IsStream t => Device -> t IO Event-readEvents dev = serially $ unfoldrM' $ fmap rightToMaybe $ tryIO $ nextEvent dev defaultReadFlags+readEvents dev = S.repeatM $ nextEvent dev defaultReadFlags  readEventsMany :: IsStream t => AsyncT IO Device -> t IO (Device, Event)-readEventsMany = asyncly . join . (S.map $ \d -> (S.map (d,) $ readEvents d))+readEventsMany ds = asyncly $ do+    d <- ds+    S.map (d,) $ readEvents d -makeDevices :: (Functor (t IO), IsStream t) => t IO RawFilePath -> t IO Device+makeDevices :: (IsStream t, Functor (t IO)) => t IO RawFilePath -> t IO Device makeDevices = S.mapMaybeM maybeNewDevice -existingDevicePaths :: (IsStream t, MonadIO (t IO)) => t IO RawFilePath-existingDevicePaths = S.fromFoldable =<< S.yieldM (lsFiles evdevDir)--newDevicePaths :: (MonadIO (t IO), IsStream t) => t IO RawFilePath-newDevicePaths =-    let watcher mvar = \case-            I.Created False path -> do -- file (not directory) created-                let fullPath = evdevDir </> path-                handleBoolRetry ((== PermissionDenied) . ioe_type) 100 $ putMVar mvar fullPath-            _ -> return ()-    in do-        mvar <- liftIO newEmptyMVar-        iNot <- liftIO initINotify-        _ <- liftIO $ addWatch iNot [I.Create] evdevDir (watcher mvar)-        serially $ S.repeatM $ takeMVar mvar----- retry the action after encountering an exception satisfying p-handleBoolRetry :: Exception e => (e -> Bool) -> Int -> IO a -> IO a-handleBoolRetry p t x = handleBool p (const $ threadDelay t >> handleBoolRetry p t x) x+--TODO use Streamly directly+allDevicePaths :: (IsStream t, Monad (t IO)) => t IO RawFilePath+allDevicePaths = do+    fs <- S.yieldM $ lsFiles evdevDir+    S.fromFoldable fs   {- Util -} --- a specialization of S.unfoldrM which doesn't make use of any value from the previous round-unfoldrM' :: (IsStream t, MonadAsync m) => m (Maybe a) -> t m a-unfoldrM' x = S.unfoldrM (const $ fmap (,undefined) <$> x) undefined- -- lists files only, and returns full paths. lsFiles :: RawFilePath -> IO [RawFilePath]-lsFiles = filterM doesFileExist <=< ((fmap . map . combine) <*> listDirectory)+lsFiles p = filterM doesFileExist =<< (map (p </>) <$> listDirectory p)