[project @ 2005-10-20 18:07:53 by krasimir]

[haskell-directory.git] / System / Directory.hs

diff --git a/System/Directory.hs b/System/Directory.hs
index d5bbd84..21bdbf4 100644 (file)
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -250,6 +250,13 @@ createDirectory path = do
     withCString path $ \s -> do
       throwErrnoIfMinus1Retry_ "createDirectory" $
        mkdir s 0o777
+
+#else /* !__GLASGOW_HASKELL__ */
+
+copyPermissions :: FilePath -> FilePath -> IO ()
+copyPermissions fromFPath toFPath
+  = getPermissions fromFPath >>= setPermissions toFPath
+
 #endif
 
 -- | @'createDirectoryIfMissing' parents dir@ creates a new directory 
@@ -545,7 +552,7 @@ canonicalizePath fpath =
        peekCString pOutPath
 
 #if defined(mingw32_HOST_OS)
-foreign import stdcall unsafe "GetFullPathName"
+foreign import stdcall unsafe "GetFullPathNameA"
             c_GetFullPathName :: CString
                               -> CInt
                               -> CString
@@ -569,7 +576,27 @@ canonicalizePath fpath = return fpath
 -- 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 "SearchPath"
+            c_SearchPath :: CString
+                         -> CString
+                         -> CString
+                         -> CInt
+                         -> CString
+                         -> Ptr CString
+                         -> IO CInt
+#else
   path <- getEnv "PATH"
   search (parseSearchPath path)
   where
@@ -582,6 +609,8 @@ findExecutable binary = do
        b <- doesFileExist path
        if b then return (Just path)
              else search ds
+#endif
+
 
 #ifdef __GLASGOW_HASKELL__
 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
@@ -976,7 +1005,7 @@ foreign import ccall unsafe "__hscore_CSIDL_APPDATA"  csidl_APPDATA  :: CInt
 foreign import ccall unsafe "__hscore_CSIDL_WINDOWS"  csidl_WINDOWS  :: CInt
 foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt
 
-foreign import stdcall unsafe "GetTempPath" c_GetTempPath :: CInt -> CString -> IO CInt
+foreign import stdcall unsafe "GetTempPathA" c_GetTempPath :: CInt -> CString -> IO CInt
 
 raiseUnsupported loc = 
    ioException (IOError Nothing UnsupportedOperation loc "unsupported operation" Nothing)