module System.Path
( mtreeList
, fileList
, walkDir
, copyDir
, replaceRoot
, removeRoot
, Directory
, dirPath
, subDirs
, files
, createDir
, filterUseless
) where
import Control.Monad (liftM, filterM, forM_, mapM_)
import System.Directory
import System.FilePath ((</>), addTrailingPathSeparator)
import Data.List ((\\))
filterUseless :: [FilePath] -> [FilePath]
filterUseless = (\\ [".", ".."])
mtreeList :: Monad m => (a -> m [a]) -> a -> m [a]
mtreeList children root = do
xs <- children root
subChildren <- mapM (mtreeList children) xs
return $ root : concat subChildren
topFileList :: FilePath -> IO [FilePath]
topFileList path =
fmap (map (path </>) . filterUseless) $ getDirectoryContents path
fileList :: FilePath -> IO [FilePath]
fileList = mtreeList children
where children path = do
directory <- doesDirectoryExist path
if directory
then topFileList path
else return []
data Directory = Directory
{
dirPath :: FilePath
, subDirs :: [FilePath]
, files :: [FilePath]
}
deriving (Show)
createDir :: FilePath -> IO Directory
createDir path = do
contents <- topFileList path
subdirs <- filterM doesDirectoryExist contents
files <- filterM doesFileExist contents
return (Directory path subdirs files)
walkDir :: FilePath -> IO [Directory]
walkDir root = createDir root >>= mtreeList children
where children path = do
let dirs = subDirs path
mapM createDir dirs
removeRoot :: FilePath -> FilePath -> FilePath
removeRoot prefix = drop . length $ addTrailingPathSeparator prefix
replaceRoot :: FilePath -> FilePath -> FilePath -> FilePath
replaceRoot root to path = to </> removeRoot root path
copyDir :: FilePath -> FilePath -> IO ()
copyDir from to = do
createDirectoryIfMissing True to
walked <- walkDir from
forM_ walked $ \(Directory _ dirs files) -> do
mapM_ (createDirectoryIfMissing True . replaceRoot from to) dirs
forM_ files $ \path -> copyFile path (replaceRoot from to path)