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.

1 files changed, 3 insertions, 2 deletions

diff --git a/Utility/Directory.hs b/Utility/Directory.hs
index 2f2960a9d..057da6087 100644
--- a/Utility/Directory.hs
+++ b/Utility/Directory.hs
@@ -35,14 +35,15 @@ dirContents :: FilePath -> IO [FilePath]
 dirContents d = map (d </>) . filter (not . dirCruft) <$> getDirectoryContents d
 
 {- 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 topdir = dirContentsRecursive' topdir [""]
 
 dirContentsRecursive' :: FilePath -> [FilePath] -> IO [FilePath]
 dirContentsRecursive' _ [] = return []
 dirContentsRecursive' topdir (dir:dirs) = unsafeInterleaveIO $ do
-	(files, dirs') <- collect [] [] =<< dirContents (topdir </> dir)
+	(files, dirs') <- collect [] [] =<< catchDefaultIO (dirContents (topdir </> dir)) []
 	files' <- dirContentsRecursive' topdir (dirs' ++ dirs)
 	return (files ++ files')
 	where