summaryrefslogtreecommitdiff
path: root/Utility/Directory.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Utility/Directory.hs')
-rw-r--r--Utility/Directory.hs18
1 files changed, 11 insertions, 7 deletions
diff --git a/Utility/Directory.hs b/Utility/Directory.hs
index 13e6168cb..42de1e8dd 100644
--- a/Utility/Directory.hs
+++ b/Utility/Directory.hs
@@ -38,15 +38,19 @@ dirContents d = map (d </>) . filter (not . dirCruft) <$> getDirectoryContents d
- and lazily. If the directory does not exist, no exception is thrown,
- instead, [] is returned. -}
dirContentsRecursive :: FilePath -> IO [FilePath]
-dirContentsRecursive topdir = dirContentsRecursive' [topdir]
+dirContentsRecursive topdir = dirContentsRecursiveSkipping (const False) topdir
-dirContentsRecursive' :: [FilePath] -> IO [FilePath]
-dirContentsRecursive' [] = return []
-dirContentsRecursive' (dir:dirs) = unsafeInterleaveIO $ do
- (files, dirs') <- collect [] [] =<< catchDefaultIO [] (dirContents dir)
- files' <- dirContentsRecursive' (dirs' ++ dirs)
- return (files ++ files')
+dirContentsRecursiveSkipping :: (FilePath -> Bool) -> FilePath -> IO [FilePath]
+dirContentsRecursiveSkipping skipdir topdir = go [topdir]
where
+ go [] = return []
+ go (dir:dirs)
+ | skipdir dir = go dirs
+ | otherwise = unsafeInterleaveIO $ do
+ (files, dirs') <- collect [] []
+ =<< catchDefaultIO [] (dirContents dir)
+ files' <- go (dirs' ++ dirs)
+ return (files ++ files')
collect files dirs' [] = return (reverse files, reverse dirs')
collect files dirs' (entry:entries)
| dirCruft entry = collect files dirs' entries