[project @ 2005-01-27 18:38:21 by panne]

[ghc-hetmet.git] / ghc / lib / compat / Compat / Directory.hs

diff --git a/ghc/lib/compat/Compat/Directory.hs b/ghc/lib/compat/Compat/Directory.hs
index 60f372a..a1e540a 100644 (file)
--- a/ghc/lib/compat/Compat/Directory.hs
+++ b/ghc/lib/compat/Compat/Directory.hs
@@ -17,24 +17,31 @@
 module Compat.Directory (
        getAppUserDataDirectory,
        copyFile,
-       findExecutable
+       findExecutable,
+       createDirectoryIfMissing
   ) where
 
 #if __GLASGOW_HASKELL__ < 603
 #include "config.h"
 #endif
 
-import Control.Exception       ( bracket )
-import Control.Monad           ( when )
 import System.Environment (getEnv)
-import System.FilePath
-import System.IO
-import Foreign
-import Foreign.C
-import System.Directory(doesFileExist, getPermissions, setPermissions)
-#if defined(__GLASGOW_HASKELL__)
+import System.Directory.Internals
+#if __GLASGOW_HASKELL__ > 600
+import Control.Exception       ( bracket )
+import Control.Monad           ( when )
+import Foreign.Marshal.Alloc   ( allocaBytes )
+import System.IO (IOMode(..), openBinaryFile, hGetBuf, hPutBuf, hClose)
+import System.IO.Error         ( try )
 import GHC.IOBase ( IOException(..) )
+#else
+import System.IO               ( try )
+#endif
+#if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS)
+import Foreign.Ptr
+import Foreign.C
 #endif
+import System.Directory(doesFileExist, doesDirectoryExist, getPermissions, setPermissions, createDirectory)
 
 getAppUserDataDirectory :: String -> IO FilePath
 getAppUserDataDirectory appName = do
@@ -109,3 +116,14 @@ findExecutable binary = do
        b <- doesFileExist path
        if b then return (Just path)
              else search ds
+
+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