From 46015579023dca84dd8299652a30dc0529f184e1 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Wed, 29 Apr 2026 21:03:50 +0530 Subject: [PATCH 1/3] Rename Cp to CpOptions --- src/Streamly/Coreutils/Cp.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/Streamly/Coreutils/Cp.hs b/src/Streamly/Coreutils/Cp.hs index 30a63a02..fb1771d5 100644 --- a/src/Streamly/Coreutils/Cp.hs +++ b/src/Streamly/Coreutils/Cp.hs @@ -12,7 +12,7 @@ module Streamly.Coreutils.Cp ( cp -- * Cp options - , Cp + , CpOptions , CpOverwrite (..) -- , CpBackup , cpOverwrite @@ -68,13 +68,13 @@ data CpMethod = | SymbolicLink | CopyClone -- Use the cloning method if available on the platform -data Cp = Cp +data CpOptions = CpOptions { optOverwrite :: CpOverwrite , optCopyMethod :: CpMethod } -defaultOptions :: Cp -defaultOptions = Cp +defaultOptions :: CpOptions +defaultOptions = CpOptions { optOverwrite = OverwriteAlways , optCopyMethod = CopyContents } @@ -83,14 +83,14 @@ defaultOptions = Cp -- -- Default is 'OverwriteAlways'. -- -cpOverwrite :: CpOverwrite -> Cp -> Cp +cpOverwrite :: CpOverwrite -> CpOptions -> CpOptions cpOverwrite opt options = options { optOverwrite = opt } -- | Specify the copy method. -- -- Default is 'CopyContents'. -- -cpMethod :: CpMethod -> Cp -> Cp +cpMethod :: CpMethod -> CpOptions -> CpOptions cpMethod opt options = options { optCopyMethod = opt } -- | Unconditionally copy the source to destination using the specified copy @@ -121,7 +121,7 @@ cpShouldOverwrite option src dest = else return True -- | @cp option-modifier source destination@. Copy a file or directory. -cp :: (Cp -> Cp) -> FilePath -> FilePath -> IO () +cp :: (CpOptions -> CpOptions) -> FilePath -> FilePath -> IO () cp f src dest = do let options = f defaultOptions r <- cpShouldOverwrite (optOverwrite options) src dest From e45f621df52f5b05f3f3aa1dd356c404ba36a75a Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Wed, 29 Apr 2026 21:53:46 +0530 Subject: [PATCH 2/3] Replace FilePath with Path in FileTest and its users --- src/Streamly/Coreutils/Cp.hs | 23 ++----- src/Streamly/Coreutils/FileTest.hs | 11 ++-- src/Streamly/Coreutils/FileTest/Common.hs | 68 ++++++++++---------- src/Streamly/Coreutils/FileTest/Posix.hs | 20 +++--- src/Streamly/Coreutils/FileTest/Windows.hsc | 47 ++++++++------ src/Streamly/Coreutils/Ln.hs | 8 ++- src/Streamly/Coreutils/Rm.hs | 71 +++++++++++++-------- src/Streamly/Coreutils/Touch.hs | 11 ++-- streamly-coreutils.cabal | 1 + test/Streamly/Test/Coreutils/Rm.hs | 9 ++- 10 files changed, 149 insertions(+), 120 deletions(-) diff --git a/src/Streamly/Coreutils/Cp.hs b/src/Streamly/Coreutils/Cp.hs index fb1771d5..0e3301e6 100644 --- a/src/Streamly/Coreutils/Cp.hs +++ b/src/Streamly/Coreutils/Cp.hs @@ -25,6 +25,7 @@ import Control.Monad (when) import Data.Function ((&)) import System.PosixCompat.Files (createLink) import qualified Streamly.Internal.FileSystem.FileIO as File +import Streamly.FileSystem.Path (Path) import qualified Streamly.FileSystem.Path as Path import Streamly.Coreutils.FileTest @@ -41,15 +42,6 @@ import Streamly.Coreutils.FileTest -- Ideally, cp should not hard link as we have ln for hard linking, but it can -- be useful when we need to hard link recursively. --- Path vs FilePath: --- --- Ideally, we want to use "Path" instead of "FilePath" in this module. However, --- this change isn't very straightforward at the moment due to the dependence on --- System.PosixCompat.Files. --- --- Streamly.Coreutils.FileTest relies on System.PosixCompat.Files for most of --- its APIs. - -- | Specify the overwrite behavior of copy. data CpOverwrite = OverwriteNever -- ^ Do not overwrite when destination file exists @@ -95,20 +87,17 @@ cpMethod opt options = options { optCopyMethod = opt } -- | Unconditionally copy the source to destination using the specified copy -- method. -cpCopy :: CpMethod -> FilePath -> FilePath -> IO () +cpCopy :: CpMethod -> Path -> Path -> IO () cpCopy method src dest = case method of - CopyContents -> do - srcP <- Path.fromString src - destP <- Path.fromString dest - File.readChunks srcP & File.fromChunks destP - HardLink -> createLink src dest + CopyContents -> File.readChunks src & File.fromChunks dest + HardLink -> createLink (Path.toString src) (Path.toString dest) SymbolicLink -> error "Unimplemented" CopyClone -> error "Unimplemented" -- | Determine whether source should be copied to destination based on the -- specified overwrite behavior option. -cpShouldOverwrite :: CpOverwrite -> FilePath -> FilePath -> IO Bool +cpShouldOverwrite :: CpOverwrite -> Path -> Path -> IO Bool cpShouldOverwrite option src dest = case option of OverwriteAlways -> return True @@ -121,7 +110,7 @@ cpShouldOverwrite option src dest = else return True -- | @cp option-modifier source destination@. Copy a file or directory. -cp :: (CpOptions -> CpOptions) -> FilePath -> FilePath -> IO () +cp :: (CpOptions -> CpOptions) -> Path -> Path -> IO () cp f src dest = do let options = f defaultOptions r <- cpShouldOverwrite (optOverwrite options) src dest diff --git a/src/Streamly/Coreutils/FileTest.hs b/src/Streamly/Coreutils/FileTest.hs index ac13c95d..5ee5488b 100644 --- a/src/Streamly/Coreutils/FileTest.hs +++ b/src/Streamly/Coreutils/FileTest.hs @@ -68,9 +68,9 @@ -- -- Example: -- --- >>> _ <- test "a" doesItExist --- >>> _ <- test "/usr/bin/ls" (isReadable `and_` size (> 4096)) --- >>> _ <- test "/usr/bin/ls" (modifyTimeComparedTo "reference.txt" (>)) +-- >>> _ <- test [path|a|] doesItExist +-- >>> _ <- test [path|/usr/bin/ls|] (isReadable `and_` size (> 4096)) +-- >>> _ <- test [path|/usr/bin/ls|] (modifyTimeComparedTo [path|reference.txt|] (>)) module Streamly.Coreutils.FileTest ( @@ -254,13 +254,16 @@ import qualified Streamly.Coreutils.FileTest.Posix as FileTest import qualified Streamly.Coreutils.FileTest.Windows as FileTest #endif +import Streamly.FileSystem.Path (Path) import Streamly.Coreutils.FileTest.Common import Prelude hiding (and, or) -- $setup +-- >>> :set -XQuasiQuotes -- >>> import Prelude hiding (or, and) -- >>> import Data.Time.Clock (NominalDiffTime) -- >>> import Data.Time.Clock.POSIX (POSIXTime) +-- >>> import Streamly.FileSystem.Path (path) ------------------------------------------------------------------------------- -- User and group ownerships @@ -464,7 +467,7 @@ isExecutable = FileTest.isExecutable -- -- The supplied file path is dereferenced if it is a symlink. -- -sameFileAs :: FilePath -> FileTest +sameFileAs :: Path -> FileTest sameFileAs = FileTest.sameFileAs -- | True if the supplied file descriptor refers to a terminal device. diff --git a/src/Streamly/Coreutils/FileTest/Common.hs b/src/Streamly/Coreutils/FileTest/Common.hs index 689efc63..c2f2811e 100644 --- a/src/Streamly/Coreutils/FileTest/Common.hs +++ b/src/Streamly/Coreutils/FileTest/Common.hs @@ -23,7 +23,7 @@ -- -- 'FileTest' predicates operate on 'FileState', which carries: -- --- * The 'FilePath' that was supplied to the runner ('test' / 'testl'). +-- * The 'Path' that was supplied to the runner ('test' / 'testl'). -- * A lazily-populated 'IORef' that caches the 'FileStatus' after the -- first predicate that needs it fetches it. -- * The OS stat action to use ('getFileStatus' for 'test', @@ -40,7 +40,7 @@ -- -- We could use a more restricted StatusTest predicates which consume only the -- file status argument. StatusTest can then be lifted into a FileTest which --- passes a FilePath argument as well and maybe some others. StatusTest +-- passes a Path argument as well and maybe some others. StatusTest -- predicates can be moved into a separate module. But does it buy us anything -- worthwhile? -- @@ -208,6 +208,8 @@ import System.Posix.Types (COff(..), FileMode) import qualified System.PosixCompat.Files as Files import Prelude hiding (and, or) +import Streamly.FileSystem.Path (Path) +import qualified Streamly.FileSystem.Path as Path import Streamly.Internal.Data.Time.Clock import Streamly.Internal.Data.Time.Units @@ -240,7 +242,7 @@ newtype Predicate m a = -- 'testl' supplies 'Files.getSymbolicLinkStatus' (examines the link itself). -- Storing the action here keeps the choice invisible to individual predicates. data FileState = FileState - { filepath :: FilePath + { filepath :: Path -- ^ The path supplied to 'test' \/ 'testl'. , fileStatus :: IORef (Maybe FileStatus) -- XXX store it in IORef using Either type. @@ -268,7 +270,7 @@ requireStatus fs = do -- @fetchFn@ is the OS stat action predicates will use. Pass -- 'Files.getFileStatus' for symlink-following behaviour, or -- 'Files.getSymbolicLinkStatus' to examine the link itself. -newFileState :: FilePath -> IO FileStatus -> IO FileState +newFileState :: Path -> IO FileStatus -> IO FileState newFileState path fetchFn = do ref <- newIORef Nothing pure $ FileState @@ -282,7 +284,7 @@ newFileState path fetchFn = do -- is left empty because no path is available at this call site; 'fetchStatus' -- is set to an error thunk since it must never be called when the cache is -- already populated. -mkFileState :: String -> FilePath -> FileStatus -> IO FileState +mkFileState :: String -> Path -> FileStatus -> IO FileState mkFileState tag fp st = do ref <- newIORef (Just st) return $ FileState @@ -400,8 +402,6 @@ or = foldr or_ false not_ :: FileTest -> FileTest not_ (FileTest (Predicate p)) = FileTest (Predicate (fmap not . p)) --- XXX Use Path instead of filepath. - applyCatchENOENT :: (t -> IO Bool) -> t -> IO Bool applyCatchENOENT f fs = f fs `catch` eatENOENT @@ -415,7 +415,7 @@ applyCatchENOENT f fs = -- This can lead to silent bugs. We should raise an exception if the file does -- not exist unless the predicate is doesItExist. --- | Apply a predicate to a 'FilePath', if the path is a symlink uses the link +-- | Apply a predicate to a 'Path', if the path is a symlink uses the link -- target and not the link itself. See 'testl' for testing the link itself. -- -- * 'test' returns 'True' if the file exists and the predicate is 'True' @@ -427,10 +427,11 @@ applyCatchENOENT f fs = -- * test 'doesItExist' returns false if the path is symlink but it does not -- point to an existing file. -- -test :: FilePath -> FileTest -> IO Bool +test :: Path -> FileTest -> IO Bool test path (FileTest (Predicate f)) = do -- 'Files.getFileStatus' dereferences symlinks. - newFileState path (Files.getFileStatus path) >>= applyCatchENOENT f + newFileState path (Files.getFileStatus (Path.toString path)) + >>= applyCatchENOENT f -- | Like 'test' but uses the path and not the link target if the path is a -- symlink. @@ -442,24 +443,25 @@ test path (FileTest (Predicate f)) = do -- should not be used. -- * Predicates related to file owner, group, size, time stamps are relevant. -- -testl :: FilePath -> FileTest -> IO Bool +testl :: Path -> FileTest -> IO Bool testl path (FileTest (Predicate f)) = - newFileState path (Files.getSymbolicLinkStatus path) >>= applyCatchENOENT f + newFileState path (Files.getSymbolicLinkStatus (Path.toString path)) + >>= applyCatchENOENT f -- | Apply a predicate to a pre-fetched 'FileStatus'. Note you cannot use -- predicates that require filepath when using apply. -testWithStatus :: FilePath -> FileStatus -> FileTest -> IO Bool +testWithStatus :: Path -> FileStatus -> FileTest -> IO Bool testWithStatus fp st (FileTest (Predicate f)) = mkFileState "FileTest.testWithStatus" fp st >>= f -- | Like 'withState' but the supplied function may perform IO. -withStateM :: (FilePath -> FileStatus -> IO Bool) -> FileTest +withStateM :: (Path -> FileStatus -> IO Bool) -> FileTest withStateM p = FileTest $ Predicate $ \fs -> requireStatus fs >>= p (filepath fs) --- | Convert a @FilePath -> FileStatus -> Bool@ function into a 'FileTest' +-- | Convert a @Path -> FileStatus -> Bool@ function into a 'FileTest' -- predicate. -withState :: (FilePath -> FileStatus -> Bool) -> FileTest +withState :: (Path -> FileStatus -> Bool) -> FileTest withState p = withStateM (\fp fs -> pure $ p fp fs) -- | Like 'withStatus' but the supplied function may perform IO. @@ -471,11 +473,11 @@ withStatus :: (FileStatus -> Bool) -> FileTest withStatus p = withStatusM (pure . p) -- | Like 'withPath' but the supplied function may perform IO. -withPathM :: (FilePath -> IO Bool) -> FileTest +withPathM :: (Path -> IO Bool) -> FileTest withPathM p = FileTest $ Predicate $ \fs -> p (filepath fs) --- | Convert a @FilePath -> Bool@ function into a 'FileTest' predicate. -withPath :: (FilePath -> Bool) -> FileTest +-- | Convert a @Path -> Bool@ function into a 'FileTest' predicate. +withPath :: (Path -> Bool) -> FileTest withPath p = withPathM (pure . p) -- | A predicate which is always 'True'. Identity of 'and' style folds. @@ -797,19 +799,17 @@ modifiedBefore t = modifyTime (<= t) modifiedAfter :: POSIXTime -> FileTest modifiedAfter t = modifyTime (>= t) --- XXX Use Path instead of filepath. --- -- NOTE: The specified file path is always dereferenced. Time comparison of -- symlinks is rare, not provided here. timeComparedToWith :: (FileStatus -> POSIXTime) - -> FilePath + -> Path -> (POSIXTime -> POSIXTime -> Bool) -> FileTest timeComparedToWith getFileTime path cmp = withStatusM $ \st -> do - st1 <- Files.getFileStatus path + st1 <- Files.getFileStatus (Path.toString path) pure $ cmp (getFileTime st) (getFileTime st1) -- | Compare the modification time of the file with the modification time of @@ -818,7 +818,7 @@ timeComparedToWith getFileTime path cmp = -- If specified file path is a symlink it is dereferenced. -- modifyTimeComparedTo :: - FilePath -> (POSIXTime -> POSIXTime -> Bool) -> FileTest + Path -> (POSIXTime -> POSIXTime -> Bool) -> FileTest modifyTimeComparedTo = timeComparedToWith Files.modificationTimeHiRes -- | True if the file was modified strictly before the reference file. @@ -827,7 +827,7 @@ modifyTimeComparedTo = timeComparedToWith Files.modificationTimeHiRes -- -- If specified file path is a symlink it is dereferenced. -- -olderThanFile :: FilePath -> FileTest +olderThanFile :: Path -> FileTest olderThanFile path = modifyTimeComparedTo path (<) -- | True if the file was modified strictly after the reference file. @@ -836,7 +836,7 @@ olderThanFile path = modifyTimeComparedTo path (<) -- -- If specified file path is a symlink it is dereferenced. -- -newerThanFile :: FilePath -> FileTest +newerThanFile :: Path -> FileTest newerThanFile path = modifyTimeComparedTo path (>) -- | Compare the access time of the file with the access time of @@ -844,7 +844,7 @@ newerThanFile path = modifyTimeComparedTo path (>) -- -- If specified file path is a symlink it is dereferenced. accessTimeComparedTo :: - FilePath -> (POSIXTime -> POSIXTime -> Bool) -> FileTest + Path -> (POSIXTime -> POSIXTime -> Bool) -> FileTest accessTimeComparedTo = timeComparedToWith Files.accessTimeHiRes -- | True if the file was accessed strictly before the reference file. @@ -852,7 +852,7 @@ accessTimeComparedTo = timeComparedToWith Files.accessTimeHiRes -- >>> accessedBeforeFile path = accessTimeComparedTo path (<) -- -- If specified file path is a symlink it is dereferenced. -accessedBeforeFile :: FilePath -> FileTest +accessedBeforeFile :: Path -> FileTest accessedBeforeFile path = accessTimeComparedTo path (<) -- | True if the file was accessed __strictly__ after the reference file. @@ -860,7 +860,7 @@ accessedBeforeFile path = accessTimeComparedTo path (<) -- >>> accessedAfterFile path = accessTimeComparedTo path (>) -- -- If specified file path is a symlink it is dereferenced. -accessedAfterFile :: FilePath -> FileTest +accessedAfterFile :: Path -> FileTest accessedAfterFile path = accessTimeComparedTo path (>) ----------------------------------- @@ -1083,10 +1083,10 @@ isNonEmptyFile = and_ isFile (size (> 0)) -- >>> sameSizeAs path = sizeComparedTo path (==) -- -- If the supplied file path is a symlink it is dereferenced. -sizeComparedTo :: FilePath -> (Int64 -> Int64 -> Bool) -> FileTest +sizeComparedTo :: Path -> (Int64 -> Int64 -> Bool) -> FileTest sizeComparedTo path rel = withStatusM $ \st -> do - st1 <- Files.getFileStatus path + st1 <- Files.getFileStatus (Path.toString path) pure $ rel (getSize st) (getSize st1) -- | True if the file is __strictly__ larger than the given file. If specified @@ -1096,7 +1096,7 @@ sizeComparedTo path rel = -- -- >>> largerThanFile path = sizeComparedTo path (>) -- -largerThanFile :: FilePath -> FileTest +largerThanFile :: Path -> FileTest largerThanFile path = sizeComparedTo path (>) -- | True if the file is __strictly__ smaller than the given file. If specified @@ -1106,7 +1106,7 @@ largerThanFile path = sizeComparedTo path (>) -- -- >>> smallerThanFile path = sizeComparedTo path (<) -- -smallerThanFile :: FilePath -> FileTest +smallerThanFile :: Path -> FileTest smallerThanFile path = sizeComparedTo path (<) -- | True if the file has the same size as the given file. If specified file @@ -1116,5 +1116,5 @@ smallerThanFile path = sizeComparedTo path (<) -- -- >>> sameSizeAs path = sizeComparedTo path (==) -- -sameSizeAs :: FilePath -> FileTest +sameSizeAs :: Path -> FileTest sameSizeAs path = sizeComparedTo path (==) diff --git a/src/Streamly/Coreutils/FileTest/Posix.hs b/src/Streamly/Coreutils/FileTest/Posix.hs index f5979c26..03eb6d70 100644 --- a/src/Streamly/Coreutils/FileTest/Posix.hs +++ b/src/Streamly/Coreutils/FileTest/Posix.hs @@ -34,6 +34,8 @@ import qualified System.PosixCompat.Files as Files import qualified System.Posix.User as User import qualified System.Posix.Terminal as Terminal +import Streamly.FileSystem.Path (Path) +import qualified Streamly.FileSystem.Path as Path import Streamly.Coreutils.FileTest.Common -- XXX 'getFdStatus' is not implemented for Windows in unix-compat. @@ -46,7 +48,7 @@ import Streamly.Coreutils.FileTest.Common -- testFd :: Fd -> FileTest -> IO Bool testFd fd (FileTest (Predicate f)) = - -- XXX We should pass "Either Fd FilePath" in state. + -- XXX We should pass "Either Fd Path" in state. let fp = error $ "FileTest.testFd: filepath cannot be used" in Files.getFdStatus fd >>= mkFileState "FileTest.testFd" fp >>= f @@ -59,10 +61,10 @@ testHandle = undefined -- -- The supplied file path is dereferenced if it is a symlink. -- -sameFileAs :: FilePath -> FileTest +sameFileAs :: Path -> FileTest sameFileAs path = withStatusM $ \st -> do - st1 <- Files.getFileStatus path + st1 <- Files.getFileStatus (Path.toString path) pure $ Files.deviceID st == Files.deviceID st1 && Files.fileID st == Files.fileID st1 @@ -106,20 +108,20 @@ isOwnedByCurrentGroup = -- getfacl x -- test -r x || echo "not readable" -pathIsReadable :: FilePath -> IO Bool -pathIsReadable path = Posix.fileAccess path True False False +pathIsReadable :: Path -> IO Bool +pathIsReadable path = Posix.fileAccess (Path.toString path) True False False isReadable :: FileTest isReadable = withPathM pathIsReadable -pathIsWritable :: FilePath -> IO Bool -pathIsWritable path = Posix.fileAccess path False True False +pathIsWritable :: Path -> IO Bool +pathIsWritable path = Posix.fileAccess (Path.toString path) False True False isWritable :: FileTest isWritable = withPathM pathIsWritable -pathIsExecutable :: FilePath -> IO Bool -pathIsExecutable path = Posix.fileAccess path False False True +pathIsExecutable :: Path -> IO Bool +pathIsExecutable path = Posix.fileAccess (Path.toString path) False False True isExecutable :: FileTest isExecutable = withPathM pathIsExecutable diff --git a/src/Streamly/Coreutils/FileTest/Windows.hsc b/src/Streamly/Coreutils/FileTest/Windows.hsc index 9a670ceb..ff8abce8 100644 --- a/src/Streamly/Coreutils/FileTest/Windows.hsc +++ b/src/Streamly/Coreutils/FileTest/Windows.hsc @@ -81,6 +81,8 @@ import System.Win32.Types import qualified System.Win32.Types as Win32 import Foreign +import Streamly.FileSystem.Path (Path) +import qualified Streamly.FileSystem.Path as Path import Streamly.Coreutils.FileTest.Common ------------------------------------------------------------------------------- @@ -246,10 +248,10 @@ instance Storable GENERIC_MAPPING where -- Uses fILE_FLAG_BACKUP_SEMANTICS so that directories can be opened too. -- Uses 0 for desired access since only metadata is needed; this succeeds -- even when data-read access is restricted. -withFileHandle :: FilePath -> (HANDLE -> IO a) -> IO a +withFileHandle :: Path -> (HANDLE -> IO a) -> IO a withFileHandle path action = bracket - (createFile path 0 + (createFile (Path.toString path) 0 (fILE_SHARE_READ .|. fILE_SHARE_WRITE .|. fILE_SHARE_DELETE) Nothing oPEN_EXISTING @@ -260,7 +262,7 @@ withFileHandle path action = -- | Return a (volumeSerialNumber, fileIndex) pair that uniquely identifies -- a file on the local system, following the same-inode logic as POSIX. -fileId :: FilePath -> IO (DWORD, Word64) +fileId :: Path -> IO (DWORD, Word64) fileId path = withFileHandle path $ \h -> do info <- getFileInformationByHandle h @@ -270,7 +272,7 @@ fileId path = -- | True if both paths refer to the same underlying file or directory, -- equivalent to POSIX inode comparison. -sameFileAs :: FilePath -> FileTest +sameFileAs :: Path -> FileTest sameFileAs path2 = withPathM $ \path1 -> do id1 <- fileId path1 @@ -318,9 +320,9 @@ isTerminalFd (Fd fd) = -- We bind c_GetFileSecurity directly (as Ptr ()) rather than using -- getFileSecurity, whose SecurityDescriptor newtype is opaque and -- incompatible with c_GetSecurityDescriptorOwner. -withFileOwnerSID :: FilePath -> (PSID -> IO a) -> IO a +withFileOwnerSID :: Path -> (PSID -> IO a) -> IO a withFileOwnerSID path action = - withFilePath path $ \pPath -> + withFilePath (Path.toString path) $ \pPath -> alloca $ \pLenNeeded -> do -- First call: get required buffer size _ <- c_GetFileSecurity @@ -367,7 +369,7 @@ withEffectiveUserSID action = do -- Ownership ------------------------------------------------------------------------------- -isPathOwnedByCurrentUser :: FilePath -> IO Bool +isPathOwnedByCurrentUser :: Path -> IO Bool isPathOwnedByCurrentUser path = withFileOwnerSID path $ \fileSid -> withEffectiveUserSID $ \userSid -> @@ -380,7 +382,7 @@ isOwnedByCurrentUser = withPathM isPathOwnedByCurrentUser withFilePrimaryGroupSID = undefined withEffectiveGroupSID = undefined -isPathOwnedByCurrentGroup :: FilePath -> IO Bool +isPathOwnedByCurrentGroup :: Path -> IO Bool isPathOwnedByCurrentGroup path = withFilePrimaryGroupSID path $ \fileSid -> withEffectiveGroupSID $ \userSid -> @@ -405,10 +407,11 @@ isOwnedByCurrentGroup = withPathM isPathOwnedByCurrentGroup -- -- Returns false if the file is locked and not shared for reading. -- -isPathReadableNow :: FilePath -> IO Bool +isPathReadableNow :: Path -> IO Bool isPathReadableNow path = (do h <- createFile - path fILE_READ_DATA shareMode Nothing oPEN_EXISTING + (Path.toString path) + fILE_READ_DATA shareMode Nothing oPEN_EXISTING flags Nothing closeHandle h return True @@ -425,7 +428,7 @@ isReadableNow = withPathM isPathReadableNow -- -- Returns false if the file is locked and not shared for writing. -- -isFileWritableNow :: FilePath -> FileStatus -> IO Bool +isFileWritableNow :: Path -> FileStatus -> IO Bool isFileWritableNow path st = do isDirectory <- testWithStatus path st isDir -- Under unix-compat on Windows, ownerWriteMode corresponds to the @@ -448,7 +451,8 @@ isFileWritableNow path st = do | otherwise = 0 bracket (createFile - path desiredAccess shareMode Nothing oPEN_EXISTING + (Path.toString path) + desiredAccess shareMode Nothing oPEN_EXISTING flags Nothing) closeHandle (\_ -> return True) @@ -459,10 +463,11 @@ isWritableNow = withStateM isFileWritableNow -- | Returns true if file is executable. -- Returns false if the file is locked and not shared for execution. -isPathExecutableNow :: FilePath -> IO Bool +isPathExecutableNow :: Path -> IO Bool isPathExecutableNow path = (do h <- createFile - path fILE_EXECUTE shareMode Nothing oPEN_EXISTING + (Path.toString path) + fILE_EXECUTE shareMode Nothing oPEN_EXISTING flags Nothing closeHandle h return True @@ -497,13 +502,13 @@ openCurrentProcessImpersonationToken = do -- | Checks the file's DACL against the current process token for the -- given access mask. Implements the Windows equivalent of POSIX access(). -pathAccess :: FilePath -> DWORD -> IO Bool +pathAccess :: Path -> DWORD -> IO Bool pathAccess path mask = bracket openCurrentProcessImpersonationToken (\h -> c_CloseHandle h >> return ()) $ \token -> - withFilePath path $ \pPath -> + withFilePath (Path.toString path) $ \pPath -> alloca $ \ppSd -> do ret <- c_GetNamedSecurityInfo pPath @@ -549,15 +554,15 @@ pathAccess path mask = | otherwise = return False -- | Windows equivalent of POSIX: access(path, R_OK). Matches @test -r@. -pathIsReadable :: FilePath -> IO Bool +pathIsReadable :: Path -> IO Bool pathIsReadable path = pathAccess path fILE_GENERIC_READ -- | Windows equivalent of POSIX: access(path, W_OK). Matches @test -w@. -pathIsWritable :: FilePath -> IO Bool +pathIsWritable :: Path -> IO Bool pathIsWritable path = pathAccess path fILE_GENERIC_WRITE -- | Windows equivalent of POSIX: access(path, X_OK). Matches @test -x@. -pathIsExecutable :: FilePath -> IO Bool +pathIsExecutable :: Path -> IO Bool pathIsExecutable path = pathAccess path fILE_GENERIC_EXECUTE isReadable :: FileTest @@ -574,14 +579,14 @@ fILE_ATTRIBUTE_DIRECTORY = 0x10 -- | True iff the path is a reparse point (symlink or junction) that the OS -- also marks as a directory object. -isPathDirSymLink :: FilePath -> FileStatus -> IO Bool +isPathDirSymLink :: Path -> FileStatus -> IO Bool isPathDirSymLink path st = -- XXX We should cache the raw attributes for multiple checks Currently we -- cache only the FileStatus from unix-compat which does not have full info -- for windows and we need to make additional calls. if isSymbolicLink st then do - attrs <- getFileAttributes path + attrs <- getFileAttributes (Path.toString path) return $ attrs .&. fILE_ATTRIBUTE_DIRECTORY /= 0 else return False diff --git a/src/Streamly/Coreutils/Ln.hs b/src/Streamly/Coreutils/Ln.hs index 46892c06..d1d87e41 100644 --- a/src/Streamly/Coreutils/Ln.hs +++ b/src/Streamly/Coreutils/Ln.hs @@ -22,6 +22,8 @@ import Control.Monad (when) import Streamly.Coreutils.FileTest (test, doesItExist) import qualified System.PosixCompat.Files as Posix +import Streamly.FileSystem.Path (Path) +import qualified Streamly.FileSystem.Path as Path data Ln = Ln { lnForce :: Bool @@ -37,15 +39,15 @@ force opt cfg = cfg {lnForce = opt} symbolic :: Bool -> Ln -> Ln symbolic opt cfg = cfg {lnSymbolic = opt} -ln :: (Ln -> Ln) -> FilePath -> FilePath -> IO () +ln :: (Ln -> Ln) -> Path -> Path -> IO () ln f src tgt = do let opt = f defaultConfig when (lnForce opt == False) $ do found <- test tgt doesItExist when found $ error msg case lnSymbolic opt of - False -> Posix.createLink src tgt - True -> Posix.createSymbolicLink src tgt + False -> Posix.createLink (Path.toString src) (Path.toString tgt) + True -> Posix.createSymbolicLink (Path.toString src) (Path.toString tgt) where diff --git a/src/Streamly/Coreutils/Rm.hs b/src/Streamly/Coreutils/Rm.hs index bd003889..8d663011 100644 --- a/src/Streamly/Coreutils/Rm.hs +++ b/src/Streamly/Coreutils/Rm.hs @@ -103,6 +103,8 @@ import System.Directory , writable ) import System.FilePath (()) +import Streamly.FileSystem.Path (Path) +import qualified Streamly.FileSystem.Path as Path -- TODO: backward compatibility for Rm, None, Nuke changes. @@ -156,7 +158,7 @@ recursive opt cfg = cfg { rmRecursive = opt } -- Internal ------------------------------------------------------------------------------- -withWriteProtectionCheck :: FilePath -> (FilePath -> IO b) -> [Char] -> IO b +withWriteProtectionCheck :: Path -> (Path -> IO b) -> String -> IO b withWriteProtectionCheck path f msg = do -- Note: there is an inherent TOCTOU race between this check and -- the call to the deletion function "f". @@ -166,16 +168,18 @@ withWriteProtectionCheck path f msg = do else error $ "rm: cannot remove '" - ++ path ++ "': write-protected " ++ msg + ++ Path.toString path ++ "': write-protected " ++ msg -rmdir :: RmOptions -> FilePath -> IO () +rmdir :: RmOptions -> Path -> IO () rmdir options path = + let pathStr = Path.toString path + in case rmRecursive options of False -> - error $ "rm: cannot remove '" ++ path ++ "': Is a directory" + error $ "rm: cannot remove '" ++ pathStr ++ "': Is a directory" True -> case rmForce options of - FullForce -> removePathForcibly path + FullForce -> removePathForcibly pathStr Force -> #if defined(CABAL_OS_WINDOWS) -- On Unix removePathForcibly makes directories writable to @@ -185,34 +189,45 @@ rmdir options path = -- them deletable. This is exactly what we want for the -- Force option. So FullForce and Force are essentially -- same on Windows. - removePathForcibly path + removePathForcibly pathStr #else - removeDirectoryRecursive path + removeDirectoryRecursive pathStr #endif NoForce -> do - contents <- listDirectory path + contents <- listDirectory pathStr withWriteProtectionCheck path (const (pure ())) "directory" - forM_ contents $ \item -> + forM_ contents $ \item -> do + itemPath <- Path.fromString (pathStr item) rm (withForce (rmForce options) . recursive True) - (path item) - withWriteProtectionCheck path removeDirectory "directory" + itemPath + withWriteProtectionCheck + path + (removeDirectory . Path.toString) + "directory" -- XXX implement and use "chmod" -- | Make a path writable by the owner. Used on Windows before deletion to -- clear FILE_ATTRIBUTE_READONLY. Compiled on all platforms so that it is -- tested on Unix too, but only called on Windows. -_setWritable :: FilePath -> IO () +_setWritable :: Path -> IO () _setWritable path = do - perms <- getPermissions path + let pathStr = Path.toString path + perms <- getPermissions pathStr when (not (writable perms)) $ - setPermissions path (perms { writable = True }) + setPermissions pathStr (perms { writable = True }) -rmfile :: RmOptions -> FilePath -> IO () +rmfile :: RmOptions -> Path -> IO () rmfile options path = + let pathStr = Path.toString path + in case rmForce options of - FullForce -> removePathForcibly path - NoForce -> withWriteProtectionCheck path removeFile "regular file" + FullForce -> removePathForcibly pathStr + NoForce -> + withWriteProtectionCheck + path + (removeFile . Path.toString) + "regular file" Force -> do #if defined(CABAL_OS_WINDOWS) -- On Windows, file deletability is tied to the file's own @@ -220,9 +235,9 @@ rmfile options path = -- matters). Force must clear it before unlinking. _setWritable path #endif - removeFile path + removeFile pathStr -performRm :: RmOptions -> FilePath -> IO () +performRm :: RmOptions -> Path -> IO () performRm options path = do -- isDir returns false if path is symlink dir <- testl path isDir @@ -237,7 +252,7 @@ performRm options path = do FullForce -> _setWritable path Force -> _setWritable path NoForce -> return () - removeDirectory path + removeDirectory (Path.toString path) else rmfile options path #else rmfile options path @@ -255,7 +270,7 @@ performRm options path = do -- -- Note: When 'recursive' is 'False' (the default), passing a directory path -- always results in an error, even under 'FullForce'. -rm :: (RmOptions -> RmOptions) -> FilePath -> IO () +rm :: (RmOptions -> RmOptions) -> Path -> IO () rm f path = do let options = f defaultConfig -- Note this test is required not just for existence check but also so that @@ -267,7 +282,7 @@ rm f path = do else case rmForce options of NoForce -> - error $ "rm: cannot remove '" ++ path + error $ "rm: cannot remove '" ++ Path.toString path ++ "': No such file or directory" _ -> return () @@ -286,7 +301,7 @@ rm f path = do -- @Note:@ Under 'NoForce', this fails if the path does not exist, is a -- broken symlink, or is a regular file. Under 'Force', these cases -- are silent no-ops. -rmContents :: RmForce -> FilePath -> IO () +rmContents :: RmForce -> Path -> IO () rmContents flevel path = do -- 'test' follows symlinks, unlike 'testl'. -- This checks if the *target* exists and is a directory. @@ -294,13 +309,15 @@ rmContents flevel path = do if isTargetDir then do - contents <- listDirectory path - forM_ contents $ \item -> - rm (withForce flevel . recursive True) (path item) + let pathStr = Path.toString path + contents <- listDirectory pathStr + forM_ contents $ \item -> do + itemPath <- Path.fromString (pathStr item) + rm (withForce flevel . recursive True) itemPath else case flevel of NoForce -> - error $ "rmContents: cannot access '" ++ path + error $ "rmContents: cannot access '" ++ Path.toString path ++ "': Not a directory or broken symlink" _ -> return () diff --git a/src/Streamly/Coreutils/Touch.hs b/src/Streamly/Coreutils/Touch.hs index 5ad44354..93649d92 100644 --- a/src/Streamly/Coreutils/Touch.hs +++ b/src/Streamly/Coreutils/Touch.hs @@ -22,6 +22,8 @@ where import Control.Monad (unless) import Streamly.Coreutils.FileTest (test, doesItExist) import System.IO (openFile, IOMode(WriteMode), hClose) +import Streamly.FileSystem.Path (Path) +import qualified Streamly.FileSystem.Path as Path #if !defined (CABAL_OS_WINDOWS) import qualified System.Posix.Files as Posix (touchSymbolicLink) @@ -60,18 +62,19 @@ create opt cfg = cfg {createNew = opt} -- * create True -- * followLinks True -- -touch :: (Touch -> Touch) -> FilePath -> IO () +touch :: (Touch -> Touch) -> Path -> IO () touch f path = do let opt = f defaultConfig + pathStr = Path.toString path if (createNew opt == True && deRef opt == True) then do found <- test path doesItExist - unless found $ openFile path WriteMode >>= hClose + unless found $ openFile pathStr WriteMode >>= hClose else case deRef opt of - True -> Posix.touchFile path + True -> Posix.touchFile pathStr #if !defined (CABAL_OS_WINDOWS) - False -> Posix.touchSymbolicLink path + False -> Posix.touchSymbolicLink pathStr #else -- XXX Is it possible to support this on Windows? False -> error "touch: followLinks=False not supported on Windows" diff --git a/streamly-coreutils.cabal b/streamly-coreutils.cabal index bd30795f..9c50e507 100644 --- a/streamly-coreutils.cabal +++ b/streamly-coreutils.cabal @@ -241,6 +241,7 @@ test-suite Streamly.Coreutils.Rm , directory , filepath , hspec + , streamly-core , streamly-coreutils , temporary , unix-compat diff --git a/test/Streamly/Test/Coreutils/Rm.hs b/test/Streamly/Test/Coreutils/Rm.hs index 33996422..7f8853b6 100644 --- a/test/Streamly/Test/Coreutils/Rm.hs +++ b/test/Streamly/Test/Coreutils/Rm.hs @@ -64,12 +64,19 @@ import System.Posix.User (getRealUserID) import System.Posix.Types (FileMode) import Test.Hspec -import Streamly.Coreutils.Rm +import Streamly.Coreutils.Rm hiding (rm) +import qualified Streamly.Coreutils.Rm as Rm +import qualified Streamly.FileSystem.Path as Path ------------------------------------------------------------------------------- -- Helpers ------------------------------------------------------------------------------- +rm :: (RmOptions -> RmOptions) -> FilePath -> IO () +rm f path = do + pathP <- Path.fromString path + Rm.rm f pathP + -- | Run a test inside a fresh temporary directory, cleaning up afterwards. withTempDir :: (FilePath -> IO ()) -> IO () withTempDir action = do From 84e6baa40c1b8f3acac5f385702fe4198f742f7b Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Thu, 30 Apr 2026 07:48:33 +0530 Subject: [PATCH 3/3] Replace FilePath by streamly Path at all places --- src/Streamly/Coreutils/Directory.hs | 19 +++--- src/Streamly/Coreutils/Dirname.hs | 7 +- src/Streamly/Coreutils/Mkdir.hs | 13 ++-- src/Streamly/Coreutils/Mv.hs | 13 ++-- src/Streamly/Coreutils/ReadLink.hs | 7 +- src/Streamly/Coreutils/ResolvePath.hs | 95 ++++++++++++++------------- src/Streamly/Coreutils/Stat.hs | 10 +-- src/Streamly/Coreutils/Which.hs | 17 +++-- 8 files changed, 106 insertions(+), 75 deletions(-) diff --git a/src/Streamly/Coreutils/Directory.hs b/src/Streamly/Coreutils/Directory.hs index 001d2066..3ec984e7 100644 --- a/src/Streamly/Coreutils/Directory.hs +++ b/src/Streamly/Coreutils/Directory.hs @@ -23,26 +23,29 @@ import System.Directory , setCurrentDirectory ) +import Streamly.FileSystem.Path (Path) +import qualified Streamly.FileSystem.Path as Path + -- | Get home directory of the current user. -home :: IO FilePath -home = getHomeDirectory +home :: IO Path +home = getHomeDirectory >>= Path.fromString -- XXX Support -L and -P options? Move this to its own module. -- | Get the current working directory of the process. -pwd :: IO FilePath -pwd = getCurrentDirectory +pwd :: IO Path +pwd = getCurrentDirectory >>= Path.fromString -- XXX Set PWD env var? Move to its own module? -- Support -L, -P options? -- | Set the current working directory of the process. -cd :: FilePath -> IO () -cd = setCurrentDirectory +cd :: Path -> IO () +cd = setCurrentDirectory . Path.toString -- | Run an IO action with the given working directory and restore the -- original working directory afterwards, even if the given action fails -- due to an exception. -- -withCd :: FilePath -> IO () -> IO () -withCd = withCurrentDirectory +withCd :: Path -> IO () -> IO () +withCd = withCurrentDirectory . Path.toString diff --git a/src/Streamly/Coreutils/Dirname.hs b/src/Streamly/Coreutils/Dirname.hs index 74b525cb..167f2237 100644 --- a/src/Streamly/Coreutils/Dirname.hs +++ b/src/Streamly/Coreutils/Dirname.hs @@ -14,5 +14,8 @@ where import System.FilePath (takeDirectory) -dirname :: FilePath -> FilePath -dirname = takeDirectory +import Streamly.FileSystem.Path (Path) +import qualified Streamly.FileSystem.Path as Path + +dirname :: Path -> IO Path +dirname path = Path.fromString (takeDirectory (Path.toString path)) diff --git a/src/Streamly/Coreutils/Mkdir.hs b/src/Streamly/Coreutils/Mkdir.hs index 3d3f8c8d..1764d536 100644 --- a/src/Streamly/Coreutils/Mkdir.hs +++ b/src/Streamly/Coreutils/Mkdir.hs @@ -34,6 +34,9 @@ where import System.Directory (createDirectory, createDirectoryIfMissing) +import Streamly.FileSystem.Path (Path) +import qualified Streamly.FileSystem.Path as Path + -- Design Notes -- -- No existOk: makeParents True implies exist-ok (matching coreutils -p behaviour). @@ -74,16 +77,16 @@ makeParents opt cfg = cfg {mdParents = opt} parents :: Bool -> MkdirOptions -> MkdirOptions parents = makeParents --- | Create a directory at the given 'FilePath'. +-- | Create a directory at the given 'Path'. -- -- The first argument is an options modifier applied to the default -- 'MkdirOptions'. Pass 'id' to use all defaults. -- -- >> mkdir id "a" -- create a single directory -- >> mkdir (makeParents True) "a/b/c" -- create with missing parents -mkdir :: (MkdirOptions -> MkdirOptions) -> FilePath -> IO () -mkdir f = do +mkdir :: (MkdirOptions -> MkdirOptions) -> Path -> IO () +mkdir f path = do let opt = f defaultConfig case mdParents opt of - False -> createDirectory - True -> createDirectoryIfMissing True + False -> createDirectory (Path.toString path) + True -> createDirectoryIfMissing True (Path.toString path) diff --git a/src/Streamly/Coreutils/Mv.hs b/src/Streamly/Coreutils/Mv.hs index 48ed641a..f5f21405 100644 --- a/src/Streamly/Coreutils/Mv.hs +++ b/src/Streamly/Coreutils/Mv.hs @@ -20,6 +20,9 @@ where import System.Directory (doesPathExist, renamePath) +import Streamly.FileSystem.Path (Path) +import qualified Streamly.FileSystem.Path as Path + newtype Mv = Mv {mvForce :: Bool} defaultConfig :: Mv @@ -28,16 +31,18 @@ defaultConfig = Mv False force :: Bool -> Mv -> Mv force opt cfg = cfg {mvForce = opt} -mv :: (Mv -> Mv) -> FilePath -> FilePath -> IO () +mv :: (Mv -> Mv) -> Path -> Path -> IO () mv f old new = do let opt = f defaultConfig + oldStr = Path.toString old + newStr = Path.toString new case mvForce opt of - True -> renamePath old new + True -> renamePath oldStr newStr False -> do - exists <- doesPathExist new + exists <- doesPathExist newStr if exists then error msg - else renamePath old new + else renamePath oldStr newStr where diff --git a/src/Streamly/Coreutils/ReadLink.hs b/src/Streamly/Coreutils/ReadLink.hs index a13bc97e..baa74265 100644 --- a/src/Streamly/Coreutils/ReadLink.hs +++ b/src/Streamly/Coreutils/ReadLink.hs @@ -14,6 +14,9 @@ where import System.Directory (getSymbolicLinkTarget) +import Streamly.FileSystem.Path (Path) +import qualified Streamly.FileSystem.Path as Path + -- | If the path is a symbolic link return the link target. -readLink :: FilePath -> IO FilePath -readLink = getSymbolicLinkTarget +readLink :: Path -> IO Path +readLink path = getSymbolicLinkTarget (Path.toString path) >>= Path.fromString diff --git a/src/Streamly/Coreutils/ResolvePath.hs b/src/Streamly/Coreutils/ResolvePath.hs index 690582d5..d5bf594f 100644 --- a/src/Streamly/Coreutils/ResolvePath.hs +++ b/src/Streamly/Coreutils/ResolvePath.hs @@ -49,13 +49,13 @@ -- >>> _ = resolvePath (resolutionMode ResolveThenParent) -- realpath -P -- >>> _ = resolvePath (resolutionMode ParentThenResolve) -- realpath -L -- >>> _ = resolvePath (resolutionMode NoSymlinkResolution) -- realpath -s --- >>> _ = resolvePath (relativeTo "/usr/bin") -- realpath --relative-to=/usr/bin --- >>> _ = resolvePath (relativeWithin "/usr") -- realpath --relative-base=/usr +-- >>> _ = resolvePath (relativeTo [path|/usr/bin|]) -- realpath --relative-to=/usr/bin +-- >>> _ = resolvePath (relativeWithin [path|/usr|]) -- realpath --relative-base=/usr -- -- Composed modifiers: -- -- >>> -- realpath --relative-to=/usr/bin --relative-base=/usr --- >>> _ = resolvePath (relativeTo "/usr/bin" . relativeWithin "/usr") +-- >>> _ = resolvePath (relativeTo [path|/usr/bin|] . relativeWithin [path|/usr|]) -- -- == Caveats -- @@ -97,10 +97,16 @@ import System.FilePath (makeRelative, splitDirectories, joinPath, isAbsolute, takeDirectory) -- import System.IO.Error (ioError, userError) +import Streamly.FileSystem.Path (Path) +import qualified Streamly.FileSystem.Path as Path + -- $setup +-- >>> :set -XQuasiQuotes -- >>> import Control.Exception (try, SomeException) -- >>> import System.Directory (canonicalizePath, getCurrentDirectory, getTemporaryDirectory) -- >>> import System.FilePath ((), isAbsolute) +-- >>> import Streamly.FileSystem.Path (path) +-- >>> import qualified Streamly.FileSystem.Path as Path -- = Design notes -- @@ -240,8 +246,8 @@ data ResolutionMode data ResolvePathOptions = ResolvePathOptions { _existenceCheck :: ExistenceCheck , _resolutionMode :: ResolutionMode - , _relativeTo :: Maybe FilePath - , _relativeWithin :: Maybe FilePath + , _relativeTo :: Maybe Path + , _relativeWithin :: Maybe Path } -- Default configuration: the seed value that modifiers are composed @@ -265,13 +271,13 @@ defaultConfig = ResolvePathOptions -- -- 'RequirePath' rejects a path whose final component does not exist: -- --- >>> cwd <- getCurrentDirectory +-- >>> cwd <- getCurrentDirectory >>= Path.fromString -- >>> r1 <- resolvePath (existenceCheck RequirePath) cwd -- >>> r2 <- resolvePath (existenceCheck RequirePath) r1 --- >>> r1 == r2 +-- >>> Path.toString r1 == Path.toString r2 -- True -- --- >>> result <- try (resolvePath (existenceCheck RequirePath) "/definitely/does/not/exist/xyzzy") :: IO (Either SomeException FilePath) +-- >>> result <- try (resolvePath (existenceCheck RequirePath) [path|/definitely/does/not/exist/xyzzy|]) :: IO (Either SomeException Path.Path) -- >>> either (const True) (const False) result -- True -- @@ -279,21 +285,21 @@ defaultConfig = ResolvePathOptions -- as its parent directory exists. -- -- >>> tmp <- getTemporaryDirectory --- >>> r1 <- resolvePath id (tmp "missing-leaf") --- >>> r2 <- canonicalizePath (tmp "missing-leaf") --- >>> r1 == r2 +-- >>> r1 <- resolvePath id =<< Path.fromString (tmp "missing-leaf") +-- >>> r2 <- canonicalizePath (tmp "missing-leaf") >>= Path.fromString +-- >>> Path.toString r1 == Path.toString r2 -- True -- -- 'RequireParents' rejects a path whose parent directory does not exist: -- --- >>> result <- try (resolvePath id "/definitely/does/not/exist/child") :: IO (Either SomeException FilePath) +-- >>> result <- try (resolvePath id [path|/definitely/does/not/exist/child|]) :: IO (Either SomeException Path.Path) -- >>> either (const True) (const False) result -- True -- -- 'RequireNone' accepts any path, whether it exists or not: -- --- >>> r <- resolvePath (existenceCheck RequireNone) "/definitely/does/not/exist/child" --- >>> null r +-- >>> r <- resolvePath (existenceCheck RequireNone) [path|/definitely/does/not/exist/child|] +-- >>> null (Path.toString r) -- False existenceCheck :: ExistenceCheck -> ResolvePathOptions -> ResolvePathOptions existenceCheck check opts = opts { _existenceCheck = check } @@ -314,20 +320,20 @@ existenceCheck check opts = opts { _existenceCheck = check } -- -- >>> tmp <- getTemporaryDirectory -- >>> let opts m = resolutionMode m . existenceCheck RequireNone --- >>> r1 <- resolvePath (opts ParentThenResolve) (tmp "a" ".." "b") --- >>> r2 <- resolvePath (existenceCheck RequireNone) (tmp "b") --- >>> r1 == r2 +-- >>> r1 <- resolvePath (opts ParentThenResolve) =<< Path.fromString (tmp "a" ".." "b") +-- >>> r2 <- resolvePath (existenceCheck RequireNone) =<< Path.fromString (tmp "b") +-- >>> Path.toString r1 == Path.toString r2 -- True -- -- 'NoSymlinkResolution' collapses @..@ and @.@ textually and performs no -- symlink resolution (so the base is not canonicalized - the result -- may differ from 'ResolveThenParent' when the base contains symlinks): -- --- >>> r <- resolvePath (opts NoSymlinkResolution) (tmp "a" ".." "b") --- >>> r == tmp "b" +-- >>> r <- resolvePath (opts NoSymlinkResolution) =<< Path.fromString (tmp "a" ".." "b") +-- >>> Path.toString r == tmp "b" -- True --- >>> r <- resolvePath (opts NoSymlinkResolution) (tmp "." "x") --- >>> r == tmp "x" +-- >>> r <- resolvePath (opts NoSymlinkResolution) =<< Path.fromString (tmp "." "x") +-- >>> Path.toString r == tmp "x" -- True resolutionMode :: ResolutionMode -> ResolvePathOptions -> ResolvePathOptions resolutionMode mode opts = opts { _resolutionMode = mode } @@ -346,9 +352,9 @@ resolutionMode mode opts = opts { _resolutionMode = mode } -- -- A path relative to itself is @\".\"@: -- --- >>> resolvePath (relativeTo "/") "/" +-- >>> Path.toString <$> resolvePath (relativeTo [path|/|]) [path|/|] -- "." -relativeTo :: FilePath -> ResolvePathOptions -> ResolvePathOptions +relativeTo :: Path -> ResolvePathOptions -> ResolvePathOptions relativeTo base opts = opts { _relativeTo = Just base } -- XXX realpath performs existence check for --relative-to path as well: @@ -386,15 +392,15 @@ relativeTo base opts = opts { _relativeTo = Just base } -- -- Inside the boundary, the path is relativized: -- --- >>> resolvePath (relativeWithin "/") "/missing-leaf" +-- >>> Path.toString <$> resolvePath (relativeWithin [path|/|]) [path|/missing-leaf|] -- "missing-leaf" -- -- Outside the boundary, the absolute path is returned unchanged: -- --- >>> tmp <- getTemporaryDirectory --- >>> resolvePath (relativeWithin tmp) "/missing-leaf" +-- >>> tmp <- getTemporaryDirectory >>= Path.fromString +-- >>> Path.toString <$> resolvePath (relativeWithin tmp) [path|/missing-leaf|] -- "/missing-leaf" -relativeWithin :: FilePath -> ResolvePathOptions -> ResolvePathOptions +relativeWithin :: Path -> ResolvePathOptions -> ResolvePathOptions relativeWithin dir opts = opts { _relativeWithin = Just dir } -- Collapse @.@ and @..@ segments lexically. On absolute paths, @..@ @@ -403,7 +409,7 @@ relativeWithin dir opts = opts { _relativeWithin = Just dir } -- -- Uses 'splitDirectories' / 'joinPath' from @filepath@ to stay -- platform-correct on separator handling. -lexicalCollapse :: FilePath -> FilePath +lexicalCollapse :: String -> String lexicalCollapse p = let parts = splitDirectories p absolute = isAbsolute p @@ -428,7 +434,7 @@ lexicalCollapse p = -- Perform the pre-resolution existence check demanded by the given -- 'ExistenceCheck'. Throws 'IOError' on violation. -checkExistence :: ExistenceCheck -> FilePath -> IO () +checkExistence :: ExistenceCheck -> String -> IO () checkExistence check path = case check of RequireNone -> return () RequirePath -> do @@ -450,7 +456,7 @@ checkExistence check path = case check of -- Uses component-wise comparison via 'splitDirectories' so that -- partial-name matches (e.g. @\/foo@ vs @\/foobar@) don't register -- as containment. -isPathUnder :: FilePath -> FilePath -> Bool +isPathUnder :: String -> String -> Bool isPathUnder dir p = splitDirectories dir `isPrefixOf` splitDirectories p -- | Resolve a filesystem path to its canonical form, similar to the @@ -467,21 +473,22 @@ isPathUnder dir p = splitDirectories dir `isPrefixOf` splitDirectories p -- In the default mode, the result for an existing directory is always -- an absolute path: -- --- >>> r <- resolvePath id "." --- >>> isAbsolute r +-- >>> r <- resolvePath id [path|.|] +-- >>> isAbsolute (Path.toString r) -- True resolvePath :: (ResolvePathOptions -> ResolvePathOptions) - -> FilePath - -> IO FilePath + -> Path + -> IO Path resolvePath modifier path = do let opts = modifier defaultConfig - checkExistence (_existenceCheck opts) path + pathStr = Path.toString path + checkExistence (_existenceCheck opts) pathStr resolved <- case _resolutionMode opts of - ResolveThenParent -> canonicalizePath path + ResolveThenParent -> canonicalizePath pathStr ParentThenResolve -> - fmap lexicalCollapse (makeAbsolute path) >>= canonicalizePath - NoSymlinkResolution -> fmap lexicalCollapse (makeAbsolute path) + fmap lexicalCollapse (makeAbsolute pathStr) >>= canonicalizePath + NoSymlinkResolution -> fmap lexicalCollapse (makeAbsolute pathStr) -- Relativization and containment logic: -- * _relativeTo chooses the target to relativize against. -- * _relativeWithin gates whether relativization fires: if @@ -493,13 +500,13 @@ resolvePath modifier path = do Just t -> Just t Nothing -> _relativeWithin opts case target of - Nothing -> return resolved + Nothing -> Path.fromString resolved Just t -> do - canonicalTarget <- canonicalizePath t + canonicalTarget <- canonicalizePath (Path.toString t) case _relativeWithin opts of - Nothing -> return (makeRelative canonicalTarget resolved) + Nothing -> Path.fromString (makeRelative canonicalTarget resolved) Just boundary -> do - canonicalBoundary <- canonicalizePath boundary + canonicalBoundary <- canonicalizePath (Path.toString boundary) if isPathUnder canonicalBoundary resolved - then return (makeRelative canonicalTarget resolved) - else return resolved + then Path.fromString (makeRelative canonicalTarget resolved) + else Path.fromString resolved diff --git a/src/Streamly/Coreutils/Stat.hs b/src/Streamly/Coreutils/Stat.hs index 83d94d6c..dacbe51d 100644 --- a/src/Streamly/Coreutils/Stat.hs +++ b/src/Streamly/Coreutils/Stat.hs @@ -23,6 +23,8 @@ module Streamly.Coreutils.Stat import System.PosixCompat.Files (FileStatus) +import Streamly.FileSystem.Path (Path) +import qualified Streamly.FileSystem.Path as Path import qualified System.PosixCompat.Files as Files newtype Stat = Stat {deRef :: Bool} @@ -33,9 +35,9 @@ defaultConfig = Stat True followLinks :: Bool -> Stat -> Stat followLinks opt cfg = cfg {deRef = opt} -stat :: (Stat -> Stat) -> FilePath -> IO FileStatus -stat f = do +stat :: (Stat -> Stat) -> Path -> IO FileStatus +stat f path = do let opt = f defaultConfig case deRef opt of - False -> Files.getSymbolicLinkStatus - True -> Files.getFileStatus + False -> Files.getSymbolicLinkStatus (Path.toString path) + True -> Files.getFileStatus (Path.toString path) diff --git a/src/Streamly/Coreutils/Which.hs b/src/Streamly/Coreutils/Which.hs index 566aa207..15985421 100644 --- a/src/Streamly/Coreutils/Which.hs +++ b/src/Streamly/Coreutils/Which.hs @@ -18,11 +18,16 @@ where import System.Directory -which :: String -> IO (Maybe FilePath) -which = findExecutable +import Streamly.FileSystem.Path (Path) +import qualified Streamly.FileSystem.Path as Path -whichAll :: String -> IO [FilePath] -whichAll = findExecutables +which :: String -> IO (Maybe Path) +which name = findExecutable name >>= traverse Path.fromString -whichAllIn :: [FilePath] -> String -> IO [FilePath] -whichAllIn dirs = findExecutablesInDirectories dirs +whichAll :: String -> IO [Path] +whichAll name = findExecutables name >>= traverse Path.fromString + +whichAllIn :: [Path] -> String -> IO [Path] +whichAllIn dirs name = + findExecutablesInDirectories (map Path.toString dirs) name + >>= traverse Path.fromString