Skip to content

Commit

Permalink
WIP migration to PosixPath
Browse files Browse the repository at this point in the history
  • Loading branch information
georgefst committed Aug 15, 2024
1 parent 94d6f36 commit a7a1859
Show file tree
Hide file tree
Showing 8 changed files with 53 additions and 26 deletions.
2 changes: 2 additions & 0 deletions evdev-examples/evdev-examples.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@ executable evtest
bytestring,
evdev,
evdev-streamly,
filepath,
pretty-simple,
streamly,
ghc-options:
Expand Down Expand Up @@ -66,6 +67,7 @@ executable evdev-replay
base,
evdev,
evdev-streamly,
filepath,
mtl,
streamly,
time,
Expand Down
9 changes: 8 additions & 1 deletion evdev-examples/evtest/Main.hs
Original file line number Diff line number Diff line change
@@ -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
Expand All @@ -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
6 changes: 3 additions & 3 deletions evdev-examples/replay/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
4 changes: 2 additions & 2 deletions evdev-streamly/evdev-streamly.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down
34 changes: 23 additions & 11 deletions evdev-streamly/src/Evdev/Stream.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand All @@ -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/).
Expand Down Expand Up @@ -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
Expand All @@ -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'
Expand All @@ -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


Expand Down Expand Up @@ -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
4 changes: 2 additions & 2 deletions evdev/evdev.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
10 changes: 5 additions & 5 deletions evdev/src/Evdev.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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,
Expand All @@ -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
Expand Down
10 changes: 8 additions & 2 deletions evdev/test/Test.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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]

Expand Down Expand Up @@ -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

0 comments on commit a7a1859

Please sign in to comment.