From 74f0d67aa3988a71f3a53b88de4344272d924b95 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 2 Jul 2012 10:56:26 -0400 Subject: 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. --- Utility/Directory.hs | 5 +++-- 1 file 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 -- cgit v1.2.3