evdev-streamly 0.0.1.0 → 0.0.2.0
raw patch · 4 files changed
+48/−20 lines, 4 filesdep +filepath-bytestringdep −posix-pathsdep ~bytestringdep ~evdevdep ~rawfilepathPVP ok
version bump matches the API change (PVP)
Dependencies added: filepath-bytestring
Dependencies removed: posix-paths
Dependency ranges changed: bytestring, evdev, rawfilepath, streamly
API changes (from Hackage documentation)
+ Evdev.Stream: newDevices' :: (IsStream t, Monad (t IO)) => Int -> t IO Device
Files
- CHANGELOG.md +7/−1
- README.md +1/−1
- evdev-streamly.cabal +11/−11
- src/Evdev/Stream.hs +29/−7
CHANGELOG.md view
@@ -1,5 +1,11 @@ # Revision history for evdev-streamly -## 0.1.0.0 -- 2020-05-30+## 0.0.2.0 -- 2021-01-05+* Reverse `allDevices` list.+### Internal+* Update various dependencies.+* Use `filepath-bytestring` consistently rather than `posix-paths`.++## 0.0.1.0 -- 2020-05-30 * Split out from `evdev` package.
README.md view
@@ -11,4 +11,4 @@ ------------- 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.+If you wish to use this library alongside `conduit`, `pipes` etc. then see the *Interoperation* section of [Streamly's tutorial](https://hackage.haskell.org/package/streamly/docs/Streamly-Tutorial.html).
evdev-streamly.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: evdev-streamly-version: 0.0.1.0+version: 0.0.2.0 author: George Thomas maintainer: George Thomas synopsis: Bridge for working with evdev and streamly@@ -26,16 +26,16 @@ 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,+ base >= 4.11 && < 5,+ bytestring ^>= {0.10, 0.11},+ containers ^>= 0.6.2,+ evdev ^>= 2.1,+ extra ^>= {1.6.18, 1.7},+ filepath-bytestring ^>= 1.4.2,+ rawfilepath ^>= 1.0.0,+ streamly ^>= 0.8,+ streamly-fsnotify ^>= 1.1.1,+ unix ^>= 2.7.2, default-language: Haskell2010 default-extensions: DerivingStrategies
src/Evdev/Stream.hs view
@@ -5,6 +5,7 @@ allEvents, makeDevices, newDevices,+ newDevices', readEvents, readEventsMany, ) where@@ -15,15 +16,16 @@ import System.IO import System.IO.Error +import Control.Concurrent (threadDelay) 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 System.FilePath.ByteString ((</>)) -import Streamly+import Streamly.Prelude (AsyncT, IsStream, MonadAsync, SerialT) import qualified Streamly.Prelude as S import Evdev@@ -37,9 +39,9 @@ -- | 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+readEventsMany ds = S.fromAsync $ do d <- ds- S.map (d,) $ serially $ readEvents' d+ S.map (d,) $ S.fromSerial $ readEvents' d where -- catch all IO errors readEvents' = unfoldM . printIOError' . nextEvent@@ -62,10 +64,14 @@ -- 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)+ let paths = S.filterM doesFileExist $ S.map (evdevDir </>) $ S.fromFoldable+ =<< S.fromEffect (reverse <$> listDirectory evdevDir) in S.mapMaybeM (printIOError' . newDevice) paths --TODO perhaps streamly-fsnotify ought to use RawFilePath?+--TODO fix this - we don't always seem to get notified of permission changes -+ -- indeed when we don't, we actually find that 'stat' and 'ls -l' show different permissions to:+ -- 'fmap (flip showOct "" . fileMode) . getFileStatus' -- | 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@@ -93,10 +99,25 @@ _ -> return (Nothing, watching) tryNewDevice = printIOError . newDevice in do- (_,es) <- S.yieldM $ watchDirectory (BS.unpack evdevDir) N.everything+ (_,es) <- S.fromEffect $ watchDirectory (BS.unpack evdevDir) N.everything scanMaybe watch Set.empty es +--TODO just fix 'newDevices'+-- | This is a workaround for bugginess in 'newDevices' when it comes to waiting for permissions on a new device+-- - it just waits the number of microseconds given before trying to read from the device.+newDevices' :: (IsStream t, Monad (t IO)) => Int -> t IO Device+newDevices' delay =+ let f = \case+ N.Added (BS.pack -> p) _ NotDir -> do+ threadDelay delay+ eitherToMaybe <$> tryNewDevice p+ _ -> return Nothing+ tryNewDevice = printIOError . newDevice+ in do+ (_,es) <- S.fromEffect $ watchDirectory (BS.unpack evdevDir) N.everything+ S.mapMaybeM f es + {- Util -} -- specialized form of S.scanlM'@@ -104,7 +125,7 @@ -- 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)+scanMaybe f e = S.mapMaybe fst . S.scanlM' (f . snd) (pure (Nothing, e)) -- specialised form of S.unfoldrM -- this should perhaps be in streamly (it's in monad-loops)@@ -112,6 +133,7 @@ unfoldM :: (IsStream t, MonadAsync m) => m (Maybe a) -> t m a unfoldM x = S.unfoldrM (const $ fmap (,undefined) <$> x) undefined +--TODO get rid - this isn't a great approach for a library -- like tryIOError, but also prints the error to stderr printIOError :: IO a -> IO (Either IOError a) printIOError f = (Right <$> f) `catchIOError` \err -> do