FIX #3086: use System.Win32.getTemporaryDirectory

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

diff --git a/System/Directory.hs b/System/Directory.hs
index d80950b..1f38b14 100644 (file)
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -81,7 +81,9 @@ import Control.Monad           ( when, unless )
 import Control.Exception.Base
 
 #ifdef __NHC__
-import Directory
+import Directory hiding ( getDirectoryContents
+                        , doesDirectoryExist, doesFileExist
+                        , getModificationTime )
 import System (system)
 #endif /* __NHC__ */
 
@@ -94,11 +96,11 @@ import Foreign.C
 
 {-# CFILES cbits/directory.c #-}
 
-#ifdef __GLASGOW_HASKELL__
 import System.Posix.Types
 import System.Posix.Internals
 import System.Time             ( ClockTime(..) )
 
+#ifdef __GLASGOW_HASKELL__
 import GHC.IOBase      ( IOException(..), IOErrorType(..), ioException )
 
 #ifdef mingw32_HOST_OS
@@ -329,11 +331,15 @@ createDirectoryIfMissing create_parents path0
           -- between a dir already existing and a file already existing. So we
           -- check for it here. Unfortunately there is a slight race condition
           -- here, but we think it is benign. It could report an exeption in
-          -- the case that the dir did exist but another process deletes it
-          -- before we can check that it did indeed exist.
-          | isAlreadyExistsError e -> do exists <- doesDirectoryExist dir
-                                         if exists then return ()
-                                                   else throw e
+          -- the case that the dir did exist but another process deletes the
+          -- directory and creates a file in its place before we can check
+          -- that the directory did indeed exist.
+          | isAlreadyExistsError e ->
+              (withFileStatus "createDirectoryIfMissing" dir $ \st -> do
+                 isDir <- isDirectory st
+                 if isDir then return ()
+                          else throw e
+              ) `catch` ((\_ -> return ()) :: IOException -> IO ())
           | otherwise              -> throw e
 
 #if __GLASGOW_HASKELL__
@@ -698,7 +704,7 @@ foreign import stdcall unsafe "SearchPathA"
 #endif
 
 
-#ifdef __GLASGOW_HASKELL__
+#ifndef __HUGS__
 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
 in /dir/. 
 
@@ -758,11 +764,11 @@ getDirectoryContents path = do
                    return (entry:entries)
         else do errno <- getErrno
                 if (errno == eINTR) then loop ptr_dEnt dir else do
-                let (Errno eo) = errno
-                if (eo == end_of_dir)
-                   then return []
-                   else throwErrno desc
-
+                  let (Errno eo) = errno
+                  if (eo == end_of_dir)
+                     then return []
+                     else throwErrno desc
+#endif /* !__HUGS__ */
 
 
 {- |If the operating system has a notion of current directories,
@@ -790,34 +796,15 @@ Insufficient resources are available to perform the operation.
 The operating system has no notion of current directory.
 
 -}
-
+#ifdef __GLASGOW_HASKELL__
 getCurrentDirectory :: IO FilePath
 getCurrentDirectory = do
 #ifdef mingw32_HOST_OS
-  -- XXX: should use something from Win32
-  p <- mallocBytes long_path_size
-  go p long_path_size
-  where go p bytes = do
-         p' <- c_getcwd p (fromIntegral bytes)
-         if p' /= nullPtr 
-            then do s <- peekCString p'
-                    free p'
-                    return s
-            else do errno <- getErrno
-                    if errno == eRANGE
-                       then do let bytes' = bytes * 2
-                               p'' <- reallocBytes p bytes'
-                               go p'' bytes'
-                       else throwErrno "getCurrentDirectory"
+  System.Win32.getCurrentDirectory
 #else
   System.Posix.getWorkingDirectory
 #endif
 
-#ifdef mingw32_HOST_OS
-foreign import ccall unsafe "getcwd"
-   c_getcwd   :: Ptr CChar -> CSize -> IO (Ptr CChar)
-#endif
-
 {- |If the operating system has a notion of current directories,
 @'setCurrentDirectory' dir@ changes the current
 directory of the calling process to /dir/.
@@ -858,6 +845,9 @@ setCurrentDirectory path =
   System.Posix.changeWorkingDirectory path
 #endif
 
+#endif /* __GLASGOW_HASKELL__ */
+
+#ifndef __HUGS__
 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
 exists and is a directory, and 'False' otherwise.
 -}
@@ -893,6 +883,8 @@ getModificationTime name =
  withFileStatus "getModificationTime" name $ \ st ->
  modificationTime st
 
+#endif /* !__HUGS__ */
+
 withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 withFileStatus loc name f = do
   modifyIOError (`ioeSetFileName` name) $
@@ -935,13 +927,13 @@ foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode
 foreign import ccall unsafe "__hscore_S_IFDIR" s_IFDIR :: CMode
 #endif
 
+
+#ifdef __GLASGOW_HASKELL__
 foreign import ccall unsafe "__hscore_long_path_size"
   long_path_size :: Int
-
 #else
 long_path_size :: Int
 long_path_size = 2048  --  // guess?
-
 #endif /* __GLASGOW_HASKELL__ */
 
 {- | Returns the current user's home directory.
@@ -1081,9 +1073,7 @@ The function doesn\'t verify whether the path exists.
 getTemporaryDirectory :: IO FilePath
 getTemporaryDirectory = do
 #if defined(mingw32_HOST_OS)
-  allocaBytes long_path_size $ \pPath -> do
-     _r <- c_GetTempPath (fromIntegral long_path_size) pPath
-     peekCString pPath
+  System.Win32.getTemporaryDirectory
 #else
   getEnv "TMPDIR"
 #if !__NHC__
@@ -1107,8 +1097,6 @@ 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 "GetTempPathA" c_GetTempPath :: CInt -> CString -> IO CInt
-
 raiseUnsupported :: String -> IO ()
 raiseUnsupported loc = 
    ioException (ioeSetErrorString (mkIOError UnsupportedOperation loc Nothing Nothing) "unsupported operation")
@@ -1124,4 +1112,3 @@ exeExtension = "exe"
 #else
 exeExtension = ""
 #endif
-