diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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). diff --git a/evdev-streamly.cabal b/evdev-streamly.cabal --- a/evdev-streamly.cabal +++ b/evdev-streamly.cabal @@ -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 diff --git a/src/Evdev/Stream.hs b/src/Evdev/Stream.hs --- a/src/Evdev/Stream.hs +++ b/src/Evdev/Stream.hs @@ -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