[project @ 2003-04-11 10:11:24 by ross]

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

diff --git a/System/Directory.hs b/System/Directory.hs
index 911ff4e..d37a364 100644 (file)
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -55,16 +55,24 @@ module System.Directory
     , getModificationTime       -- :: FilePath -> IO ClockTime
    ) where
 
+#ifdef __NHC__
+import Directory
+#elif defined(__HUGS__)
+import Hugs.Directory
+#else
+
 import Prelude
 
+import Control.Exception       ( bracket )
 import System.Posix.Types
 import System.Time             ( ClockTime(..) )
 import System.IO
+import System.IO.Error
 import Foreign
 import Foreign.C
 
 #ifdef __GLASGOW_HASKELL__
-import GHC.Posix
+import System.Posix.Internals
 import GHC.IOBase      ( IOException(..), IOErrorType(..), ioException )
 #endif
 
@@ -230,6 +238,7 @@ 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)
 
@@ -269,6 +278,7 @@ The operand refers to an existing directory.
 
 removeFile :: FilePath -> IO ()
 removeFile path = do
+  modifyIOError (`ioeSetFileName` path) $
     withCString path $ \s ->
       throwErrnoIfMinus1Retry_ "removeFile" (c_unlink s)
 
@@ -421,6 +431,7 @@ The path refers to an existing non-directory object.
 
 getDirectoryContents :: FilePath -> IO [FilePath]
 getDirectoryContents path = do
+  modifyIOError (`ioeSetFileName` path) $
    alloca $ \ ptr_dEnt ->
      bracket
        (withCString path $ \s -> 
@@ -530,6 +541,7 @@ 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
@@ -559,13 +571,15 @@ getModificationTime name =
 
 withFileStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a
 withFileStatus name f = do
+  modifyIOError (`ioeSetFileName` name) $
     allocaBytes sizeof_stat $ \p ->
-      withCString name $ \s -> do
+      withCString (fileNameEndClean name) $ \s -> do
         throwErrnoIfMinus1Retry_ "withFileStatus" (c_stat s p)
        f p
 
 withFileOrSymlinkStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a
 withFileOrSymlinkStatus name f = do
+  modifyIOError (`ioeSetFileName` name) $
     allocaBytes sizeof_stat $ \p ->
       withCString name $ \s -> do
         throwErrnoIfMinus1Retry_ "withFileOrSymlinkStatus" (lstat s p)
@@ -581,6 +595,16 @@ isDirectory stat = do
   mode <- st_mode stat
   return (s_isdir mode)
 
+fileNameEndClean :: String -> String
+fileNameEndClean name = 
+  if i >= 0 && (ec == '\\' || ec == '/') then 
+     fileNameEndClean (take i name)
+   else
+     name
+  where
+      i  = (length name) - 1
+      ec = name !! i
+
 emptyCMode     :: CMode
 emptyCMode     = 0
 
@@ -610,3 +634,5 @@ foreign import ccall unsafe "__hscore_X_OK" x_OK :: CMode
 foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
 foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
 foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode
+
+#endif