path-io 1.4.1 → 1.4.2
raw patch · 5 files changed
+108/−79 lines, 5 filesdep ~pathdep ~time
Dependency ranges changed: path, time
Files
- CHANGELOG.md +5/−0
- Path/IO.hs +64/−62
- README.md +1/−1
- path-io.cabal +3/−3
- tests/Main.hs +35/−13
CHANGELOG.md view
@@ -1,3 +1,8 @@+## Path IO 1.4.2++* Fixed various bugs in `listDirRecurRel`, `walkDirRel`, and+ `walkDirAccumRel` and clarified their behavior in the docs.+ ## Path IO 1.4.1 * Fixed a bug in `walkDirRel` that resulted in `NotAProperPrefix` exception
Path/IO.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Path.IO--- Copyright : © 2016–2018 Mark Karpov+-- Copyright : © 2016–2019 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>@@ -351,37 +351,33 @@ listDirRecur :: MonadIO m => Path b Dir -- ^ Directory to list -> m ([Path Abs Dir], [Path Abs File]) -- ^ Sub-directories and files-listDirRecur = listDirRecurWith walkDirAccum+listDirRecur dir = (DList.toList *** DList.toList)+ <$> walkDirAccum (Just excludeSymlinks) writer dir+ where+ excludeSymlinks _ subdirs _ =+ WalkExclude <$> filterM isSymlink subdirs+ writer _ ds fs = return+ ( DList.fromList ds+ , DList.fromList fs+ ) --- | The same as 'listDirRecur' but returns relative paths.+-- | The same as 'listDirRecur' but returns paths that are relative to the+-- given directory. ----- @since 1.4.0+-- @since 1.4.2 listDirRecurRel :: MonadIO m => Path b Dir -- ^ Directory to list -> m ([Path Rel Dir], [Path Rel File]) -- ^ Sub-directories and files-listDirRecurRel = listDirRecurWith walkDirAccumRel---- | A non-public helper function used to define 'listDirRecur' and--- 'listDirRecurRel'.--listDirRecurWith :: MonadIO m- => ( Maybe (Path b Dir -> [Path b Dir] -> [Path b File] -> m (WalkAction b))- -> ( Path b Dir- -> [Path b Dir]- -> [Path b File]- -> m (DList.DList (Path b Dir), DList.DList (Path b File)))- -> Path b' Dir- -> m (DList.DList (Path b Dir), DList.DList (Path b File)))- -- ^ The walk function to use- -> Path b' Dir -- ^ Directory to list- -> m ([Path b Dir], [Path b File]) -- ^ Sub-directories and files-listDirRecurWith walkF dir = (DList.toList *** DList.toList)- <$> walkF (Just excludeSymlinks) writer dir+listDirRecurRel dir = (DList.toList *** DList.toList)+ <$> walkDirAccumRel (Just excludeSymlinks) writer dir where- excludeSymlinks _ subdirs _ =- WalkExclude <$> filterM isSymlink subdirs- writer _ ds fs = return (DList.fromList ds, DList.fromList fs)+ excludeSymlinks tdir subdirs _ =+ WalkExclude <$> filterM (isSymlink . (dir </>) . (tdir </>)) subdirs+ writer tdir ds fs = return+ ( DList.fromList ((tdir </>) <$> ds)+ , DList.fromList ((tdir </>) <$> fs)+ ) -- | Copies a directory recursively. It /does not/ follow symbolic links and -- preserves permissions when possible. If the destination directory already@@ -432,11 +428,7 @@ -> Path Abs t -> IO (Path Abs t) swapParent old new path = (new </>) <$>-#if MIN_VERSION_path(0,6,0) stripProperPrefix old path-#else- stripDir old path-#endif tdirs <- mapM (swapParent bsrc bdest) dirs tfiles <- mapM (swapParent bsrc bdest) files ensureDir bdest@@ -519,9 +511,6 @@ case mRes of Nothing -> return $ Just () Just traversed' -> walktree traversed' curdir-- -- use Maybe monad to abort any further traversal if any of the- -- handler calls returns WalkFinish walktree traversed curdir = do (subdirs, files) <- listDir curdir action <- handler curdir subdirs files@@ -530,49 +519,58 @@ WalkExclude xdirs -> case subdirs \\ xdirs of [] -> return $ Just ()- ds -> runMaybeT $ mapM_ (MaybeT . walkAvoidLoop traversed) ds-+ ds -> runMaybeT $ mapM_+ (MaybeT . walkAvoidLoop traversed)+ ds checkLoop traversed dir = do- st <- liftIO $ P.getFileStatus (toFilePath dir)+ st <- liftIO $ P.getFileStatus (fromAbsDir dir) let ufid = (P.deviceID st, P.fileID st)-- -- check for loop, have we already traversed this dir? return $ if S.member ufid traversed then Nothing else Just (S.insert ufid traversed) --- | The same as 'walkDir' but uses relative paths.+-- | The same as 'walkDir' but uses relative paths. The handler is given+-- @dir@, directory relative to the directory where traversal begins.+-- Sub-directories and files are relative to @dir@. ----- @since 1.4.0+-- @since 1.4.2 walkDirRel :: MonadIO m- => (Path Rel Dir -> [Path Rel Dir] -> [Path Rel File] -> m (WalkAction Rel))+ => ( Path Rel Dir+ -> [Path Rel Dir]+ -> [Path Rel File]+ -> m (WalkAction Rel)+ ) -- ^ Handler (@dir -> subdirs -> files -> 'WalkAction'@) -> Path b Dir -- ^ Directory where traversal begins -> m ()-walkDirRel handler' topdir' = do+walkDirRel handler topdir' = do topdir <- makeAbsolute topdir'- let stripTopdir :: MonadIO m => Path Abs f -> m (Path Rel f)- stripTopdir = liftIO .-#if MIN_VERSION_path(0,6,0)- stripProperPrefix topdir-#else- stripDir topdir-#endif- handler curdir subdirs files = do- curdirRel <- if curdir == topdir- then return $(mkRelDir ".")- else stripTopdir curdir- subdirsRel <- mapM stripTopdir subdirs- filesRel <- mapM stripTopdir files- action <- handler' curdirRel subdirsRel filesRel- return $ case action of- WalkFinish -> WalkFinish- WalkExclude xdirs -> WalkExclude $- (topdir </>) <$> xdirs- walkDir handler topdir+ let walkAvoidLoop traversed curdir = do+ mRes <- checkLoop traversed (topdir </> curdir)+ case mRes of+ Nothing -> return $ Just ()+ Just traversed' -> walktree traversed' curdir+ walktree traversed curdir = do+ (subdirs, files) <- listDirRel (topdir </> curdir)+ action <- handler curdir subdirs files+ case action of+ WalkFinish -> return Nothing+ WalkExclude xdirs ->+ case subdirs \\ xdirs of+ [] -> return $ Just ()+ ds -> runMaybeT $ mapM_+ (MaybeT . walkAvoidLoop traversed)+ ((curdir </>) <$> ds)+ checkLoop traversed dir = do+ st <- liftIO $ P.getFileStatus (fromAbsDir dir)+ let ufid = (P.deviceID st, P.fileID st)+ return $ if S.member ufid traversed+ then Nothing+ else Just (S.insert ufid traversed)+ void (walkAvoidLoop S.empty $(mkRelDir ".")) -- | Similar to 'walkDir' but accepts a 'Monoid'-returning output writer as -- well. Values returned by the output writer invocations are accumulated@@ -598,9 +596,11 @@ -- ^ Accumulation of outputs generated by the output writer invocations walkDirAccum = walkDirAccumWith walkDir --- | The same as 'walkDirAccum' but uses relative paths.+-- | The same as 'walkDirAccum' but uses relative paths. The handler and+-- writer are given @dir@, directory relative to the directory where+-- traversal begins. Sub-directories and files are relative to @dir@. ----- @since 1.4.0+-- @since 1.4.2 walkDirAccumRel :: (MonadIO m, Monoid o)@@ -615,6 +615,8 @@ -> m o -- ^ Accumulation of outputs generated by the output writer invocations walkDirAccumRel = walkDirAccumWith walkDirRel++-- | Non-public helper function for defining accumulating walking actions. walkDirAccumWith :: (MonadIO m, Monoid o)
README.md view
@@ -17,6 +17,6 @@ ## License -Copyright © 2016–2018 Mark Karpov+Copyright © 2016–2019 Mark Karpov Distributed under BSD 3 clause license.
path-io.cabal view
@@ -1,5 +1,5 @@ name: path-io-version: 1.4.1+version: 1.4.2 cabal-version: 1.18 tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.3 license: BSD3@@ -27,7 +27,7 @@ , dlist >= 0.8 && < 0.9 , exceptions >= 0.8 && < 0.11 , filepath >= 1.2 && < 1.5- , path >= 0.5 && < 0.7+ , path >= 0.6 && < 0.7 , temporary >= 1.1 && < 1.4 , time >= 1.4 && < 1.9 , transformers >= 0.3 && < 0.6@@ -57,7 +57,7 @@ , directory >= 1.2.2 && < 1.4 , exceptions >= 0.8 && < 0.11 , hspec >= 2.0 && < 3.0- , path >= 0.5 && < 0.7+ , path >= 0.6 && < 0.7 , path-io , transformers >= 0.3 && < 0.6 , unix-compat
tests/Main.hs view
@@ -6,12 +6,13 @@ import Control.Monad import Control.Monad.Catch import Control.Monad.IO.Class (MonadIO (..))+import Data.Bifunctor import Data.List (sort) import Path import Path.IO-import Test.Hspec import System.Environment import System.PosixCompat.Files+import Test.Hspec #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>))@@ -24,7 +25,9 @@ -- NOTE These tests shall fail on Windows as unix-compat does not -- implement createSymbolicLink for windows. describe "listDir" listDirSpec+ describe "listDirRel" listDirRelSpec describe "listDirRecur" listDirRecurSpec+ describe "listDirRecurRel" listDirRecurRelSpec describe "listDirRecurWith" listDirRecurWithSpec describe "walkDir Finish" walkDirFinishSpec describe "copyDirRecur" copyDirRecurSpec@@ -53,10 +56,18 @@ listDirSpec = it "lists directory" $ \dir -> getDirStructure listDir dir `shouldReturn` populatedDirTop +listDirRelSpec :: SpecWith (Path Abs Dir)+listDirRelSpec = it "lists directory" $ \dir ->+ getDirStructureRel listDirRel dir `shouldReturn` populatedDirTop+ listDirRecurSpec :: SpecWith (Path Abs Dir) listDirRecurSpec = it "lists directory recursively" $ \dir -> getDirStructure listDirRecur dir `shouldReturn` populatedDirStructure +listDirRecurRelSpec :: SpecWith (Path Abs Dir)+listDirRecurRelSpec = it "lists directory recursively" $ \dir ->+ getDirStructureRel listDirRecurRel dir `shouldReturn` populatedDirStructure+ listDirRecurWithSpec :: SpecWith (Path Abs Dir) listDirRecurWithSpec = it "lists directory recursively using predicates" $ \dir ->@@ -76,18 +87,6 @@ f' <- filterM filePred f return (d', f') --- Follows symbolic links-listDirRecurCyclic :: (MonadIO m, MonadThrow m)- => Path b Dir -- ^ Directory to list- -> m ([Path Abs Dir], [Path Abs File]) -- ^ Sub-directories and files-listDirRecurCyclic = walkDirAccum Nothing (\_ d f -> return (d, f))--listDirRecurCyclicSpec :: SpecWith (Path Abs Dir)-listDirRecurCyclicSpec =- it "lists directory trees having traversal cycles" $ \dir ->- getDirStructure listDirRecurCyclic dir- `shouldReturn` populatedCyclicDirStructure- -- | walkDir with a Finish handler may have unpredictable output depending on -- the order of traversal. The only guarantee is that we will finish only after -- we find the directory "c". Though if we test only for the presence of "c" we@@ -143,6 +142,18 @@ found <- findFile (dir : undefined) relFile found `shouldBe` Just (dir </> relFile) +listDirRecurCyclicSpec :: SpecWith (Path Abs Dir)+listDirRecurCyclicSpec =+ it "lists directory trees having traversal cycles" $ \dir ->+ getDirStructure listDirRecurCyclic dir+ `shouldReturn` populatedCyclicDirStructure++-- Follows symbolic links+listDirRecurCyclic :: (MonadIO m, MonadThrow m)+ => Path b Dir -- ^ Directory to list+ -> m ([Path Abs Dir], [Path Abs File]) -- ^ Sub-directories and files+listDirRecurCyclic = walkDirAccum Nothing (\_ d f -> return (d, f))+ getCurrentDirSpec :: SpecWith (Path Abs Dir) getCurrentDirSpec = it "returns current dir" $ \dir -> getCurrentDir `shouldNotReturn` dir@@ -266,6 +277,17 @@ rdirs <- sort <$> mapM (makeRelative path) dirs rfiles <- sort <$> mapM (makeRelative path) files return (rdirs, rfiles)++-- | A version of 'getDirStructure' that accepts scanning function that+-- returns relative paths.++getDirStructureRel+ :: (Path Abs Dir -> IO ([Path Rel Dir], [Path Rel File]))+ -- ^ Which function to use for scanning+ -> Path Abs Dir+ -- ^ Path to directory to scan+ -> IO ([Path Rel Dir], [Path Rel File])+getDirStructureRel f path = bimap sort sort <$> f path -- | Structure of directory created by the 'populatedDir' function. Please -- keep it sorted.