posix-paths 0.2.1.6 → 0.3.0.1
raw patch · 3 files changed
Files
- doctests.hs +6/−3
- posix-paths.cabal +9/−5
- src/System/Posix/Directory/Traversals.hs +80/−48
doctests.hs view
@@ -8,17 +8,20 @@ import Test.DocTest import Test.HUnit +main :: IO () main = do doctest [ "-isrc" , "-XOverloadedStrings" , "src/System/Posix/FilePath" ]- runTestTT unitTests+ _ <- runTestTT unitTests+ pure () unitTests :: Test unitTests = test [ TestCase $ do- r <- (==) <$> allDirectoryContents "." <*> allDirectoryContents' "."- assertBool "allDirectoryContents == allDirectoryContents'" r+ a <- allDirectoryContents "."+ b <- allDirectoryContents' "."+ assertEqual "allDirectoryContents == allDirectoryContents'" a b ]
posix-paths.cabal view
@@ -1,5 +1,5 @@ name: posix-paths-version: 0.2.1.6+version: 0.3.0.1 license: BSD3 license-file: LICENSE maintainer: jwlato@gmail.com@@ -16,7 +16,7 @@ benchmarks/*.hs extra-tmp-files: build-type: Simple-Cabal-Version: >= 1.14+Cabal-Version: 1.14 Library hs-source-dirs: src@@ -27,7 +27,11 @@ System.Posix.FilePath build-depends: base >= 4.2 && < 5, bytestring >= 0.9.2.0,- unix >= 2.5.1.0+ -- System.Posix.Directory.Internals (exposing the+ -- DirStream constructor and CDir/CDirent types) was+ -- introduced in unix-2.8.0.0 (August 2022).+ unix >= 2.8.0.0,+ unliftio >= 0.2 test-suite doctests default-language: Haskell2010@@ -57,8 +61,8 @@ filepath >= 1.2, process >= 1.0, criterion >= 0.6- ghc-options: -Wall -O2+ ghc-options: -Wall source-repository head type: git- location: git://github.com/JohnLato/posix-paths.git+ location: https://github.com/JohnLato/posix-paths.git
src/System/Posix/Directory/Traversals.hs view
@@ -7,6 +7,7 @@ module System.Posix.Directory.Traversals ( getDirectoryContents+, traverseDirectoryContents , allDirectoryContents , allDirectoryContents'@@ -22,25 +23,27 @@ import Control.Applicative import Control.Monad+import Control.Monad.IO.Class (liftIO) import System.Posix.FilePath ((</>)) import System.Posix.Directory.Foreign import qualified System.Posix as Posix import System.IO.Error-import Control.Exception import qualified Data.ByteString.Char8 as BS import System.Posix.ByteString.FilePath import System.Posix.Directory.ByteString as PosixBS import System.Posix.Files.ByteString+import UnliftIO (MonadUnliftIO, withRunInIO)+import UnliftIO.Exception import System.IO.Unsafe-import Unsafe.Coerce (unsafeCoerce) import Foreign.C.Error import Foreign.C.String import Foreign.C.Types import Foreign.Marshal.Alloc (alloca,allocaBytes) import Foreign.Ptr import Foreign.Storable+import System.Posix.Directory.Internals (DirStream(DirStream),CDir ,CDirent) ---------------------------------------------------------- @@ -71,20 +74,25 @@ -- this uses traverseDirectory because it's more efficient than forcing the -- lazy version. --- | Recursively apply the 'action' to the parent directory and all+-- | Recursively apply the 'action' to the parent file or directory and all -- files/subdirectories. --+-- Like UNIX @find@, this includes the parent file/directory!+--+-- As for @find@, emitted file paths of subdirectories contain slashes,+-- starting with the parent directory.+-- -- This function allows for memory-efficient traversals.-traverseDirectory :: (s -> RawFilePath -> IO s) -> s -> RawFilePath -> IO s-traverseDirectory act s0 topdir = toploop+traverseDirectory :: (MonadUnliftIO m) => (s -> RawFilePath -> m s) -> s -> RawFilePath -> m s+traverseDirectory act s0 topDirOrFile = toploop where toploop = do- isDir <- isDirectory <$> getFileStatus topdir- s' <- act s0 topdir- if isDir then actOnDirContents topdir s' loop+ isDir <- liftIO $ isDirectory <$> getFileStatus topDirOrFile+ s' <- act s0 topDirOrFile+ if isDir then actOnDirContents topDirOrFile s' loop else return s' loop typ path acc = do- isDir <- case () of+ isDir <- liftIO $ case () of () | typ == dtDir -> return True | typ == dtUnknown -> isDirectory <$> getFileStatus path | otherwise -> return False@@ -92,46 +100,43 @@ then act acc path >>= \acc' -> actOnDirContents path acc' loop else act acc path -actOnDirContents :: RawFilePath+actOnDirContents :: (MonadUnliftIO m)+ => RawFilePath -> b- -> (DirType -> RawFilePath -> b -> IO b)- -> IO b+ -> (DirType -> RawFilePath -> b -> m b)+ -> m b actOnDirContents pathRelToTop b f =- modifyIOError ((`ioeSetFileName` (BS.unpack pathRelToTop)) .- (`ioeSetLocation` "findBSTypRel")) $ do- bracket- (openDirStream pathRelToTop)- (Posix.closeDirStream)- (\dirp -> loop dirp b)- where- loop dirp b' = do- (typ,e) <- readDirEnt dirp- if (e == "")- then return b'- else do- if (e == "." || e == "..")- then loop dirp b'- else f typ (pathRelToTop </> e) b' >>= loop dirp+ traverseDirectoryContents+ (\b' (typ, e) -> f typ (pathRelToTop </> e) b')+ b+ pathRelToTop +-- | `withRunInIO` lifted to `MonadUnliftIO`.+modifyIOErrorUnliftIO :: (MonadUnliftIO m) => (IOError -> IOError) -> m a -> m a+modifyIOErrorUnliftIO f action =+ withRunInIO $ \runInIO -> do+ modifyIOError f (runInIO action) ------------------------------------------------------------- dodgy stuff -type CDir = ()-type CDirent = () --- Posix doesn't export DirStream, so to re-use that type we need to use--- unsafeCoerce. It's just a newtype, so this is a legitimate usage.--- ugly trick.+-- unpacks the DirStream unpackDirStream :: DirStream -> Ptr CDir-unpackDirStream = unsafeCoerce+unpackDirStream (DirStream p) = p + packDirStream :: Ptr CDir -> DirStream-packDirStream = unsafeCoerce+packDirStream = DirStream -- the __hscore_* functions are defined in the unix package. We can import them and let -- the linker figure it out.-foreign import ccall unsafe "__hscore_readdir"+--+-- In contrast to current `unix` we use `safe` calls for anything that+-- does file system IO, because it can take a substantial amount of time+-- on spinning disks or networked file systems, and `unsafe` calls block+-- a capability.+-- See https://github.com/haskell/unix/issues/34.+foreign import ccall safe "__hscore_readdir" c_readdir :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt foreign import ccall unsafe "__hscore_free_dirent"@@ -176,20 +181,47 @@ then return (dtUnknown,BS.empty) else throwErrno "readDirEnt" +-- | Apply the 'action' to the given directory (must be a directory),+-- without recursing into subdirectories.+--+-- This function does filter out the @.@ and @..@ entries.+--+-- Emitted file paths are the directory entry names,+-- thus not prefixed with the given parent directory.+--+-- This function allows for memory-efficient traversals.+--+-- Use this if you want to implement your own recursive subdirectory+-- traversal, deciding e.g. into which directories or symlinks to traverse.+--+-- You SHOULD check if the obtained 'DirType'+-- is 'System.Posix.Directory.Foreign.dtUnknown'+-- (see comments in @man 3 readdir@ on @d_type@),+-- and do a 'System.Posix.Files.ByteString.getFileStatus'+-- in that case (results in @stat()@), as not all file systems+-- implement obtaining a 'DirType'.+traverseDirectoryContents :: (MonadUnliftIO m) => (s -> (DirType, RawFilePath) -> m s) -> s -> RawFilePath -> m s+traverseDirectoryContents act state path =+ modifyIOErrorUnliftIO+ ((`ioeSetFileName` (BS.unpack path)) .+ (`ioeSetLocation` "System.Posix.Directory.Traversals.traverseDirectoryContents")) $ do+ bracket+ (liftIO $ PosixBS.openDirStream path)+ (liftIO . PosixBS.closeDirStream)+ (\dirp -> loop state dirp)+ where+ loop state0 dirp = do+ t@(_typ,e) <- liftIO $ readDirEnt dirp+ if BS.null e then return state0 else do+ if (e == "." || e == "..")+ then loop state0 dirp+ else do+ state1 <- act state0 t+ loop state1 dirp+ getDirectoryContents :: RawFilePath -> IO [(DirType, RawFilePath)] getDirectoryContents path =- modifyIOError ((`ioeSetFileName` (BS.unpack path)) .- (`ioeSetLocation` "System.Posix.Directory.Traversals.getDirectoryContents")) $ do- bracket- (PosixBS.openDirStream path)- PosixBS.closeDirStream- loop- where- loop dirp = do- t@(_typ,e) <- readDirEnt dirp- if BS.null e then return [] else do- es <- loop dirp- return (t:es)+ fmap reverse $ traverseDirectoryContents (\l e -> pure (e:l)) [] path -- | return the canonicalized absolute pathname --