X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FDirectory.hs;h=e3c2c726040844ad79635deb2ff14502b1f18901;hb=4f63d4b753caf3964066ba7ebe7860154b8684db;hp=1df632f25ead83d2ab0d0003d44019c22691345d;hpb=12608d12873e6b88c44881b3ff91bba6807affe5;p=haskell-directory.git

diff --git a/System/Directory.hs b/System/Directory.hs
index 1df632f..e3c2c72 100644
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -77,7 +77,7 @@ import System.FilePath
 import System.IO
 import System.IO.Error hiding ( catch, try )
 import Control.Monad           ( when, unless )
-import Control.Exception
+import Control.Exception.Base
 
 #ifdef __NHC__
 import Directory
@@ -100,6 +100,12 @@ import System.Time             ( ClockTime(..) )
 
 import GHC.IOBase	( IOException(..), IOErrorType(..), ioException )
 
+#ifdef mingw32_HOST_OS
+import qualified System.Win32
+#else
+import qualified System.Posix
+#endif
+
 {- $intro
 A directory contains a series of entries, each of which is a named
 reference to a file system object (file, directory etc.).  Some
@@ -278,10 +284,11 @@ The path refers to an existing non-directory object.
 
 createDirectory :: FilePath -> IO ()
 createDirectory path = do
-  modifyIOError (`ioeSetFileName` path) $
-    withCString path $ \s -> do
-      throwErrnoIfMinus1Retry_ "createDirectory" $
-	mkdir s 0o777
+#ifdef mingw32_HOST_OS
+  System.Win32.createDirectory path Nothing
+#else
+  System.Posix.createDirectory path 0o777
+#endif
 
 #else /* !__GLASGOW_HASKELL__ */
 
@@ -349,10 +356,13 @@ The operand refers to an existing non-directory object.
 -}
 
 removeDirectory :: FilePath -> IO ()
-removeDirectory path = do
-  modifyIOError (`ioeSetFileName` path) $
-    withCString path $ \s ->
-       throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
+removeDirectory path =
+#ifdef mingw32_HOST_OS
+  System.Win32.removeDirectory path
+#else
+  System.Posix.removeDirectory path
+#endif
+
 #endif
 
 -- | @'removeDirectoryRecursive' dir@  removes an existing directory /dir/
@@ -409,10 +419,12 @@ The operand refers to an existing directory.
 -}
 
 removeFile :: FilePath -> IO ()
-removeFile path = do
-  modifyIOError (`ioeSetFileName` path) $
-    withCString path $ \s ->
-      throwErrnoIfMinus1Retry_ "removeFile" (c_unlink s)
+removeFile path =
+#if mingw32_HOST_OS
+  System.Win32.deleteFile path
+#else
+  System.Posix.removeLink path
+#endif
 
 {- |@'renameDirectory' old new@ changes the name of an existing
 directory from /old/ to /new/.  If the /new/ directory
@@ -465,16 +477,18 @@ Either path refers to an existing non-directory object.
 
 renameDirectory :: FilePath -> FilePath -> IO ()
 renameDirectory opath npath =
+   -- XXX this test isn't performed atomically with the following rename
    withFileStatus "renameDirectory" opath $ \st -> do
    is_dir <- isDirectory st
    if (not is_dir)
 	then ioException (IOError Nothing InappropriateType "renameDirectory"
 			    ("not a directory") (Just opath))
 	else do
-
-   withCString opath $ \s1 ->
-     withCString npath $ \s2 ->
-        throwErrnoIfMinus1Retry_ "renameDirectory" (c_rename s1 s2)
+#ifdef mingw32_HOST_OS
+   System.Win32.moveFileEx opath npath System.Win32.mOVEFILE_REPLACE_EXISTING
+#else
+   System.Posix.rename opath npath
+#endif
 
 {- |@'renameFile' old new@ changes the name of an existing file system
 object from /old/ to /new/.  If the /new/ object already
@@ -522,16 +536,18 @@ Either path refers to an existing directory.
 
 renameFile :: FilePath -> FilePath -> IO ()
 renameFile opath npath =
+   -- XXX this test isn't performed atomically with the following rename
    withFileOrSymlinkStatus "renameFile" opath $ \st -> do
    is_dir <- isDirectory st
    if is_dir
 	then ioException (IOError Nothing InappropriateType "renameFile"
 			   "is a directory" (Just opath))
 	else do
-
-    withCString opath $ \s1 ->
-      withCString npath $ \s2 ->
-         throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
+#ifdef mingw32_HOST_OS
+   System.Win32.moveFileEx opath npath System.Win32.mOVEFILE_REPLACE_EXISTING
+#else
+   System.Posix.rename opath npath
+#endif
 
 #endif /* __GLASGOW_HASKELL__ */
 
@@ -545,8 +561,8 @@ copyFile :: FilePath -> FilePath -> IO ()
 #ifdef __NHC__
 copyFile fromFPath toFPath =
     do readFile fromFPath >>= writeFile toFPath
-       try (copyPermissions fromFPath toFPath)
-       return ()
+       Prelude.catch (copyPermissions fromFPath toFPath)
+                     (\_ -> return ())
 #else
 copyFile fromFPath toFPath =
     copy `Prelude.catch` (\exc -> throw $ ioeSetLocation exc "copyFile")
@@ -752,6 +768,8 @@ The operating system has no notion of current directory.
 
 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
@@ -766,6 +784,14 @@ getCurrentDirectory = do
 			        p'' <- reallocBytes p bytes'
 			        go p'' bytes'
 		        else throwErrno "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
@@ -800,11 +826,12 @@ The path refers to an existing non-directory object.
 -}
 
 setCurrentDirectory :: FilePath -> IO ()
-setCurrentDirectory path = do
-  modifyIOError (`ioeSetFileName` path) $
-    withCString path $ \s -> 
-       throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
-	-- ToDo: add path to error
+setCurrentDirectory path =
+#ifdef mingw32_HOST_OS
+  System.Win32.setCurrentDirectory path
+#else
+  System.Posix.changeWorkingDirectory path
+#endif
 
 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
 exists and is a directory, and 'False' otherwise.
@@ -1038,7 +1065,7 @@ getTemporaryDirectory = do
     `Prelude.catch` \e -> if isDoesNotExistError e then return "/tmp"
                           else throw e
 #else
-    `catch` (\ex -> return "/tmp")
+    `Prelude.catch` (\ex -> return "/tmp")
 #endif
 #endif