diff options
author | Joey Hess <joey@kitenet.net> | 2012-11-26 16:45:55 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-11-26 16:45:55 -0400 |
commit | 88afe8500eff4a1576846621d3a4d3a37f508557 (patch) | |
tree | 68f2e328ad6860affa94494ebf43d64bf4e4d179 /Utility | |
parent | 7bf9da7bcaaa51009dc359be91449e1f43d6f3bd (diff) |
Fix dirContentsRecursive, which had missed some files in deeply nested subdirectories. Could affect various parts of git-annex.
Diffstat (limited to 'Utility')
-rw-r--r-- | Utility/Directory.hs | 19 |
1 files changed, 9 insertions, 10 deletions
diff --git a/Utility/Directory.hs b/Utility/Directory.hs index 16114ffdb..5ca39b8b5 100644 --- a/Utility/Directory.hs +++ b/Utility/Directory.hs @@ -36,23 +36,22 @@ 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 = dirContentsRecursive' [topdir] -dirContentsRecursive' :: FilePath -> [FilePath] -> IO [FilePath] -dirContentsRecursive' _ [] = return [] -dirContentsRecursive' topdir (dir:dirs) = unsafeInterleaveIO $ do - (files, dirs') <- collect [] [] =<< catchDefaultIO [] (dirContents (topdir </> dir)) - files' <- dirContentsRecursive' topdir (dirs' ++ dirs) +dirContentsRecursive' :: [FilePath] -> IO [FilePath] +dirContentsRecursive' [] = return [] +dirContentsRecursive' (dir:dirs) = unsafeInterleaveIO $ do + (files, dirs') <- collect [] [] =<< catchDefaultIO [] (dirContents dir) + files' <- dirContentsRecursive' (dirs' ++ dirs) return (files ++ files') where collect files dirs' [] = return (reverse files, reverse dirs') collect files dirs' (entry:entries) | dirCruft entry = collect files dirs' entries | otherwise = do - let dirEntry = dir </> entry - ifM (doesDirectoryExist $ topdir </> dirEntry) - ( collect files (dirEntry:dirs') entries - , collect (dirEntry:files) dirs' entries + ifM (doesDirectoryExist entry) + ( collect files (entry:dirs') entries + , collect (entry:files) dirs' entries ) {- Moves one filename to another. |