X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FDirectory.hs;h=872334a8bebcfe43b5abbb3d493da3fee6983538;hb=ee695cc16336b7f2a6bca5bc74606c702837361d;hp=46d69498b5b5acfc967e254e4655220a31d5a1bf;hpb=468611bd4c41cd427c6f98e780154db804b51b28;p=ghc-base.git

diff --git a/System/Directory.hs b/System/Directory.hs
index 46d6949..872334a 100644
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -14,22 +14,10 @@
 
 module System.Directory 
    ( 
-     -- $intro
-
-     -- * Permissions
-
-     -- $permissions
-
-     Permissions(
-	Permissions,
-	readable,		-- :: Permissions -> Bool 
-	writable,		-- :: Permissions -> Bool
-	executable,		-- :: Permissions -> Bool
-	searchable		-- :: Permissions -> Bool
-     )
+    -- $intro
 
     -- * Actions on directories
-    , createDirectory		-- :: FilePath -> IO ()
+      createDirectory		-- :: FilePath -> IO ()
     , removeDirectory		-- :: FilePath -> IO ()
     , renameDirectory		-- :: FilePath -> FilePath -> IO ()
 
@@ -45,7 +33,17 @@ module System.Directory
     , doesFileExist		-- :: FilePath -> IO Bool
     , doesDirectoryExist        -- :: FilePath -> IO Bool
 
-    -- * Setting and retrieving permissions
+    -- * Permissions
+
+    -- $permissions
+
+    , Permissions(
+	Permissions,
+	readable,		-- :: Permissions -> Bool
+	writable,		-- :: Permissions -> Bool
+	executable,		-- :: Permissions -> Bool
+	searchable		-- :: Permissions -> Bool
+      )
 
     , getPermissions            -- :: FilePath -> IO Permissions
     , setPermissions	        -- :: FilePath -> Permissions -> IO ()
@@ -55,15 +53,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
 
@@ -111,6 +118,18 @@ data Permissions
     executable, searchable :: Bool 
    } deriving (Eq, Ord, Read, Show)
 
+{- |The 'getPermissions' operation returns the
+permissions for the file or directory.
+
+The operation may fail with:
+
+* 'isPermissionError' if the user is not permitted to access
+  the permissions; or
+
+* 'isDoesNotExistError' if the file or directory does not exist.
+
+-}
+
 getPermissions :: FilePath -> IO Permissions
 getPermissions name = do
   withCString name $ \s -> do
@@ -128,6 +147,18 @@ getPermissions name = do
     }
    )
 
+{- |The 'setPermissions' operation sets the
+permissions for the file or directory.
+
+The operation may fail with:
+
+* 'isPermissionError' if the user is not permitted to set
+  the permissions; or
+
+* 'isDoesNotExistError' if the file or directory does not exist.
+
+-}
+
 setPermissions :: FilePath -> Permissions -> IO ()
 setPermissions name (Permissions r w e s) = do
     let
@@ -229,6 +260,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)
 
@@ -268,6 +300,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)
 
@@ -281,6 +314,9 @@ renaming directories in all situations (e.g. renaming to an existing
 directory, or across different physical devices), but the constraints
 must be documented.
 
+On Win32 platforms, @renameDirectory@ fails if the /new/ directory already
+exists.
+
 The operation may fail with:
 
 * 'HardwareFault'
@@ -420,6 +456,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 -> 
@@ -529,14 +566,13 @@ 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
 
-{- |To clarify, 'doesDirectoryExist' returns 'True' if a file system object
-exist, and it's a directory. 'doesFileExist' returns 'True' if the file
-system object exist, but it's not a directory (i.e., for every other 
-file system object that is not a directory.) 
+{- |The operation 'doesDirectoryExist' returns 'True' if the argument file
+exists and is a directory, and 'False' otherwise.
 -}
 
 doesDirectoryExist :: FilePath -> IO Bool
@@ -545,12 +581,28 @@ doesDirectoryExist name =
    (withFileStatus name $ \st -> isDirectory st)
    (\ _ -> return False)
 
+{- |The operation 'doesFileExist' returns 'True'
+if the argument file exists and is not a directory, and 'False' otherwise.
+-}
+
 doesFileExist :: FilePath -> IO Bool
 doesFileExist name = do 
  catch
    (withFileStatus name $ \st -> do b <- isDirectory st; return (not b))
    (\ _ -> return False)
 
+{- |The 'getModificationTime' operation returns the
+clock time at which the file or directory was last modified.
+
+The operation may fail with:
+
+* 'isPermissionError' if the user is not permitted to access
+  the modification time; or
+
+* 'isDoesNotExistError' if the file or directory does not exist.
+
+-}
+
 getModificationTime :: FilePath -> IO ClockTime
 getModificationTime name =
  withFileStatus name $ \ st ->
@@ -558,13 +610,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)
@@ -580,6 +634,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
 
@@ -590,18 +654,6 @@ unionCMode     = (+)
 foreign import ccall unsafe "__hscore_path_max"
   path_max :: Int
 
-foreign import ccall unsafe "__hscore_readdir"
-  readdir  :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
-
-foreign import ccall unsafe "__hscore_free_dirent"
-  freeDirEnt  :: Ptr CDirent -> IO ()
-
-foreign import ccall unsafe "__hscore_end_of_dir"
-  end_of_dir :: CInt
-
-foreign import ccall unsafe "__hscore_d_name"
-  d_name :: Ptr CDirent -> IO CString
-
 foreign import ccall unsafe "__hscore_R_OK" r_OK :: CMode
 foreign import ccall unsafe "__hscore_W_OK" w_OK :: CMode
 foreign import ccall unsafe "__hscore_X_OK" x_OK :: CMode
@@ -609,3 +661,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