diff --git a/evdev-examples/evdev-examples.cabal b/evdev-examples/evdev-examples.cabal index 56fb5b4..8275d6b 100755 --- a/evdev-examples/evdev-examples.cabal +++ b/evdev-examples/evdev-examples.cabal @@ -13,6 +13,7 @@ executable evtest bytestring, evdev, evdev-streamly, + filepath, pretty-simple, streamly, ghc-options: @@ -66,6 +67,7 @@ executable evdev-replay base, evdev, evdev-streamly, + filepath, mtl, streamly, time, diff --git a/evdev-examples/evtest/Main.hs b/evdev-examples/evtest/Main.hs index 0b5de26..953a0f2 100755 --- a/evdev-examples/evtest/Main.hs +++ b/evdev-examples/evtest/Main.hs @@ -1,6 +1,9 @@ module Main (main) where import qualified Data.ByteString.Char8 as BS +import Data.Maybe (fromMaybe) +import System.OsPath.Posix (PosixPath, ()) +import System.OsString.Posix (fromBytes) import Text.Pretty.Simple (pPrint) import qualified Streamly.Prelude as S @@ -17,9 +20,13 @@ main = do readEventsMany if null ns then allDevices <> newDevices - else makeDevices $ S.fromFoldable $ map ((evdevDir <> "/event") <>) ns + else makeDevices $ S.fromFoldable $ map ((evdevDir ) . fromBytes' . ("event" <>)) ns printDevice :: Device -> IO () printDevice dev = do name <- deviceName dev BS.putStrLn $ devicePath dev <> ":\n " <> name + +-- TODO `filepath` docs explicitly say this is a no-op on Posix, so why doesn't it export a safe version? +fromBytes' :: BS.ByteString -> PosixPath +fromBytes' = fromMaybe (error "invalid path") . fromBytes diff --git a/evdev-examples/replay/Main.hs b/evdev-examples/replay/Main.hs index 0957ffe..b9b44b7 100644 --- a/evdev-examples/replay/Main.hs +++ b/evdev-examples/replay/Main.hs @@ -4,9 +4,9 @@ import Control.Concurrent import Control.Monad import Data.Foldable import Data.Maybe -import Data.String import Data.Time import System.Environment +import System.OsPath.Posix import Text.Read import Streamly.Prelude qualified as S @@ -18,8 +18,8 @@ import Evdev.Uinput qualified as Uinput main :: IO () main = getArgs >>= \case - "record" : dev : ((\case ["grab"] -> Just True; [] -> Just False; _ -> Nothing) -> Just grab) -> do - d <- newDevice $ fromString dev + "record" : (encodeUtf -> Just dev) : ((\case ["grab"] -> Just True; [] -> Just False; _ -> Nothing) -> Just grab) -> do + d <- newDevice dev when grab $ grabDevice d S.mapM_ print $ readEvents d ["replay"] -> do diff --git a/evdev-streamly/evdev-streamly.cabal b/evdev-streamly/evdev-streamly.cabal index cd5f845..d64a0b0 100644 --- a/evdev-streamly/evdev-streamly.cabal +++ b/evdev-streamly/evdev-streamly.cabal @@ -30,10 +30,10 @@ library bytestring ^>= {0.10, 0.11, 0.12}, containers ^>= {0.6.2, 0.7}, evdev ^>= {2.1, 2.2, 2.3}, + directory ^>= {1.3.8}, extra ^>= {1.6.18, 1.7}, - filepath-bytestring ^>= {1.4.2, 1.5}, + filepath ^>= {1.4.100}, mtl ^>= {2.2, 2.3}, - rawfilepath ^>= {1.0, 1.1}, streamly ^>= {0.9, 0.10}, streamly-fsnotify ^>= 1.1.1, unix ^>= 2.8, diff --git a/evdev-streamly/src/Evdev/Stream.hs b/evdev-streamly/src/Evdev/Stream.hs index 84ff2d6..316b517 100644 --- a/evdev-streamly/src/Evdev/Stream.hs +++ b/evdev-streamly/src/Evdev/Stream.hs @@ -13,23 +13,25 @@ module Evdev.Stream ( import Data.Bool import Data.Either.Extra import Data.Functor +import Data.Maybe 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.FilePath.ByteString (()) +import qualified System.Directory.OsPath +import System.OsPath.Posix (PosixPath, (), decodeUtf, encodeUtf) import Streamly.Prelude (AsyncT, IsStream, MonadAsync, SerialT) import qualified Streamly.Prelude as S import Evdev +import System.OsString.Internal.Types (OsString(..)) + --TODO provide a 'group' operation on streams, representing packets as sets -- | Read all events from a device. @@ -48,7 +50,7 @@ readEventsMany ds = S.fromAsync $ do readEvents' :: Device -> SerialT IO Event -- | Create devices for all paths in the stream. -makeDevices :: IsStream t => t IO RawFilePath -> t IO Device +makeDevices :: IsStream t => t IO PosixPath -> t IO Device makeDevices = S.mapM newDevice -- | All events on all valid devices (in /\/dev\/input/). @@ -77,15 +79,15 @@ allDevices = 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 :: Set PosixPath -> N.Event -> IO (Maybe Device, Set PosixPath) watch watching = \case - N.Added (BS.pack -> p) _ NotDir -> + N.Added (enc -> 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 -> + N.Modified (enc -> p) _ NotDir -> if p `elem` watching then tryNewDevice p <&> \case Right d -> -- success - no longer watch for changes @@ -94,12 +96,14 @@ newDevices = (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 + N.Removed (enc -> p) _ NotDir -> -- device is gone - no longer watch for changes return (Nothing, Set.delete p watching) _ -> return (Nothing, watching) tryNewDevice = printIOError . newDevice + enc = fromMaybe (error "bad fsnotify path conversion") . encodeUtf + dec = fromMaybe (error "bad fsnotify path conversion") . decodeUtf in do - (_,es) <- S.fromEffect $ watchDirectory (BS.unpack evdevDir) N.everything + (_,es) <- S.fromEffect $ watchDirectory (dec evdevDir) N.everything scanMaybe watch Set.empty es --TODO just fix 'newDevices' @@ -108,13 +112,15 @@ newDevices = newDevices' :: (IsStream t, Monad (t IO)) => Int -> t IO Device newDevices' delay = let f = \case - N.Added (BS.pack -> p) _ NotDir -> do + N.Added (enc -> p) _ NotDir -> do threadDelay delay eitherToMaybe <$> tryNewDevice p _ -> return Nothing tryNewDevice = printIOError . newDevice + enc = fromMaybe (error "bad fsnotify path conversion") . encodeUtf + dec = fromMaybe (error "bad fsnotify path conversion") . decodeUtf in do - (_,es) <- S.fromEffect $ watchDirectory (BS.unpack evdevDir) N.everything + (_,es) <- S.fromEffect $ watchDirectory (dec evdevDir) N.everything S.mapMaybeM f es @@ -147,3 +153,9 @@ printIOError' = fmap eitherToMaybe . printIOError -- apply the function iff the guard passes applyWhen :: Bool -> (a -> a) -> a -> a applyWhen = flip $ bool id + +-- TODO hmm unsure what to do here - at the very least move these... +doesFileExist :: PosixPath -> IO Bool +doesFileExist = System.Directory.OsPath.doesFileExist . OsString +listDirectory :: PosixPath -> IO [PosixPath] +listDirectory = fmap (map getOsString) . System.Directory.OsPath.listDirectory . OsString diff --git a/evdev/evdev.cabal b/evdev/evdev.cabal index 25efdf8..3548d1c 100644 --- a/evdev/evdev.cabal +++ b/evdev/evdev.cabal @@ -22,11 +22,11 @@ common common base >= 4.11 && < 5, bytestring ^>= {0.10, 0.11, 0.12}, containers ^>= {0.6.2, 0.7}, + directory ^>= {1.3.8}, extra ^>= {1.6.18, 1.7}, - filepath-bytestring ^>= {1.4.2, 1.5}, + filepath ^>= {1.4.100}, monad-loops ^>= 0.4.3, mtl ^>= {2.2, 2.3}, - rawfilepath ^>= {1.0, 1.1}, time ^>= {1.9.3, 1.10, 1.11, 1.12, 1.13, 1.14}, unix ^>= 2.8, default-language: GHC2021 diff --git a/evdev/src/Evdev.hs b/evdev/src/Evdev.hs index 455d112..45e8bc4 100644 --- a/evdev/src/Evdev.hs +++ b/evdev/src/Evdev.hs @@ -67,10 +67,10 @@ import Data.Tuple.Extra (uncurry3) import Data.Word (Word16) import Foreign ((.|.)) import Foreign.C (CUInt) +import System.OsPath.Posix (PosixPath, encodeUtf) import System.Posix.Process (getProcessID) import System.Posix.Files (readSymbolicLink) -import System.Posix.ByteString (Fd, RawFilePath) -import System.Posix.IO.ByteString (OpenMode (..), defaultFileFlags, openFd) +import System.Posix.PosixString (Fd, OpenMode (..), defaultFileFlags, openFd) import qualified Evdev.LowLevel as LL import Evdev.Codes @@ -204,7 +204,7 @@ toCTimeVal t = LL.CTimeVal n (round $ f * 1_000_000) {- | Create a device from a valid path - usually /\/dev\/input\/eventX/ for some numeric /X/. Use 'newDeviceFromFd' if you need more control over how the device is created. -} -newDevice :: RawFilePath -> IO Device +newDevice :: PosixPath -> IO Device newDevice path = newDeviceFromFd =<< openFd path ReadWrite defaultFileFlags {- | Generalisation of 'newDevice', in case one needs control over the file descriptor, @@ -223,8 +223,8 @@ newDeviceFromFd fd = do return $ Device{cDevice = dev, devicePath = pack path} -- | The usual directory containing devices (/"\/dev\/input"/). -evdevDir :: RawFilePath -evdevDir = "/dev/input" +evdevDir :: PosixPath +evdevDir = fromMaybe (error "evdevDir invalid") $ encodeUtf "/dev/input" deviceName :: Device -> IO ByteString deviceName = join . LL.deviceName . cDevice diff --git a/evdev/test/Test.hs b/evdev/test/Test.hs index f68aecf..1e651af 100644 --- a/evdev/test/Test.hs +++ b/evdev/test/Test.hs @@ -12,13 +12,15 @@ import Data.Time import Evdev import Evdev.Codes import qualified Evdev.Uinput as Uinput -import RawFilePath -import System.FilePath.ByteString +import qualified System.Directory.OsPath import System.IO.Error +import System.OsPath.Posix import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck +import System.OsString.Internal.Types (OsString(..)) + main :: IO () main = defaultMain $ testGroup "Tests" [smoke, inverses] @@ -83,3 +85,7 @@ retryIf p x = go 100 go tries = x `catch` \e -> if p e && tries /= 0 then threadDelay 10_000 >> go (tries - 1) else throw e + +-- TODO copied from `evdev-streamly` - see there for issues +listDirectory :: PosixPath -> IO [PosixPath] +listDirectory = fmap (map getOsString) . System.Directory.OsPath.listDirectory . OsString