diff options
Diffstat (limited to 'Utility')
| -rw-r--r-- | Utility/Directory.hs | 29 |
1 files changed, 28 insertions, 1 deletions
diff --git a/Utility/Directory.hs b/Utility/Directory.hs index 78bb6e701..b8ed63a36 100644 --- a/Utility/Directory.hs +++ b/Utility/Directory.hs @@ -34,7 +34,7 @@ dirCruft _ = False dirContents :: FilePath -> IO [FilePath] dirContents d = map (d </>) . filter (not . dirCruft) <$> getDirectoryContents d -{- Gets contents of directory, and then its subdirectories, recursively, +{- Gets files in a directory, and then its subdirectories, recursively, - and lazily. -} dirContentsRecursive :: FilePath -> IO [FilePath] dirContentsRecursive topdir = dirContentsRecursive' topdir [""] @@ -56,6 +56,33 @@ dirContentsRecursive' topdir (dir:dirs) = unsafeInterleaveIO $ do , collect (dirEntry:files) dirs' entries ) +{- Gets the subdirectories in a directory, and their subdirectories, + - recursively, and lazily. Prunes sections of the tree matching a + - condition. -} +dirTree :: FilePath -> (FilePath -> Bool) -> IO [FilePath] +dirTree topdir prune + | prune topdir = return [] + | otherwise = (:) topdir <$> dirTree' topdir prune [""] + +dirTree' :: FilePath -> (FilePath -> Bool) -> [FilePath] -> IO [FilePath] +dirTree' _ _ [] = return [] +dirTree' topdir prune (dir:dirs) + | prune dir = dirTree' topdir prune dirs + | otherwise = unsafeInterleaveIO $ do + subdirs <- collect [] =<< dirContents (topdir </> dir) + subdirs' <- dirTree' topdir prune (subdirs ++ dirs) + return $ subdirs ++ subdirs' + where + collect dirs' [] = return dirs' + collect dirs' (entry:entries) + | dirCruft entry || prune entry = collect dirs' entries + | otherwise = do + let dirEntry = dir </> entry + ifM (doesDirectoryExist $ topdir </> dirEntry) + ( collect (dirEntry:dirs') entries + , collect dirs' entries + ) + {- Moves one filename to another. - First tries a rename, but falls back to moving across devices if needed. -} moveFile :: FilePath -> FilePath -> IO () |