[project @ 2004-11-14 09:50:33 by krasimir]

* Add stub for System.FilePath
* Add findExecutable & copyFile to Compat.Directory

diff --git a/ghc/lib/compat/Compat/Directory.hs b/ghc/lib/compat/Compat/Directory.hs
index 74baec8..73b7f59 100644 (file)
--- a/ghc/lib/compat/Compat/Directory.hs
+++ b/ghc/lib/compat/Compat/Directory.hs
@@ -16,18 +16,27 @@
 
 module Compat.Directory (
        getAppUserDataDirectory,
 
 module Compat.Directory (
        getAppUserDataDirectory,

+       copyFile,
+       findExecutable

   ) where
 
 #if __GLASGOW_HASKELL__ < 603
 #include "config.h"
 #endif
 
   ) where
 
 #if __GLASGOW_HASKELL__ < 603
 #include "config.h"
 #endif
 

-#if !defined(mingw32_TARGET_OS)
+import Control.Exception       ( bracket )
+import Control.Monad           ( when )

 import System.Environment (getEnv)
 import System.Environment (getEnv)

-#else
+import System.FilePath
+import System.IO
+#if defined(mingw32_TARGET_OS)

 import Foreign
 import Foreign.C
 #endif
 import Foreign
 import Foreign.C
 #endif

+import System.Directory(doesFileExist, getPermissions, setPermissions)
+#if defined(__GLASGOW_HASKELL__)
+import GHC.IOBase ( IOException(..) )
+#endif

 
 getAppUserDataDirectory :: String -> IO FilePath
 getAppUserDataDirectory appName = do
 
 getAppUserDataDirectory :: String -> IO FilePath
 getAppUserDataDirectory appName = do

@@ -55,3 +64,49 @@ foreign import ccall unsafe "__hscore_long_path_size"
 
 foreign import ccall unsafe "__hscore_CSIDL_APPDATA"  csidl_APPDATA  :: CInt
 #endif
 
 foreign import ccall unsafe "__hscore_CSIDL_APPDATA"  csidl_APPDATA  :: CInt
 #endif

+
+
+copyFile :: FilePath -> FilePath -> IO ()
+copyFile fromFPath toFPath =
+#if (!(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 600))
+       do readFile fromFPath >>= writeFile toFPath
+          try (getPermissions fromFPath >>= setPermissions toFPath)
+          return ()
+#else
+       (bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
+        bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo ->
+        allocaBytes bufferSize $ \buffer -> do
+               copyContents hFrom hTo buffer
+               try (getPermissions fromFPath >>= setPermissions toFPath)
+               return ()) `catch` (ioError . changeFunName)
+       where
+               bufferSize = 1024
+               
+               changeFunName (IOError h iot fun str mb_fp) = IOError h iot "copyFile" str mb_fp
+               
+               copyContents hFrom hTo buffer = do
+                       count <- hGetBuf hFrom buffer bufferSize
+                       when (count > 0) $ do
+                               hPutBuf hTo buffer count
+                               copyContents hFrom hTo buffer
+#endif
+
+
+findExecutable :: String -> IO (Maybe FilePath)
+findExecutable binary = do
+  path <- getEnv "PATH"
+  search (parseSearchPath path)
+  where
+#ifdef mingw32_TARGET_OS
+    fileName = binary `joinFileExt` "exe"
+#else
+    fileName = binary
+#endif
+
+    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)
+             else search ds

diff --git a/ghc/lib/compat/Makefile b/ghc/lib/compat/Makefile
index 62d1726..94188dd 100644 (file)
--- a/ghc/lib/compat/Makefile
+++ b/ghc/lib/compat/Makefile
@@ -21,6 +21,7 @@ ifeq "$(ghc_603_plus)" "YES"
 # These modules are all provided in GHC 6.3+
 EXCLUDED_SRCS += \
        Data/Version.hs \
 # These modules are all provided in GHC 6.3+
 EXCLUDED_SRCS += \
        Data/Version.hs \

+       System/FilePath.hs \

        Distribution/Compat/Error.hs \
        Distribution/Compat/ReadP.hs \
        Distribution/Extension.hs \
        Distribution/Compat/Error.hs \
        Distribution/Compat/ReadP.hs \
        Distribution/Extension.hs \

diff --git a/ghc/lib/compat/System/FilePath.hs b/ghc/lib/compat/System/FilePath.hs
new file mode 100644 (file)
index 0000000..951a3d1
--- /dev/null
+++ b/ghc/lib/compat/System/FilePath.hs
@@ -0,0 +1,4 @@
+{-# OPTIONS -cpp #-}
+#include "base/System/FilePath.hs"
+
+-- dummy comment