From e552cfc427d2734b9a9629f2ab1d22f493e775f6 Mon Sep 17 00:00:00 2001
From: Simon Marlow <simonmar@microsoft.com>
Date: Thu, 5 Jul 2007 19:46:47 +0000
Subject: [PATCH] FIX BUILD (with GHC 6.2.x): System.Directory.Internals is no
 more Update functions in Compat.Directory from originals in
 System.Directory

---
 compat/Compat/Directory.hs           |   64 ++++++++++++++++++++++++++--------
 compat/Makefile                      |    7 ----
 compat/System/Directory/Internals.hs |    4 ---
 3 files changed, 50 insertions(+), 25 deletions(-)
 delete mode 100644 compat/System/Directory/Internals.hs

diff --git a/compat/Compat/Directory.hs b/compat/Compat/Directory.hs
index e6e4cd4..fcbe6db 100644
--- a/compat/Compat/Directory.hs
+++ b/compat/Compat/Directory.hs
@@ -24,7 +24,7 @@ module Compat.Directory (
 #include "../../includes/ghcconfig.h"
 
 import System.Environment (getEnv)
-import System.Directory.Internals
+import System.FilePath
 #if __GLASGOW_HASKELL__ > 600
 import Control.Exception	( bracket )
 import Control.Monad		( when )
@@ -99,33 +99,69 @@ copyFile fromFPath toFPath =
 				copyContents hFrom hTo buffer
 #endif
 
-
+-- | Given an executable file name, searches for such file
+-- in the directories listed in system PATH. The returned value 
+-- is the path to the found executable or Nothing if there isn't
+-- such executable. For example (findExecutable \"ghc\")
+-- gives you the path to GHC.
 findExecutable :: String -> IO (Maybe FilePath)
-findExecutable binary = do
+findExecutable binary =
+#if defined(mingw32_HOST_OS)
+  withCString binary $ \c_binary ->
+  withCString ('.':exeExtension) $ \c_ext ->
+  allocaBytes long_path_size $ \pOutPath ->
+  alloca $ \ppFilePart -> do
+    res <- c_SearchPath nullPtr c_binary c_ext (fromIntegral long_path_size) pOutPath ppFilePart
+    if res > 0 && res < fromIntegral long_path_size
+      then do fpath <- peekCString pOutPath
+              return (Just fpath)
+      else return Nothing
+
+foreign import stdcall unsafe "SearchPathA"
+            c_SearchPath :: CString
+                         -> CString
+                         -> CString
+                         -> CInt
+                         -> CString
+                         -> Ptr CString
+                         -> IO CInt
+#else
+ do
   path <- getEnv "PATH"
-  search (parseSearchPath path)
+  search (splitSearchPath path)
   where
-#ifdef mingw32_HOST_OS
-    fileName = binary `joinFileExt` "exe"
-#else
-    fileName = binary
-#endif
+    fileName = binary <.> exeExtension
 
     search :: [FilePath] -> IO (Maybe FilePath)
     search [] = return Nothing
     search (d:ds) = do
-	let path = d `joinFileName` fileName
-	b <- doesFileExist path
-	if b then return (Just path)
+        let path = d </> fileName
+        b <- doesFileExist path
+        if b then return (Just path)
              else search ds
+#endif
+
+-- ToDo: This should be determined via autoconf (AC_EXEEXT)
+-- | Extension for executable files
+-- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
+exeExtension :: String
+#ifdef mingw32_HOST_OS
+exeExtension = "exe"
+#else
+exeExtension = ""
+#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 
+  case (b,parents, file) of
     (_,     _, "") -> return ()
     (True,  _,  _) -> return ()
-    (_,  True,  _) -> mapM_ (createDirectoryIfMissing False) (tail (pathParents file))
+    (_,  True,  _) -> mapM_ (createDirectoryIfMissing False) $ mkParents file
     (_, False,  _) -> createDirectory file
+ where mkParents = scanl1 (</>) . splitDirectories . normalise
diff --git a/compat/Makefile b/compat/Makefile
index 4dc05f8..31d998e 100644
--- a/compat/Makefile
+++ b/compat/Makefile
@@ -54,13 +54,6 @@ SRC_CC_OPTS += -D__GHC_PATCHLEVEL__=$(GhcPatchLevel)
 EXCLUDED_SRCS += System/FilePath/Internal.hs
 
 ifeq "$(ghc_ge_603)" "YES"
-# These modules are provided in GHC 6.3+
-EXCLUDED_SRCS += \
-	System/Directory/Internals.hs
-
-SRC_MKDEPENDHS_OPTS += \
-	-optdep--exclude-module=System.Directory.Internals
-
 # GHC 6.3+ has Cabal, but we're replacing it:
 SRC_HC_OPTS += -ignore-package Cabal
 
diff --git a/compat/System/Directory/Internals.hs b/compat/System/Directory/Internals.hs
deleted file mode 100644
index 009b08d..0000000
--- a/compat/System/Directory/Internals.hs
+++ /dev/null
@@ -1,4 +0,0 @@
-{-# OPTIONS -cpp #-}
-#include "../../includes/ghcplatform.h"
-#include "directory/System/Directory/Internals.hs"
--- dummy comment
-- 
1.7.10.4