Here's some stuff that I have in the cabal Utils module that might be
useful in System.FilePath or System.Directory...
What would folks think of adding them? I find createIfNotExists to be
especially useful, though maybe it should be createDirectoryAndParents
or something.
peace,
isaac
------------------------------------------------------------
module PathStuff (createIfNotExists, currentDir, removeFileRecursive) where
import Control.Monad (unless, liftM, mapM)
import Data.Maybe (Maybe, catMaybes)
import System.IO.Error (try)
import System.FilePath (pathParents)
import System.Directory (getDirectoryContents, removeDirectory,
setCurrentDirectory, getCurrentDirectory,
doesDirectoryExist, removeFile,
createDirectory)
createIfNotExists :: Bool -- ^Create its parents too?
-> FilePath -- ^The path to the directory you want to make
-> IO ()
createIfNotExists parents file
= do b <- doesDirectoryExist file
case (b,parents, file) of
(_, _, "") -> return ()
(True, _, _) -> return ()
(_, True, _) -> createDirectoryParents file
(_, False, _) -> createDirectory file
-- |like mkdir -p. Create this directory and its parents
createDirectoryParents :: FilePath -> IO()
createDirectoryParents file
= mapM_ (createIfNotExists False) (tail (pathParents file))
-- |The path name that represents the current directory. May be
-- system-specific. In Unix, it's "." FIX: What about other arches?
currentDir :: FilePath
currentDir = "."
-- |Probably follows symlinks, be careful.
removeFileRecursive :: FilePath -> IO ()
removeFileRecursive startLoc
= do cont' <- getDirectoryContents startLoc
let cont = filter (\x -> x /= "." && x /= "..") cont'
curDir <- getCurrentDirectory
setCurrentDirectory startLoc
dirs <- removeFiles cont
mapM removeFileRecursive dirs
setCurrentDirectory curDir
removeDirectory startLoc
-- |Remove a list of files; if it encounters a directory, it doesn't
-- remove it, but returns it. Throws everything that removeFile
-- throws unless the file is a directory.
removeFiles :: [FilePath] -- ^Files and directories to remove
-> IO [FilePath]
{- ^The ones we were unable to remove because they were of
an inappropriate type (directory) removeFiles -}
removeFiles files = liftM catMaybes (mapM rm' files)
where
rm' :: FilePath -> IO (Maybe FilePath)
rm' f = do temp <- try (removeFile f)
case temp of
Left e -> do isDir <- doesDirectoryExist f
-- If f is not a directory, re-throw the error
unless isDir $ ioError e
return (Just f)
Right _ -> return Nothing
