X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FDirectory.hs;h=9cb985cc1af3ab55fab15d78cf8e7791204b97e3;hb=f444698bf6b09b2da6a1fec8aecc1eaf37847980;hp=00aa07a290522a2a1b91527858023376d9c14f59;hpb=4ea71f2a9ade50ca74a091338948ef02c4e23d6d;p=ghc-base.git

diff --git a/System/Directory.hs b/System/Directory.hs
index 00aa07a..9cb985c 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 ()
@@ -72,7 +70,7 @@ import Foreign
 import Foreign.C
 
 #ifdef __GLASGOW_HASKELL__
-import GHC.Posix
+import System.Posix.Internals
 import GHC.IOBase	( IOException(..), IOErrorType(..), ioException )
 #endif
 
@@ -120,13 +118,25 @@ 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
   read  <- c_access s r_OK
   write <- c_access s w_OK
   exec  <- c_access s x_OK
-  withFileStatus name $ \st -> do
+  withFileStatus "getPermissions" name $ \st -> do
   is_dir <- isDirectory st
   return (
     Permissions {
@@ -137,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
@@ -214,7 +236,7 @@ EIO
 The operand is not a valid directory name.
 [ENAMETOOLONG, ELOOP]
 
-* 'isDoesNotExist'  'NoSuchThing'
+* 'isDoesNotExistError' \/ 'NoSuchThing'
 The directory does not exist. 
 @[ENOENT, ENOTDIR]@
 
@@ -242,7 +264,7 @@ removeDirectory path = do
     withCString path $ \s ->
        throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
 
-{- |@'removefile' file@ removes the directory entry for an existing file
+{- |'removeFile' /file/ removes the directory entry for an existing file
 /file/, where /file/ is not itself a directory. The
 implementation may specify additional constraints which must be
 satisfied before a file can be removed (e.g. the file may not be in
@@ -252,13 +274,13 @@ The operation may fail with:
 
 * 'HardwareFault'
 A physical I\/O error has occurred.
-'EIO'
+@[EIO]@
 
 * 'InvalidArgument'
 The operand is not a valid file name.
 @[ENAMETOOLONG, ELOOP]@
 
-* 'isDoesNotExist' \/ 'NoSuchThing'
+* 'isDoesNotExistError' \/ 'NoSuchThing'
 The file does not exist. 
 @[ENOENT, ENOTDIR]@
 
@@ -292,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'
@@ -330,7 +355,7 @@ Either path refers to an existing non-directory object.
 
 renameDirectory :: FilePath -> FilePath -> IO ()
 renameDirectory opath npath =
-   withFileStatus opath $ \st -> do
+   withFileStatus "renameDirectory" opath $ \st -> do
    is_dir <- isDirectory st
    if (not is_dir)
 	then ioException (IOError Nothing InappropriateType "renameDirectory"
@@ -387,7 +412,7 @@ Either path refers to an existing directory.
 
 renameFile :: FilePath -> FilePath -> IO ()
 renameFile opath npath =
-   withFileOrSymlinkStatus opath $ \st -> do
+   withFileOrSymlinkStatus "renameFile" opath $ \st -> do
    is_dir <- isDirectory st
    if is_dir
 	then ioException (IOError Nothing InappropriateType "renameFile"
@@ -492,8 +517,8 @@ The operating system has no notion of current directory.
 
 getCurrentDirectory :: IO FilePath
 getCurrentDirectory = do
-  p <- mallocBytes path_max
-  go p path_max
+  p <- mallocBytes long_path_size
+  go p long_path_size
   where go p bytes = do
     	  p' <- c_getcwd p (fromIntegral bytes)
 	  if p' /= nullPtr 
@@ -546,43 +571,57 @@ setCurrentDirectory path = do
        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
 doesDirectoryExist name = 
  catch
-   (withFileStatus name $ \st -> isDirectory st)
+   (withFileStatus "doesDirectoryExist" 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))
+   (withFileStatus "doesFileExist" 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 ->
+ withFileStatus "getModificationTime" name $ \ st ->
  modificationTime st
 
-withFileStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a
-withFileStatus name f = do
+withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
+withFileStatus loc name f = do
   modifyIOError (`ioeSetFileName` name) $
     allocaBytes sizeof_stat $ \p ->
       withCString (fileNameEndClean name) $ \s -> do
-        throwErrnoIfMinus1Retry_ "withFileStatus" (c_stat s p)
+        throwErrnoIfMinus1Retry_ loc (c_stat s p)
 	f p
 
-withFileOrSymlinkStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a
-withFileOrSymlinkStatus name f = do
+withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
+withFileOrSymlinkStatus loc name f = do
   modifyIOError (`ioeSetFileName` name) $
     allocaBytes sizeof_stat $ \p ->
       withCString name $ \s -> do
-        throwErrnoIfMinus1Retry_ "withFileOrSymlinkStatus" (lstat s p)
+        throwErrnoIfMinus1Retry_ loc (lstat s p)
 	f p
 
 modificationTime :: Ptr CStat -> IO ClockTime
@@ -597,7 +636,7 @@ isDirectory stat = do
 
 fileNameEndClean :: String -> String
 fileNameEndClean name = 
-  if i >= 0 && (ec == '\\' || ec == '/') then 
+  if i > 0 && (ec == '\\' || ec == '/') then 
      fileNameEndClean (take i name)
    else
      name
@@ -612,20 +651,8 @@ unionCMode     :: CMode -> CMode -> CMode
 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_long_path_size"
+  long_path_size :: Int
 
 foreign import ccall unsafe "__hscore_R_OK" r_OK :: CMode
 foreign import ccall unsafe "__hscore_W_OK" w_OK :: CMode