evdev-streamly (empty) → 0.0.1.0

raw patch · 5 files changed

+225/−0 lines, 5 filesdep +basedep +bytestringdep +containers

Dependencies added: base, bytestring, containers, evdev, extra, posix-paths, rawfilepath, streamly, streamly-fsnotify, unix

Files

• CHANGELOG.md +5/−0
• LICENSE +30/−0
• README.md +14/−0
• evdev-streamly.cabal +49/−0
• src/Evdev/Stream.hs +127/−0

@@ -0,0 +1,5 @@+# Revision history for evdev-streamly++## 0.1.0.0 -- 2020-05-30++* Split out from `evdev` package.

@@ -0,0 +1,30 @@+Copyright (c) 2019, George Thomas++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of George Thomas nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,14 @@+Evdev + Streamly+================++This library provides provides a high level [Streamly](https://hackage.haskell.org/package/streamly)-based interface to [evdev](http://hackage.haskell.org/package/evdev), for working with streams of input events.++It doesn't re-export anything, so you will almost certainly also need to depend directly on both of those packages.++Many of the functions in this library make use of concurrency, so you will probably want `--ghc-options=-threaded` for any executables you build, in order to enable the threaded runtime, and get the expected behaviour. This should be on by default in a near-future version of GHC.++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.

@@ -0,0 +1,49 @@+cabal-version:       3.0+name:                evdev-streamly+version:             0.0.1.0+author:              George Thomas+maintainer:          George Thomas+synopsis:            Bridge for working with evdev and streamly+description:+    Functions for working with streams of input events.+    Often much more pleasant than working in a more imperative style.+homepage:            https://github.com/georgefst/evdev+license:             BSD-3-Clause+license-file:        LICENSE+category:            Streamly, System+extra-source-files:+    CHANGELOG.md+    README.md++source-repository head+    type: git+    location: git://github.com/georgefst/evdev.git++library+    exposed-modules:+        Evdev.Stream+    hs-source-dirs: src+    ghc-options:+        -Wall+    build-depends:+        base                 >= 4.11 && < 5,+        bytestring           ^>= 0.10,+        containers           ^>= 0.6.2,+        evdev                ^>= 2.0,+        extra                ^>= {1.6.18, 1.7},+        posix-paths          ^>= 0.2.1,+        rawfilepath          ^>= 0.2.4,+        streamly             ^>= {0.6.1, 0.7},+        streamly-fsnotify    ^>= 1.1.1,+        unix                 ^>= 2.7.2,+    default-language: Haskell2010+    default-extensions:+        DerivingStrategies+        FlexibleContexts+        GeneralizedNewtypeDeriving+        LambdaCase+        NumericUnderscores+        OverloadedStrings+        ScopedTypeVariables+        TupleSections+        ViewPatterns

@@ -0,0 +1,127 @@+-- | Functions for working with streams of input events.+-- 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 (RawFilePath,doesFileExist,listDirectory)+import qualified Streamly.FSNotify as N+import Streamly.FSNotify (FSEntryType(NotDir),watchDirectory)+import System.Posix.FilePath ((</>))++import Streamly+import qualified Streamly.Prelude as S++import Evdev++--TODO provide a 'group' operation on streams, representing packets as sets++-- | Read all events from a device.+readEvents :: Device -> SerialT IO Event+readEvents = S.repeatM . nextEvent++-- | 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' = unfoldM . printIOError' . nextEvent+        readEvents' :: Device -> SerialT IO Event++-- | 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++--TODO perhaps streamly-fsnotify ought to use RawFilePath?+-- | 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 RawFilePath -> N.Event -> IO (Maybe Device, Set RawFilePath)+        watch watching = \case+            N.Added (BS.pack -> 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 (BS.pack -> 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 (BS.pack -> p) _ NotDir -> -- device is gone - no longer watch for changes+                return (Nothing, Set.delete p watching)+            _ -> return (Nothing, watching)+        tryNewDevice = printIOError . newDevice+    in do+        (_,es) <- S.yieldM $ watchDirectory (BS.unpack evdevDir) N.everything+        scanMaybe watch Set.empty 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