add dirContentsRecursiveSkipping

This commit is contained in:
Joey Hess 2013-10-05 15:36:09 -04:00
parent 6657aa8061
commit 370dfd141b

View file

@ -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