avoid untrappable exception if dirContentsRecursive is run on a directory
that doesn't exist, or cannot be read The problem is its use of unsafeInterleaveIO, which causes its IO code to run when the thunk is forced, outside any exception trapping the caller may do.
This commit is contained in:
parent
9517fbb948
commit
74f0d67aa3
1 changed files with 3 additions and 2 deletions
|
@ -35,14 +35,15 @@ dirContents :: FilePath -> IO [FilePath]
|
||||||
dirContents d = map (d </>) . filter (not . dirCruft) <$> getDirectoryContents d
|
dirContents d = map (d </>) . filter (not . dirCruft) <$> getDirectoryContents d
|
||||||
|
|
||||||
{- Gets files in a directory, and then its subdirectories, recursively,
|
{- Gets files in a directory, and then its subdirectories, recursively,
|
||||||
- and lazily. -}
|
- and lazily. If the directory does not exist, no exception is thrown,
|
||||||
|
- instead, [] is returned. -}
|
||||||
dirContentsRecursive :: FilePath -> IO [FilePath]
|
dirContentsRecursive :: FilePath -> IO [FilePath]
|
||||||
dirContentsRecursive topdir = dirContentsRecursive' topdir [""]
|
dirContentsRecursive topdir = dirContentsRecursive' topdir [""]
|
||||||
|
|
||||||
dirContentsRecursive' :: FilePath -> [FilePath] -> IO [FilePath]
|
dirContentsRecursive' :: FilePath -> [FilePath] -> IO [FilePath]
|
||||||
dirContentsRecursive' _ [] = return []
|
dirContentsRecursive' _ [] = return []
|
||||||
dirContentsRecursive' topdir (dir:dirs) = unsafeInterleaveIO $ do
|
dirContentsRecursive' topdir (dir:dirs) = unsafeInterleaveIO $ do
|
||||||
(files, dirs') <- collect [] [] =<< dirContents (topdir </> dir)
|
(files, dirs') <- collect [] [] =<< catchDefaultIO (dirContents (topdir </> dir)) []
|
||||||
files' <- dirContentsRecursive' topdir (dirs' ++ dirs)
|
files' <- dirContentsRecursive' topdir (dirs' ++ dirs)
|
||||||
return (files ++ files')
|
return (files ++ files')
|
||||||
where
|
where
|
||||||
|
|
Loading…
Reference in a new issue