[project @ 2005-01-10 23:48:07 by krasimir]
[ghc-hetmet.git] / ghc / lib / compat / Compat / Directory.hs
index 73b7f59..866a09f 100644 (file)
@@ -17,7 +17,8 @@
 module Compat.Directory (
        getAppUserDataDirectory,
        copyFile,
-       findExecutable
+       findExecutable,
+       createDirectoryIfMissing
   ) where
 
 #if __GLASGOW_HASKELL__ < 603
@@ -29,11 +30,9 @@ import Control.Monad           ( when )
 import System.Environment (getEnv)
 import System.FilePath
 import System.IO
-#if defined(mingw32_TARGET_OS)
 import Foreign
 import Foreign.C
-#endif
-import System.Directory(doesFileExist, getPermissions, setPermissions)
+import System.Directory(doesFileExist, doesDirectoryExist, getPermissions, setPermissions, createDirectory)
 #if defined(__GLASGOW_HASKELL__)
 import GHC.IOBase ( IOException(..) )
 #endif
@@ -59,7 +58,8 @@ foreign import stdcall unsafe "SHGetFolderPathA"
                               -> CString 
                               -> IO CInt
 
-foreign import ccall unsafe "__hscore_long_path_size"
+-- __compat_long_path_size defined in cbits/directory.c
+foreign import ccall unsafe "__compat_long_path_size"
   long_path_size :: Int
 
 foreign import ccall unsafe "__hscore_CSIDL_APPDATA"  csidl_APPDATA  :: CInt
@@ -110,3 +110,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