From 9206bdbdf5bbc71ff6dd2c00314902dda1e48c14 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 5 Oct 2013 15:36:09 -0400 Subject: add dirContentsRecursiveSkipping --- Utility/Directory.hs | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) (limited to 'Utility/Directory.hs') 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 -- cgit v1.2.3