From: krasimir <unknown>
Date: Mon, 10 Jan 2005 23:25:04 +0000 (+0000)
Subject: [project @ 2005-01-10 23:25:04 by krasimir]
X-Git-Tag: nhc98-1-18-release~132
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=402f15d3c991951972e6d21ded2d97418326e48f;p=haskell-directory.git

[project @ 2005-01-10 23:25:04 by krasimir]
move createIfNotExists and removeFileRecursive functions from
Distribution.Simple.Utils to System.Directory. The functions are renamed
to createDirectoryIfMissing and removeDirectoryRecursive.
---

diff --git a/System/Directory.hs b/System/Directory.hs
index 6c35122..53417d6 100644
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -18,7 +18,9 @@ module System.Directory
 
     -- * Actions on directories
       createDirectory		-- :: FilePath -> IO ()
+    , createDirectoryIfMissing  -- :: Bool -> FilePath -> IO ()
     , removeDirectory		-- :: FilePath -> IO ()
+    , removeDirectoryRecursive  -- :: FilePath -> IO ()
     , renameDirectory		-- :: FilePath -> FilePath -> IO ()
 
     , getDirectoryContents      -- :: FilePath -> IO [FilePath]
@@ -80,7 +82,7 @@ import Hugs.Directory
 import Prelude
 
 import Control.Exception       ( bracket )
-import Control.Monad           ( when )
+import Control.Monad           ( when, unless )
 import System.Posix.Types
 import System.Posix.Internals
 import System.Time             ( ClockTime(..) )
@@ -234,10 +236,25 @@ The path refers to an existing non-directory object.
 
 createDirectory :: FilePath -> IO ()
 createDirectory path = do
+  modifyIOError (`ioeSetFileName` path) $
     withCString path $ \s -> do
       throwErrnoIfMinus1Retry_ "createDirectory" $
 	mkdir s 0o777
 
+-- | @'createDirectoryIfMissing' parents dir@ creates a new directory 
+-- @dir@ if it doesn\'t exist. If the first argument is 'True'
+-- the function will also create all parent directories if they are missing.
+createDirectoryIfMissing :: Bool     -- ^ Create its parents too?
+		         -> FilePath -- ^ The path to the directory you want to make
+		         -> IO ()
+createDirectoryIfMissing parents file = do
+  b <- doesDirectoryExist file
+  case (b,parents, file) of 
+    (_,     _, "") -> return ()
+    (True,  _,  _) -> return ()
+    (_,  True,  _) -> mapM_ (createDirectoryIfMissing False) (tail (pathParents file))
+    (_, False,  _) -> createDirectory file
+
 {- | @'removeDirectory' dir@ removes an existing directory /dir/.  The
 implementation may specify additional constraints which must be
 satisfied before a directory can be removed (e.g. the directory has to
@@ -285,6 +302,24 @@ removeDirectory path = do
     withCString path $ \s ->
        throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
 
+-- | @'removeDirectoryRecursive' dir@  removes an existing directory /dir/
+-- together with its content and all subdirectories. Be careful, 
+-- if the directory contains symlinks, the function will follow them.
+removeDirectoryRecursive :: FilePath -> IO ()
+removeDirectoryRecursive startLoc = do
+  cont <- getDirectoryContents startLoc
+  sequence_ [rm (startLoc `joinFileName` x) | x <- cont, x /= "." && x /= ".."]
+  removeDirectory startLoc
+  where
+    rm :: FilePath -> IO ()
+    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
+                              removeDirectoryRecursive f
+                Right _ -> return ()
+
 {- |'removeFile' /file/ removes the directory entry for an existing file
 /file/, where /file/ is not itself a directory. The
 implementation may specify additional constraints which must be