WIP migration to PosixPath

Author: georgefst

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,

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

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

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,

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

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

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

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