add dirContentsRecursiveSkipping
This commit is contained in:
parent
6657aa8061
commit
370dfd141b
1 changed files with 11 additions and 7 deletions
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue