From 878e7471fa09dcc36b478e1ac1fd305d5a90b7bf Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 24 Feb 2014 19:40:14 -0400 Subject: merge from git-annex --- Utility/Directory.hs | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) (limited to 'Utility/Directory.hs') diff --git a/Utility/Directory.hs b/Utility/Directory.hs index 6caee7e..f1bcfad 100644 --- a/Utility/Directory.hs +++ b/Utility/Directory.hs @@ -1,6 +1,6 @@ {- directory manipulation - - - Copyright 2011 Joey Hess + - Copyright 2011-2014 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -10,7 +10,6 @@ module Utility.Directory where import System.IO.Error -import System.PosixCompat.Files import System.Directory import Control.Exception (throw) import Control.Monad @@ -19,10 +18,12 @@ import System.FilePath import Control.Applicative import System.IO.Unsafe (unsafeInterleaveIO) +import Utility.PosixFiles import Utility.SafeCommand import Utility.Tmp import Utility.Exception import Utility.Monad +import Utility.Applicative dirCruft :: FilePath -> Bool dirCruft "." = True @@ -73,6 +74,21 @@ dirContentsRecursiveSkipping skipdir followsubdirsymlinks topdir = go [topdir] ) _ -> skip +{- Gets the directory tree from a point, recursively and lazily, + - with leaf directories **first**, skipping any whose basenames + - match the skipdir. Does not follow symlinks. -} +dirTreeRecursiveSkipping :: (FilePath -> Bool) -> FilePath -> IO [FilePath] +dirTreeRecursiveSkipping skipdir topdir = go [] [topdir] + where + go c [] = return c + go c (dir:dirs) + | skipdir (takeFileName dir) = go c dirs + | otherwise = unsafeInterleaveIO $ do + subdirs <- go c + =<< filterM (isDirectory <$$> getSymbolicLinkStatus) + =<< catchDefaultIO [] (dirContents dir) + go (subdirs++[dir]) dirs + {- Moves one filename to another. - First tries a rename, but falls back to moving across devices if needed. -} moveFile :: FilePath -> FilePath -> IO () -- cgit v1.2.3