[project @ 2005-01-11 13:29:34 by malcolm]

[ghc-base.git] / System / Directory.hs

diff --git a/System/Directory.hs b/System/Directory.hs
index b9dcbfa..b3c09e1 100644 (file)
--- 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]
@@ -66,6 +68,7 @@ module System.Directory
 import System.Environment      ( getEnv )
 import System.FilePath
 import System.IO.Error
+import Control.Monad           ( when, unless )
 
 #ifdef __NHC__
 import Directory
@@ -80,7 +83,6 @@ import Hugs.Directory
 import Prelude
 
 import Control.Exception       ( bracket )
-import Control.Monad           ( when )
 import System.Posix.Types
 import System.Posix.Internals
 import System.Time             ( ClockTime(..) )
@@ -234,10 +236,27 @@ 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
+#endif
 
+-- | @'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
+
+#if __GLASGOW_HASKELL__
 {- | @'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
@@ -284,7 +303,27 @@ removeDirectory path = do
   modifyIOError (`ioeSetFileName` path) $
     withCString path $ \s ->
        throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
+#endif
 
+-- | @'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 ()
+
+#if __GLASGOW_HASKELL__
 {- |'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
@@ -524,7 +563,7 @@ findExecutable binary = do
   path <- getEnv "PATH"
   search (parseSearchPath path)
   where
-    fileName = binary `joinFileExt` drop 1 exeExtension
+    fileName = binary `joinFileExt` exeExtension
 
     search :: [FilePath] -> IO (Maybe FilePath)
     search [] = return Nothing
@@ -881,10 +920,17 @@ environment variable or \"\/tmp\" if the variable isn\'t defined.
 On Windows, the function checks for the existence of environment variables in 
 the following order and uses the first path found:
 
-* TMP environment variable. 
-* TEMP environment variable. 
-* USERPROFILE environment variable. 
-* The Windows directory
+* 
+TMP environment variable. 
+
+*
+TEMP environment variable. 
+
+*
+USERPROFILE environment variable. 
+
+*
+The Windows directory
 
 The operation may fail with: