X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fcompat%2FCompat%2FDirectory.hs;fp=ghc%2Flib%2Fcompat%2FCompat%2FDirectory.hs;h=866a09fb1dfd49daab6a9eebc1e19fd19e2643f6;hb=3410e077e565c70935daa32231df938043cb518b;hp=60f372aecd380c55bcb8c547f88d6ff940a71a7f;hpb=55c604790106d8c8b4a470feefe55e19bbfe7477;p=ghc-hetmet.git

diff --git a/ghc/lib/compat/Compat/Directory.hs b/ghc/lib/compat/Compat/Directory.hs
index 60f372a..866a09f 100644
--- a/ghc/lib/compat/Compat/Directory.hs
+++ b/ghc/lib/compat/Compat/Directory.hs
@@ -17,7 +17,8 @@
 module Compat.Directory (
   	getAppUserDataDirectory,
   	copyFile,
-  	findExecutable
+  	findExecutable,
+  	createDirectoryIfMissing
   ) where
 
 #if __GLASGOW_HASKELL__ < 603
@@ -31,7 +32,7 @@ import System.FilePath
 import System.IO
 import Foreign
 import Foreign.C
-import System.Directory(doesFileExist, getPermissions, setPermissions)
+import System.Directory(doesFileExist, doesDirectoryExist, getPermissions, setPermissions, createDirectory)
 #if defined(__GLASGOW_HASKELL__)
 import GHC.IOBase ( IOException(..) )
 #endif
@@ -109,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