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,
|
- and lazily. If the directory does not exist, no exception is thrown,
|
||||||
- instead, [] is returned. -}
|
- instead, [] is returned. -}
|
||||||
dirContentsRecursive :: FilePath -> IO [FilePath]
|
dirContentsRecursive :: FilePath -> IO [FilePath]
|
||||||
dirContentsRecursive topdir = dirContentsRecursive' [topdir]
|
dirContentsRecursive topdir = dirContentsRecursiveSkipping (const False) topdir
|
||||||
|
|
||||||
dirContentsRecursive' :: [FilePath] -> IO [FilePath]
|
dirContentsRecursiveSkipping :: (FilePath -> Bool) -> FilePath -> IO [FilePath]
|
||||||
dirContentsRecursive' [] = return []
|
dirContentsRecursiveSkipping skipdir topdir = go [topdir]
|
||||||
dirContentsRecursive' (dir:dirs) = unsafeInterleaveIO $ do
|
|
||||||
(files, dirs') <- collect [] [] =<< catchDefaultIO [] (dirContents dir)
|
|
||||||
files' <- dirContentsRecursive' (dirs' ++ dirs)
|
|
||||||
return (files ++ files')
|
|
||||||
where
|
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' [] = return (reverse files, reverse dirs')
|
||||||
collect files dirs' (entry:entries)
|
collect files dirs' (entry:entries)
|
||||||
| dirCruft entry = collect files dirs' entries
|
| dirCruft entry = collect files dirs' entries
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue