[project @ 2004-08-18 09:23:19 by malcolm]

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

diff --git a/System/Directory.hs b/System/Directory.hs
index 4f76ca6..fa6265b 100644 (file)
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -5,76 +5,127 @@
 -- License     :  BSD-style (see the file libraries/base/LICENSE)
 -- 
 -- Maintainer  :  libraries@haskell.org
 -- License     :  BSD-style (see the file libraries/base/LICENSE)
 -- 
 -- Maintainer  :  libraries@haskell.org

--- Stability   :  provisional
+-- Stability   :  stable

 -- Portability :  portable
 --
 -- System-independent interface to directory manipulation.
 --
 -----------------------------------------------------------------------------
 
 -- Portability :  portable
 --
 -- System-independent interface to directory manipulation.
 --
 -----------------------------------------------------------------------------
 

-{-
-A directory contains a series of entries, each of which is a named
-reference to a file system object (file, directory etc.).  Some
-entries may be hidden, inaccessible, or have some administrative
-function (e.g. "." or ".." under POSIX), but in this standard all such
-entries are considered to form part of the directory contents.
-Entries in sub-directories are not, however, considered to form part
-of the directory contents.
-
-Each file system object is referenced by a {\em path}.  There is
-normally at least one absolute path to each file system object.  In
-some operating systems, it may also be possible to have paths which
-are relative to the current directory.
--}
-

 module System.Directory 
    ( 
 module System.Directory 
    ( 

-      Permissions(
-       Permissions,
-       readable,               -- :: Permissions -> Bool 
-       writable,               -- :: Permissions -> Bool
-       executable,             -- :: Permissions -> Bool
-       searchable              -- :: Permissions -> Bool
-     ),
+    -- $intro

 
 

-    , createDirectory          -- :: FilePath -> IO ()
+    -- * Actions on directories
+      createDirectory          -- :: FilePath -> IO ()

     , removeDirectory          -- :: FilePath -> IO ()
     , renameDirectory          -- :: FilePath -> FilePath -> IO ()
 
     , getDirectoryContents      -- :: FilePath -> IO [FilePath]
     , getCurrentDirectory       -- :: IO FilePath
     , setCurrentDirectory       -- :: FilePath -> IO ()
     , removeDirectory          -- :: FilePath -> IO ()
     , renameDirectory          -- :: FilePath -> FilePath -> IO ()
 
     , getDirectoryContents      -- :: FilePath -> IO [FilePath]
     , getCurrentDirectory       -- :: IO FilePath
     , setCurrentDirectory       -- :: FilePath -> IO ()

+    , getHomeDirectory
+    , getAppUserDataDirectory 

 
 

+    -- * Actions on files

     , removeFile               -- :: FilePath -> IO ()
     , renameFile                -- :: FilePath -> FilePath -> IO ()
     , removeFile               -- :: FilePath -> IO ()
     , renameFile                -- :: FilePath -> FilePath -> IO ()

+#ifdef __GLASGOW_HASKELL__
+    , copyFile                  -- :: FilePath -> FilePath -> IO ()
+#endif

 
 

+    -- * Existence tests

     , doesFileExist            -- :: FilePath -> IO Bool
     , doesDirectoryExist        -- :: FilePath -> IO Bool
 
     , doesFileExist            -- :: FilePath -> IO Bool
     , doesDirectoryExist        -- :: FilePath -> IO Bool
 

+    -- * Permissions
+
+    -- $permissions
+
+    , Permissions(
+       Permissions,
+       readable,               -- :: Permissions -> Bool
+       writable,               -- :: Permissions -> Bool
+       executable,             -- :: Permissions -> Bool
+       searchable              -- :: Permissions -> Bool
+      )
+

     , getPermissions            -- :: FilePath -> IO Permissions
     , setPermissions           -- :: FilePath -> Permissions -> IO ()
 
     , getPermissions            -- :: FilePath -> IO Permissions
     , setPermissions           -- :: FilePath -> Permissions -> IO ()
 

+    -- * Timestamps
+

     , getModificationTime       -- :: FilePath -> IO ClockTime
    ) where
 
     , getModificationTime       -- :: FilePath -> IO ClockTime
    ) where
 

+#ifdef __NHC__
+import Directory
+getHomeDirectory :: IO FilePath
+getHomeDirectory = getEnv "HOME"
+getAppUserDataDirectory :: String -> IO FilePath
+getAppUserDataDirectory appName = do path <- getEnv "HOME"
+                                     return (path++'/':'.':appName)
+#elif defined(__HUGS__)
+import Hugs.Directory
+#else
+

 import Prelude
 
 import Prelude
 

+import Control.Exception       ( bracket )
+import Control.Monad           ( when )
+import System.Posix.Types
+import System.Posix.Internals

 import System.Time             ( ClockTime(..) )
 import System.IO
 import System.Time             ( ClockTime(..) )
 import System.IO

+import System.IO.Error

 import Foreign
 import Foreign.C
 
 #ifdef __GLASGOW_HASKELL__
 import Foreign
 import Foreign.C
 
 #ifdef __GLASGOW_HASKELL__

-import GHC.Posix

 import GHC.IOBase      ( IOException(..), IOErrorType(..), ioException )
 #endif
 
 import GHC.IOBase      ( IOException(..), IOErrorType(..), ioException )
 #endif
 

+#ifndef mingw32_TARGET_OS
+import System.Environment
+#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
+entries may be hidden, inaccessible, or have some administrative
+function (e.g. `.' or `..' under POSIX
+<http://www.opengroup.org/onlinepubs/007904975/toc.htm>), but in 
+this standard all such entries are considered to form part of the
+directory contents. Entries in sub-directories are not, however,
+considered to form part of the directory contents.
+
+Each file system object is referenced by a /path/.  There is
+normally at least one absolute path to each file system object.  In
+some operating systems, it may also be possible to have paths which
+are relative to the current directory.
+-}
+

 -----------------------------------------------------------------------------
 -- Permissions
 
 -----------------------------------------------------------------------------
 -- Permissions
 

--- The Permissions type is used to record whether certain
--- operations are permissible on a file/directory:
--- [to whom? - presumably the "current user"]
+{- $permissions
+
+ The 'Permissions' type is used to record whether certain operations are
+ permissible on a file\/directory. 'getPermissions' and 'setPermissions'
+ get and set these permissions, respectively. Permissions apply both to
+ files and directories. For directories, the executable field will be
+ 'False', and for files the searchable field will be 'False'. Note that
+ directories may be searchable without being readable, if permission has
+ been given to use them as part of a path, but not to examine the 
+ directory contents.
+
+Note that to change some, but not all permissions, a construct on the following lines must be used. 
+
+>  makeReadable f = do
+>     p <- getPermissions f
+>     setPermissions f (p {readable = True})
+
+-}

 
 data Permissions
  = Permissions {
 
 data Permissions
  = Permissions {

@@ -82,40 +133,102 @@ data Permissions
     executable, searchable :: Bool 
    } deriving (Eq, Ord, Read, Show)
 
     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 "getPermissions" name $ \st -> do
+  is_dir <- isDirectory st
+  return (
+    Permissions {
+      readable   = read  == 0,
+      writable   = write == 0,
+      executable = not is_dir && exec == 0,
+      searchable = is_dir && exec == 0
+    }
+   )
+
+{- |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
+  allocaBytes sizeof_stat $ \ p_stat -> do
+  withCString name $ \p_name -> do
+    throwErrnoIfMinus1_ "setPermissions" $ do
+      c_stat p_name p_stat
+      mode <- st_mode p_stat
+      let mode1 = modifyBit r mode s_IRUSR
+      let mode2 = modifyBit w mode1 s_IWUSR
+      let mode3 = modifyBit (e || s) mode2 s_IXUSR
+      c_chmod p_name mode3
+
+ where
+   modifyBit :: Bool -> CMode -> CMode -> CMode
+   modifyBit False m b = m .&. (complement b)
+   modifyBit True  m b = m .|. b
+

 -----------------------------------------------------------------------------
 -- Implementation
 
 -----------------------------------------------------------------------------
 -- Implementation
 

--- `createDirectory dir' creates a new directory dir which is
--- initially empty, or as near to empty as the operating system
--- allows.
+{- |@'createDirectory' dir@ creates a new directory @dir@ which is
+initially empty, or as near to empty as the operating system
+allows.

 
 

--- The operation may fail with:
+The operation may fail with:

 
 

-{-
-\begin{itemize}
-\item @isPermissionError@ / @PermissionDenied@
+* 'isPermissionError' \/ 'PermissionDenied'

 The process has insufficient privileges to perform the operation.
 @[EROFS, EACCES]@
 The process has insufficient privileges to perform the operation.
 @[EROFS, EACCES]@

-\item @isAlreadyExistsError@ / @AlreadyExists@
+
+* 'isAlreadyExistsError' \/ 'AlreadyExists'

 The operand refers to a directory that already exists.  
 @ [EEXIST]@
 The operand refers to a directory that already exists.  
 @ [EEXIST]@

-\item @HardwareFault@
-A physical I/O error has occurred.
-@ [EIO]@
-\item @InvalidArgument@
+
+* 'HardwareFault'
+A physical I\/O error has occurred.
+@[EIO]@
+
+* 'InvalidArgument'

 The operand is not a valid directory name.
 @[ENAMETOOLONG, ELOOP]@
 The operand is not a valid directory name.
 @[ENAMETOOLONG, ELOOP]@

-\item @NoSuchThing@
+
+* 'NoSuchThing'

 There is no path to the directory. 
 @[ENOENT, ENOTDIR]@
 There is no path to the directory. 
 @[ENOENT, ENOTDIR]@

-\item @ResourceExhausted@
+
+* 'ResourceExhausted'

 Insufficient resources (virtual memory, process file descriptors,
 physical disk space, etc.) are available to perform the operation.
 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 Insufficient resources (virtual memory, process file descriptors,
 physical disk space, etc.) are available to perform the operation.
 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@

-\item @InappropriateType@
+
+* 'InappropriateType'

 The path refers to an existing non-directory object.
 @[EEXIST]@
 The path refers to an existing non-directory object.
 @[EEXIST]@

-\end{itemize}
+

 -}
 
 createDirectory :: FilePath -> IO ()
 -}
 
 createDirectory :: FilePath -> IO ()

@@ -124,8 +237,7 @@ createDirectory path = do
       throwErrnoIfMinus1Retry_ "createDirectory" $
        mkdir s 0o777
 
       throwErrnoIfMinus1Retry_ "createDirectory" $
        mkdir s 0o777
 

-{-
-@removeDirectory dir@ removes an existing directory {\em dir}.  The
+{- | @'removeDirectory' dir@ removes an existing directory /dir/.  The

 implementation may specify additional constraints which must be
 satisfied before a directory can be removed (e.g. the directory has to
 be empty, or may not be in use by other processes).  It is not legal
 implementation may specify additional constraints which must be
 satisfied before a directory can be removed (e.g. the directory has to
 be empty, or may not be in use by other processes).  It is not legal

@@ -135,114 +247,135 @@ support directory removal in all situations (e.g. removal of the root
 directory).
 
 The operation may fail with:
 directory).
 
 The operation may fail with:

-\begin{itemize}
-\item @HardwareFault@
-A physical I/O error has occurred.
-[@EIO@]
-\item @InvalidArgument@
+
+* 'HardwareFault'
+A physical I\/O error has occurred.
+EIO
+
+* 'InvalidArgument'

 The operand is not a valid directory name.
 The operand is not a valid directory name.

-@[ENAMETOOLONG, ELOOP]@
-\item @isDoesNotExist@ / @NoSuchThing@
+[ENAMETOOLONG, ELOOP]
+
+* 'isDoesNotExistError' \/ 'NoSuchThing'

 The directory does not exist. 
 @[ENOENT, ENOTDIR]@
 The directory does not exist. 
 @[ENOENT, ENOTDIR]@

-\item @isPermissionError@ / @PermissionDenied@
+
+* 'isPermissionError' \/ 'PermissionDenied'

 The process has insufficient privileges to perform the operation.
 @[EROFS, EACCES, EPERM]@
 The process has insufficient privileges to perform the operation.
 @[EROFS, EACCES, EPERM]@

-\item @UnsatisfiedConstraints@
+
+* 'UnsatisfiedConstraints'

 Implementation-dependent constraints are not satisfied.  
 @[EBUSY, ENOTEMPTY, EEXIST]@
 Implementation-dependent constraints are not satisfied.  
 @[EBUSY, ENOTEMPTY, EEXIST]@

-\item @UnsupportedOperation@
+
+* 'UnsupportedOperation'

 The implementation does not support removal in this situation.
 @[EINVAL]@
 The implementation does not support removal in this situation.
 @[EINVAL]@

-\item @InappropriateType@
+
+* 'InappropriateType'

 The operand refers to an existing non-directory object.
 @[ENOTDIR]@
 The operand refers to an existing non-directory object.
 @[ENOTDIR]@

-\end{itemize}
+

 -}
 
 removeDirectory :: FilePath -> IO ()
 removeDirectory path = do
 -}
 
 removeDirectory :: FilePath -> IO ()
 removeDirectory path = do

+  modifyIOError (`ioeSetFileName` path) $

     withCString path $ \s ->
        throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
 
     withCString path $ \s ->
        throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
 

-{-
-@Removefile file@ removes the directory entry for an existing file
-{\em file}, where {\em file} is not itself a directory. The
+{- |'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
 use by other processes).
 
 The operation may fail with:
 implementation may specify additional constraints which must be
 satisfied before a file can be removed (e.g. the file may not be in
 use by other processes).
 
 The operation may fail with:

-\begin{itemize}
-\item @HardwareFault@
-A physical I/O error has occurred.
+
+* 'HardwareFault'
+A physical I\/O error has occurred.

 @[EIO]@
 @[EIO]@

-\item @InvalidArgument@
+
+* 'InvalidArgument'

 The operand is not a valid file name.
 @[ENAMETOOLONG, ELOOP]@
 The operand is not a valid file name.
 @[ENAMETOOLONG, ELOOP]@

-\item @isDoesNotExist@ / @NoSuchThing@
+
+* 'isDoesNotExistError' \/ 'NoSuchThing'

 The file does not exist. 
 @[ENOENT, ENOTDIR]@
 The file does not exist. 
 @[ENOENT, ENOTDIR]@

-\item @isPermissionError@ / @PermissionDenied@
+
+* 'isPermissionError' \/ 'PermissionDenied'

 The process has insufficient privileges to perform the operation.
 @[EROFS, EACCES, EPERM]@
 The process has insufficient privileges to perform the operation.
 @[EROFS, EACCES, EPERM]@

-\item @UnsatisfiedConstraints@
+
+* 'UnsatisfiedConstraints'

 Implementation-dependent constraints are not satisfied.  
 @[EBUSY]@
 Implementation-dependent constraints are not satisfied.  
 @[EBUSY]@

-\item @InappropriateType@
+
+* 'InappropriateType'

 The operand refers to an existing directory.
 @[EPERM, EINVAL]@
 The operand refers to an existing directory.
 @[EPERM, EINVAL]@

-\end{itemize}
+

 -}
 
 removeFile :: FilePath -> IO ()
 removeFile path = do
 -}
 
 removeFile :: FilePath -> IO ()
 removeFile path = do

+  modifyIOError (`ioeSetFileName` path) $

     withCString path $ \s ->
       throwErrnoIfMinus1Retry_ "removeFile" (c_unlink s)
 
     withCString path $ \s ->
       throwErrnoIfMinus1Retry_ "removeFile" (c_unlink s)
 

-{-
-@renameDirectory@ {\em old} {\em new} changes the name of an existing
-directory from {\em old} to {\em new}.  If the {\em new} directory
-already exists, it is atomically replaced by the {\em old} directory.
-If the {\em new} directory is neither the {\em old} directory nor an
-alias of the {\em old} directory, it is removed as if by
-$removeDirectory$.  A conformant implementation need not support
+{- |@'renameDirectory' old new@ changes the name of an existing
+directory from /old/ to /new/.  If the /new/ directory
+already exists, it is atomically replaced by the /old/ directory.
+If the /new/ directory is neither the /old/ directory nor an
+alias of the /old/ directory, it is removed as if by
+'removeDirectory'.  A conformant implementation need not support

 renaming directories in all situations (e.g. renaming to an existing
 directory, or across different physical devices), but the constraints
 must be documented.
 
 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:
 The operation may fail with:

-\begin{itemize}
-\item @HardwareFault@
-A physical I/O error has occurred.
+
+* 'HardwareFault'
+A physical I\/O error has occurred.

 @[EIO]@
 @[EIO]@

-\item @InvalidArgument@
+
+* 'InvalidArgument'

 Either operand is not a valid directory name.
 @[ENAMETOOLONG, ELOOP]@
 Either operand is not a valid directory name.
 @[ENAMETOOLONG, ELOOP]@

-\item @isDoesNotExistError@ / @NoSuchThing@
+
+* 'isDoesNotExistError' \/ 'NoSuchThing'

 The original directory does not exist, or there is no path to the target.
 @[ENOENT, ENOTDIR]@
 The original directory does not exist, or there is no path to the target.
 @[ENOENT, ENOTDIR]@

-\item @isPermissionError@ / @PermissionDenied@
+
+* 'isPermissionError' \/ 'PermissionDenied'

 The process has insufficient privileges to perform the operation.
 @[EROFS, EACCES, EPERM]@
 The process has insufficient privileges to perform the operation.
 @[EROFS, EACCES, EPERM]@

-\item @ResourceExhausted@
+
+* 'ResourceExhausted'

 Insufficient resources are available to perform the operation.  
 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 Insufficient resources are available to perform the operation.  
 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@

-\item @UnsatisfiedConstraints@
+
+* 'UnsatisfiedConstraints'

 Implementation-dependent constraints are not satisfied.
 @[EBUSY, ENOTEMPTY, EEXIST]@
 Implementation-dependent constraints are not satisfied.
 @[EBUSY, ENOTEMPTY, EEXIST]@

-\item @UnsupportedOperation@
+
+* 'UnsupportedOperation'

 The implementation does not support renaming in this situation.
 @[EINVAL, EXDEV]@
 The implementation does not support renaming in this situation.
 @[EINVAL, EXDEV]@

-\item @InappropriateType@
+
+* 'InappropriateType'

 Either path refers to an existing non-directory object.
 @[ENOTDIR, EISDIR]@
 Either path refers to an existing non-directory object.
 @[ENOTDIR, EISDIR]@

-\end{itemize}
+

 -}
 
 renameDirectory :: FilePath -> FilePath -> IO ()
 renameDirectory opath npath =
 -}
 
 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"
    is_dir <- isDirectory st
    if (not is_dir)
        then ioException (IOError Nothing InappropriateType "renameDirectory"

@@ -253,47 +386,53 @@ renameDirectory opath npath =
      withCString npath $ \s2 ->
         throwErrnoIfMinus1Retry_ "renameDirectory" (c_rename s1 s2)
 
      withCString npath $ \s2 ->
         throwErrnoIfMinus1Retry_ "renameDirectory" (c_rename s1 s2)
 

-{-
-@renameFile@ {\em old} {\em new} changes the name of an existing file system
-object from {\em old} to {\em new}.  If the {\em new} object already
-exists, it is atomically replaced by the {\em old} object.  Neither
+{- |@'renameFile' old new@ changes the name of an existing file system
+object from /old/ to /new/.  If the /new/ object already
+exists, it is atomically replaced by the /old/ object.  Neither

 path may refer to an existing directory.  A conformant implementation
 need not support renaming files in all situations (e.g. renaming
 across different physical devices), but the constraints must be
 documented.
 
 The operation may fail with:
 path may refer to an existing directory.  A conformant implementation
 need not support renaming files in all situations (e.g. renaming
 across different physical devices), but the constraints must be
 documented.
 
 The operation may fail with:

-\begin{itemize}
-\item @HardwareFault@
-A physical I/O error has occurred.
+
+* 'HardwareFault'
+A physical I\/O error has occurred.

 @[EIO]@
 @[EIO]@

-\item @InvalidArgument@
+
+* 'InvalidArgument'

 Either operand is not a valid file name.
 @[ENAMETOOLONG, ELOOP]@
 Either operand is not a valid file name.
 @[ENAMETOOLONG, ELOOP]@

-\item @isDoesNotExistError@ / @NoSuchThing@
+
+* 'isDoesNotExistError' \/ 'NoSuchThing'

 The original file does not exist, or there is no path to the target.
 @[ENOENT, ENOTDIR]@
 The original file does not exist, or there is no path to the target.
 @[ENOENT, ENOTDIR]@

-\item @isPermissionError@ / @PermissionDenied@
+
+* 'isPermissionError' \/ 'PermissionDenied'

 The process has insufficient privileges to perform the operation.
 @[EROFS, EACCES, EPERM]@
 The process has insufficient privileges to perform the operation.
 @[EROFS, EACCES, EPERM]@

-\item @ResourceExhausted@
+
+* 'ResourceExhausted'

 Insufficient resources are available to perform the operation.  
 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 Insufficient resources are available to perform the operation.  
 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@

-\item @UnsatisfiedConstraints@
+
+* 'UnsatisfiedConstraints'

 Implementation-dependent constraints are not satisfied.
 @[EBUSY]@
 Implementation-dependent constraints are not satisfied.
 @[EBUSY]@

-\item @UnsupportedOperation@
+
+* 'UnsupportedOperation'

 The implementation does not support renaming in this situation.
 @[EXDEV]@
 The implementation does not support renaming in this situation.
 @[EXDEV]@

-\item @InappropriateType@
+
+* 'InappropriateType'

 Either path refers to an existing directory.
 @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@
 Either path refers to an existing directory.
 @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@

-\end{itemize}
+

 -}
 
 renameFile :: FilePath -> FilePath -> IO ()
 renameFile opath npath =
 -}
 
 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"
    is_dir <- isDirectory st
    if is_dir
        then ioException (IOError Nothing InappropriateType "renameFile"

@@ -304,35 +443,62 @@ renameFile opath npath =
       withCString npath $ \s2 ->
          throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
 
       withCString npath $ \s2 ->
          throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
 

-{-
-@getDirectoryContents dir@ returns a list of {\em all} entries
-in {\em dir}. 
+{- |@'copyFile' old new@ copies the existing file from /old/ to /new/.
+If the /new/ file already exists, it is atomically replaced by the /old/ file.
+Neither path may refer to an existing directory.
+-}
+copyFile :: FilePath -> FilePath -> IO ()
+copyFile fromFPath toFPath =
+       (bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
+        bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo ->
+        allocaBytes bufferSize $ \buffer ->
+               copyContents hFrom hTo buffer) `catch` (ioError . changeFunName)
+       where
+               bufferSize = 1024
+               
+               changeFunName (IOError h iot fun str mb_fp) = IOError h iot "copyFile" str mb_fp
+               
+               copyContents hFrom hTo buffer = do
+                       count <- hGetBuf hFrom buffer bufferSize
+                       when (count > 0) $ do
+                               hPutBuf hTo buffer count
+                               copyContents hFrom hTo buffer
+
+
+{- |@'getDirectoryContents' dir@ returns a list of /all/ entries
+in /dir/. 

 
 The operation may fail with:
 
 The operation may fail with:

-\begin{itemize}
-\item @HardwareFault@
-A physical I/O error has occurred.
+
+* 'HardwareFault'
+A physical I\/O error has occurred.

 @[EIO]@
 @[EIO]@

-\item @InvalidArgument@
+
+* 'InvalidArgument'

 The operand is not a valid directory name.
 @[ENAMETOOLONG, ELOOP]@
 The operand is not a valid directory name.
 @[ENAMETOOLONG, ELOOP]@

-\item @isDoesNotExistError@ / @NoSuchThing@
+
+* 'isDoesNotExistError' \/ 'NoSuchThing'

 The directory does not exist.
 @[ENOENT, ENOTDIR]@
 The directory does not exist.
 @[ENOENT, ENOTDIR]@

-\item @isPermissionError@ / @PermissionDenied@
+
+* 'isPermissionError' \/ 'PermissionDenied'

 The process has insufficient privileges to perform the operation.
 @[EACCES]@
 The process has insufficient privileges to perform the operation.
 @[EACCES]@

-\item @ResourceExhausted@
+
+* 'ResourceExhausted'

 Insufficient resources are available to perform the operation.
 @[EMFILE, ENFILE]@
 Insufficient resources are available to perform the operation.
 @[EMFILE, ENFILE]@

-\item @InappropriateType@
+
+* 'InappropriateType'

 The path refers to an existing non-directory object.
 @[ENOTDIR]@
 The path refers to an existing non-directory object.
 @[ENOTDIR]@

-\end{itemize}
+

 -}
 
 getDirectoryContents :: FilePath -> IO [FilePath]
 getDirectoryContents path = do
 -}
 
 getDirectoryContents :: FilePath -> IO [FilePath]
 getDirectoryContents path = do

+  modifyIOError (`ioeSetFileName` path) $

    alloca $ \ ptr_dEnt ->
      bracket
        (withCString path $ \s -> 
    alloca $ \ ptr_dEnt ->
      bracket
        (withCString path $ \s -> 

@@ -365,33 +531,36 @@ getDirectoryContents path = do
 
 
 
 
 
 

-{-
-If the operating system has a notion of current directories,
-@getCurrentDirectory@ returns an absolute path to the
+{- |If the operating system has a notion of current directories,
+'getCurrentDirectory' returns an absolute path to the

 current directory of the calling process.
 
 The operation may fail with:
 current directory of the calling process.
 
 The operation may fail with:

-\begin{itemize}
-\item @HardwareFault@
-A physical I/O error has occurred.
+
+* 'HardwareFault'
+A physical I\/O error has occurred.

 @[EIO]@
 @[EIO]@

-\item @isDoesNotExistError@ / @NoSuchThing@
+
+* 'isDoesNotExistError' \/ 'NoSuchThing'

 There is no path referring to the current directory.
 @[EPERM, ENOENT, ESTALE...]@
 There is no path referring to the current directory.
 @[EPERM, ENOENT, ESTALE...]@

-\item @isPermissionError@ / @PermissionDenied@
+
+* 'isPermissionError' \/ 'PermissionDenied'

 The process has insufficient privileges to perform the operation.
 @[EACCES]@
 The process has insufficient privileges to perform the operation.
 @[EACCES]@

-\item @ResourceExhausted@
+
+* 'ResourceExhausted'

 Insufficient resources are available to perform the operation.
 Insufficient resources are available to perform the operation.

-\item @UnsupportedOperation@
+
+* 'UnsupportedOperation'

 The operating system has no notion of current directory.
 The operating system has no notion of current directory.

-\end{itemize}
+

 -}
 
 getCurrentDirectory :: IO FilePath
 getCurrentDirectory = do
 -}
 
 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 
   where go p bytes = do
          p' <- c_getcwd p (fromIntegral bytes)
          if p' /= nullPtr 

@@ -405,138 +574,159 @@ getCurrentDirectory = do
                                go p' bytes'
                        else throwErrno "getCurrentDirectory"
 
                                go p' bytes'
                        else throwErrno "getCurrentDirectory"
 

-{-
-If the operating system has a notion of current directories,
-@setCurrentDirectory dir@ changes the current
-directory of the calling process to {\em dir}.
+{- |If the operating system has a notion of current directories,
+@'setCurrentDirectory' dir@ changes the current
+directory of the calling process to /dir/.

 
 The operation may fail with:
 
 The operation may fail with:

-\begin{itemize}
-\item @HardwareFault@
-A physical I/O error has occurred.
+
+* 'HardwareFault'
+A physical I\/O error has occurred.

 @[EIO]@
 @[EIO]@

-\item @InvalidArgument@
+
+* 'InvalidArgument'

 The operand is not a valid directory name.
 @[ENAMETOOLONG, ELOOP]@
 The operand is not a valid directory name.
 @[ENAMETOOLONG, ELOOP]@

-\item @isDoesNotExistError@ / @NoSuchThing@
+
+* 'isDoesNotExistError' \/ 'NoSuchThing'

 The directory does not exist.
 @[ENOENT, ENOTDIR]@
 The directory does not exist.
 @[ENOENT, ENOTDIR]@

-\item @isPermissionError@ / @PermissionDenied@
+
+* 'isPermissionError' \/ 'PermissionDenied'

 The process has insufficient privileges to perform the operation.
 @[EACCES]@
 The process has insufficient privileges to perform the operation.
 @[EACCES]@

-\item @UnsupportedOperation@
+
+* 'UnsupportedOperation'

 The operating system has no notion of current directory, or the
 current directory cannot be dynamically changed.
 The operating system has no notion of current directory, or the
 current directory cannot be dynamically changed.

-\item @InappropriateType@
+
+* 'InappropriateType'

 The path refers to an existing non-directory object.
 @[ENOTDIR]@
 The path refers to an existing non-directory object.
 @[ENOTDIR]@

-\end{itemize}
+

 -}
 
 setCurrentDirectory :: FilePath -> IO ()
 setCurrentDirectory path = do
 -}
 
 setCurrentDirectory :: FilePath -> IO ()
 setCurrentDirectory path = do

+  modifyIOError (`ioeSetFileName` path) $

     withCString path $ \s -> 
        throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
        -- ToDo: add path to error
 
     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.) 
+getHomeDirectory :: IO FilePath
+getHomeDirectory =
+#ifdef mingw32_TARGET_OS
+  allocaBytes long_path_size $ \pPath -> do
+     r <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
+     if (r < 0)
+       then c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
+       else return 0
+     peekCString pPath
+#else
+  getEnv "HOME"
+#endif
+
+getAppUserDataDirectory :: String -> IO FilePath
+getAppUserDataDirectory appName = do
+#ifdef mingw32_TARGET_OS
+  allocaBytes long_path_size $ \pPath -> do
+     r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
+     s <- peekCString pPath
+     return (s++'\\':appName)
+#else
+  path <- getEnv "HOME"
+  return (path++'/':'.':appName)
+#endif
+
+#ifdef mingw32_TARGET_OS
+foreign import stdcall unsafe "SHGetFolderPath" 
+            c_SHGetFolderPath :: Ptr () 
+                              -> CInt 
+                              -> Ptr () 
+                              -> CInt 
+                              -> CString 
+                              -> IO CInt
+foreign import ccall unsafe "__hscore_CSIDL_PROFILE" csidl_PROFILE :: Int
+foreign import ccall unsafe "__hscore_CSIDL_APPDATA" csidl_APPDATA :: Int
+foreign import ccall unsafe "__hscore_CSIDL_WINDOWS" csidl_WINDOWS :: Int
+#endif
+
+{- |The operation 'doesDirectoryExist' returns 'True' if the argument file
+exists and is a directory, and 'False' otherwise.

 -}
 
 doesDirectoryExist :: FilePath -> IO Bool
 doesDirectoryExist name = 
  catch
 -}
 
 doesDirectoryExist :: FilePath -> IO Bool
 doesDirectoryExist name = 
  catch

-   (withFileStatus name $ \st -> isDirectory st)
+   (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)

    (\ _ -> return False)
 
    (\ _ -> 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
 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)
 
    (\ _ -> return False)
 

-getModificationTime :: FilePath -> IO ClockTime
-getModificationTime name =
- withFileStatus name $ \ st ->
- modificationTime st
+{- |The 'getModificationTime' operation returns the
+clock time at which the file or directory was last modified.

 
 

-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
-  is_dir <- isDirectory st
-  return (
-    Permissions {
-      readable   = read  == 0,
-      writable   = write == 0,
-      executable = not is_dir && exec == 0,
-      searchable = is_dir && exec == 0
-    }
-   )
+The operation may fail with:

 
 

-setPermissions :: FilePath -> Permissions -> IO ()
-setPermissions name (Permissions r w e s) = do
-    let
-     read  = if r      then s_IRUSR else emptyCMode
-     write = if w      then s_IWUSR else emptyCMode
-     exec  = if e || s then s_IXUSR else emptyCMode
+* 'isPermissionError' if the user is not permitted to access
+  the modification time; or
+
+* 'isDoesNotExistError' if the file or directory does not exist.

 
 

-     mode  = read `unionCMode` (write `unionCMode` exec)
+-}

 
 

-    withCString name $ \s ->
-      throwErrnoIfMinus1_ "setPermissions" $ c_chmod s mode
+getModificationTime :: FilePath -> IO ClockTime
+getModificationTime name =
+ 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 ->
     allocaBytes sizeof_stat $ \p ->

-      withCString name $ \s -> do
-        throwErrnoIfMinus1Retry_ "withFileStatus" (c_stat s p)
+      withCString (fileNameEndClean name) $ \s -> do
+        throwErrnoIfMinus1Retry_ loc (c_stat s p)

        f 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
     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
 modificationTime stat = do
     mtime <- st_mtime stat
        f p
 
 modificationTime :: Ptr CStat -> IO ClockTime
 modificationTime stat = do
     mtime <- st_mtime stat

-    return (TOD (toInteger (mtime :: CTime)) 0)
+    let realToInteger = round . realToFrac :: Real a => a -> Integer
+    return (TOD (realToInteger (mtime :: CTime)) 0)

     
 isDirectory :: Ptr CStat -> IO Bool
 isDirectory stat = do
   mode <- st_mode stat
   return (s_isdir mode)
 
     
 isDirectory :: Ptr CStat -> IO Bool
 isDirectory stat = do
   mode <- st_mode stat
   return (s_isdir mode)
 

-emptyCMode     :: CMode
-emptyCMode     = 0
-
-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
+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

 
 

-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
 
 foreign import ccall unsafe "__hscore_R_OK" r_OK :: CMode
 foreign import ccall unsafe "__hscore_W_OK" w_OK :: CMode

@@ -545,3 +735,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
 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