From 3410e077e565c70935daa32231df938043cb518b Mon Sep 17 00:00:00 2001
From: krasimir <unknown>
Date: Mon, 10 Jan 2005 23:48:07 +0000
Subject: [PATCH] [project @ 2005-01-10 23:48:07 by krasimir]
 createDirectoryIfMissing is added to Compat.Directory and
 is used in ghc-pkg. The mingw32_HOST_OS is replaced with
 mingw32_TARGET_OS. I don't know why but prior the last
 commit the tool was working with mingw32_HOST_OS fine but
 not it isn't. Maybe I miss something. Simon, could you
 check whether the patch is fine?

---
 ghc/lib/compat/Compat/Directory.hs |   16 ++++++++++++++--
 ghc/utils/ghc-pkg/Main.hs          |   27 +++++++--------------------
 2 files changed, 21 insertions(+), 22 deletions(-)

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
diff --git a/ghc/utils/ghc-pkg/Main.hs b/ghc/utils/ghc-pkg/Main.hs
index 0bc8d44..b455d68 100644
--- a/ghc/utils/ghc-pkg/Main.hs
+++ b/ghc/utils/ghc-pkg/Main.hs
@@ -22,11 +22,11 @@ import Distribution.Compat.ReadP
 import Distribution.ParseUtils	( showError )
 import Distribution.Package
 import Distribution.Version
-import Compat.Directory 	( getAppUserDataDirectory )
+import Compat.Directory 	( getAppUserDataDirectory, createDirectoryIfMissing )
 import Compat.RawSystem 	( rawSystem )
 import Control.Exception	( evaluate )
 import qualified Control.Exception as Exception
-import System.FilePath		( joinFileName, splitFileName )
+import System.FilePath		( joinFileName )
 
 import Prelude
 
@@ -53,7 +53,7 @@ import System	( getArgs, getProgName,
 import System.IO
 import Data.List ( isPrefixOf, isSuffixOf, intersperse )
 
-#ifdef mingw32_HOST_OS
+#ifdef mingw32_TARGET_OS
 import Foreign
 
 #if __GLASGOW_HASKELL__ >= 504
@@ -261,11 +261,12 @@ getPkgDatabases flags = do
 
   let
 	subdir = targetARCH ++ '-':targetOS ++ '-':version
-	user_conf = appdir `joinFileName` subdir `joinFileName` "package.conf"
+	archdir   = appdir `joinFileName` subdir
+	user_conf = archdir `joinFileName` "package.conf"
   b <- doesFileExist user_conf
   when (not b) $ do
 	putStrLn ("Creating user package database in " ++ user_conf)
-	createParents user_conf
+	createDirectoryIfMissing True archdir
 	writeFile user_conf emptyPackageConfig
 
   let
@@ -895,21 +896,10 @@ dieOrForce force s
   | otherwise = die s
 
 
------------------------------------------------------------------------------
--- Create a hierarchy of directories
-
-createParents :: FilePath -> IO ()
-createParents dir = do
-  let parent = directoryOf dir
-  b <- doesDirectoryExist parent
-  when (not b) $ do
-	createParents parent
-	createDirectory parent
-
 -----------------------------------------
 --	Cut and pasted from ghc/compiler/SysTools
 
-#if defined(mingw32_HOST_OS)
+#if defined(mingw32_TARGET_OS)
 subst a b ls = map (\ x -> if x == a then b else x) ls
 unDosifyPath xs = subst '\\' '/' xs
 
@@ -934,6 +924,3 @@ foreign import stdcall unsafe  "GetModuleFileNameA"
 getExecDir :: String -> IO (Maybe String) 
 getExecDir _ = return Nothing
 #endif
-
-directoryOf :: FilePath -> FilePath
-directoryOf = fst.splitFileName
-- 
1.7.10.4