Fix a URL

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

diff --git a/System/Directory.hs b/System/Directory.hs
index caae903..42ed6af 100644 (file)
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -5,7 +5,7 @@
 -- 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.

@@ -14,38 +14,49 @@
 
 module System.Directory 
    ( 
 
 module System.Directory 
    ( 

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

 
     -- * Actions on directories
 
     -- * Actions on directories

-    , createDirectory          -- :: FilePath -> IO ()
+      createDirectory          -- :: FilePath -> IO ()
+    , createDirectoryIfMissing  -- :: Bool -> FilePath -> IO ()

     , removeDirectory          -- :: FilePath -> IO ()
     , removeDirectory          -- :: FilePath -> IO ()

+    , removeDirectoryRecursive  -- :: FilePath -> IO ()

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

+    -- * Pre-defined directories
+    , getHomeDirectory
+    , getAppUserDataDirectory
+    , getUserDocumentsDirectory
+    , getTemporaryDirectory
+

     -- * Actions on files
     , removeFile               -- :: FilePath -> IO ()
     , renameFile                -- :: FilePath -> FilePath -> IO ()
     -- * Actions on files
     , removeFile               -- :: FilePath -> IO ()
     , renameFile                -- :: FilePath -> FilePath -> IO ()

+    , copyFile                  -- :: FilePath -> FilePath -> IO ()
+    
+    , canonicalizePath
+    , makeRelativeToCurrentDirectory
+    , findExecutable

 
     -- * Existence tests
     , doesFileExist            -- :: FilePath -> IO Bool
     , doesDirectoryExist        -- :: FilePath -> IO Bool
 
 
     -- * Existence tests
     , 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 ()
 
     , getPermissions            -- :: FilePath -> IO Permissions
     , setPermissions           -- :: FilePath -> Permissions -> IO ()

@@ -55,32 +66,42 @@ module System.Directory
     , getModificationTime       -- :: FilePath -> IO ClockTime
    ) where
 
     , getModificationTime       -- :: FilePath -> IO ClockTime
    ) where
 

+import Prelude hiding ( catch )
+
+import System.Environment      ( getEnv )
+import System.FilePath
+import System.IO
+import System.IO.Error hiding ( catch, try )
+import Control.Monad           ( when, unless )
+import Control.Exception
+

 #ifdef __NHC__
 import Directory
 #ifdef __NHC__
 import Directory

-#elif defined(__HUGS__)
-import Hugs.Directory
-#else
+import System (system)
+#endif /* __NHC__ */

 
 

-import Prelude
+#ifdef __HUGS__
+import Hugs.Directory
+#endif /* __HUGS__ */

 
 

-import Control.Exception       ( bracket )
-import System.Posix.Types
-import System.Time             ( ClockTime(..) )
-import System.IO

 import Foreign
 import Foreign.C
 
 import Foreign
 import Foreign.C
 

+{-# CFILES cbits/directory.c #-}
+

 #ifdef __GLASGOW_HASKELL__
 #ifdef __GLASGOW_HASKELL__

-import GHC.Posix
+import System.Posix.Types
+import System.Posix.Internals
+import System.Time             ( ClockTime(..) )
+

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

-#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
 
 {- $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 
+<http://www.opengroup.org/onlinepubs/009695399/>), 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.
 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.

@@ -119,13 +140,48 @@ 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
 getPermissions :: FilePath -> IO Permissions
 getPermissions name = do
   withCString name $ \s -> do

+#ifdef mingw32_HOST_OS
+  -- stat() does a better job of guessing the permissions on Windows
+  -- than access() does.  e.g. for execute permission, it looks at the
+  -- filename extension :-)
+  --
+  -- I tried for a while to do this properly, using the Windows security API,
+  -- and eventually gave up.  getPermissions is a flawed API anyway. -- SimonM
+  allocaBytes sizeof_stat $ \ p_stat -> do
+  throwErrnoIfMinus1_ "getPermissions" $ c_stat s p_stat
+  mode <- st_mode p_stat
+  let read   = mode .&. s_IRUSR
+  let write  = mode .&. s_IWUSR
+  let exec   = mode .&. s_IXUSR
+  let is_dir = mode .&. s_IFDIR
+  return (
+    Permissions {
+      readable   = read  /= 0,
+      writable   = write /= 0,
+      executable = is_dir == 0 && exec /= 0,
+      searchable = is_dir /= 0 && exec /= 0
+    }
+   )
+#else

   read  <- c_access s r_OK
   write <- c_access s w_OK
   exec  <- c_access s x_OK
   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 {
   is_dir <- isDirectory st
   return (
     Permissions {

@@ -135,18 +191,46 @@ getPermissions name = do
       searchable = is_dir && exec == 0
     }
    )
       searchable = is_dir && exec == 0
     }
    )

+#endif

 
 

-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
+{- |The 'setPermissions' operation sets the
+permissions for the file or directory.

 
 

-     mode  = read `unionCMode` (write `unionCMode` exec)
+The operation may fail with:

 
 

-    withCString name $ \s ->
-      throwErrnoIfMinus1_ "setPermissions" $ c_chmod s mode
+* '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
+
+
+copyPermissions :: FilePath -> FilePath -> IO ()
+copyPermissions source dest = do
+  allocaBytes sizeof_stat $ \ p_stat -> do
+  withCString source $ \p_source -> do
+  withCString dest $ \p_dest -> do
+    throwErrnoIfMinus1_ "copyPermissions" $ c_stat p_source p_stat
+    mode <- st_mode p_stat
+    throwErrnoIfMinus1_ "copyPermissions" $ c_chmod p_dest mode

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

@@ -190,10 +274,35 @@ The path refers to an existing non-directory object.
 
 createDirectory :: FilePath -> IO ()
 createDirectory path = do
 
 createDirectory :: FilePath -> IO ()
 createDirectory path = do

+  modifyIOError (`ioeSetFileName` path) $

     withCString path $ \s -> do
       throwErrnoIfMinus1Retry_ "createDirectory" $
        mkdir s 0o777
 
     withCString path $ \s -> do
       throwErrnoIfMinus1Retry_ "createDirectory" $
        mkdir s 0o777
 

+#else /* !__GLASGOW_HASKELL__ */
+
+copyPermissions :: FilePath -> FilePath -> IO ()
+copyPermissions fromFPath toFPath
+  = getPermissions fromFPath >>= setPermissions toFPath
+
+#endif
+
+-- | @'createDirectoryIfMissing' parents dir@ creates a new directory 
+-- @dir@ if it doesn\'t exist. If the first argument is 'True'
+-- the function will also create all parent directories if they are missing.
+createDirectoryIfMissing :: Bool     -- ^ Create its parents too?
+                        -> FilePath -- ^ The path to the directory you want to make
+                        -> IO ()
+createDirectoryIfMissing parents file = do
+  b <- doesDirectoryExist file
+  case (b,parents, file) of
+    (_,     _, "") -> return ()
+    (True,  _,  _) -> return ()
+    (_,  True,  _) -> mapM_ (createDirectoryIfMissing False) $ mkParents file
+    (_, False,  _) -> createDirectory file
+ where mkParents = scanl1 (</>) . splitDirectories . normalise
+
+#if __GLASGOW_HASKELL__

 {- | @'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
 {- | @'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

@@ -213,7 +322,7 @@ EIO
 The operand is not a valid directory name.
 [ENAMETOOLONG, ELOOP]
 
 The operand is not a valid directory name.
 [ENAMETOOLONG, ELOOP]
 

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

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

@@ -237,10 +346,31 @@ The operand refers to an existing non-directory object.
 
 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)

+#endif

 
 

-{- |@'removefile' file@ removes the directory entry for an existing file
+-- | @'removeDirectoryRecursive' dir@  removes an existing directory /dir/
+-- together with its content and all subdirectories. Be careful, 
+-- if the directory contains symlinks, the function will follow them.
+removeDirectoryRecursive :: FilePath -> IO ()
+removeDirectoryRecursive startLoc = do
+  cont <- getDirectoryContents startLoc
+  sequence_ [rm (startLoc </> x) | x <- cont, x /= "." && x /= ".."]
+  removeDirectory startLoc
+  where
+    rm :: FilePath -> IO ()
+    rm f = do temp <- try (removeFile f)
+              case temp of
+                Left e  -> do isDir <- doesDirectoryExist f
+                              -- If f is not a directory, re-throw the error
+                              unless isDir $ throw e
+                              removeDirectoryRecursive f
+                Right _ -> return ()
+
+#if __GLASGOW_HASKELL__
+{- |'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
 /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

@@ -250,13 +380,13 @@ The operation may fail with:
 
 * 'HardwareFault'
 A physical I\/O error has occurred.
 
 * 'HardwareFault'
 A physical I\/O error has occurred.

-'EIO'
+@[EIO]@

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

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

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

@@ -276,6 +406,7 @@ The operand refers to an existing directory.
 
 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)
 

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

@@ -327,7 +461,7 @@ Either path refers to an existing non-directory object.
 
 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"

@@ -384,7 +518,7 @@ Either path refers to an existing directory.
 
 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"

@@ -395,6 +529,127 @@ renameFile opath npath =
       withCString npath $ \s2 ->
          throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
 
       withCString npath $ \s2 ->
          throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
 

+#endif /* __GLASGOW_HASKELL__ */
+
+{- |@'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.  The permissions of /old/ are
+copied to /new/, if possible.
+-}
+
+copyFile :: FilePath -> FilePath -> IO ()
+#ifdef __NHC__
+copyFile fromFPath toFPath =
+    do readFile fromFPath >>= writeFile toFPath
+       try (copyPermissions fromFPath toFPath)
+       return ()
+#else
+copyFile fromFPath toFPath =
+    copy `catch` (\e -> case e of
+                        IOException e ->
+                            throw $ IOException $ ioeSetLocation e "copyFile"
+                        _ -> throw e)
+    where copy = bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
+                 bracketOnError openTmp cleanTmp $ \(tmpFPath, hTmp) ->
+                 do allocaBytes bufferSize $ copyContents hFrom hTmp
+                    hClose hTmp
+                    try (copyPermissions fromFPath tmpFPath)
+                    renameFile tmpFPath toFPath
+          openTmp = openBinaryTempFile (takeDirectory toFPath) ".copyFile.tmp"
+          cleanTmp (tmpFPath, hTmp) = do try $ hClose hTmp
+                                         try $ removeFile tmpFPath
+          bufferSize = 1024
+
+          copyContents hFrom hTo buffer = do
+                  count <- hGetBuf hFrom buffer bufferSize
+                  when (count > 0) $ do
+                          hPutBuf hTo buffer count
+                          copyContents hFrom hTo buffer
+#endif
+
+-- | Given path referring to a file or directory, returns a
+-- canonicalized path, with the intent that two paths referring
+-- to the same file\/directory will map to the same canonicalized
+-- path. Note that it is impossible to guarantee that the
+-- implication (same file\/dir \<=\> same canonicalizedPath) holds
+-- in either direction: this function can make only a best-effort
+-- attempt.
+canonicalizePath :: FilePath -> IO FilePath
+canonicalizePath fpath =
+  withCString fpath $ \pInPath ->
+  allocaBytes long_path_size $ \pOutPath ->
+#if defined(mingw32_HOST_OS)
+  alloca $ \ppFilePart ->
+    do c_GetFullPathName pInPath (fromIntegral long_path_size) pOutPath ppFilePart
+#else
+    do c_realpath pInPath pOutPath
+#endif
+       peekCString pOutPath
+
+#if defined(mingw32_HOST_OS)
+foreign import stdcall unsafe "GetFullPathNameA"
+            c_GetFullPathName :: CString
+                              -> CInt
+                              -> CString
+                              -> Ptr CString
+                              -> IO CInt
+#else
+foreign import ccall unsafe "realpath"
+                   c_realpath :: CString
+                              -> CString
+                              -> IO CString
+#endif
+
+-- | 'makeRelative' the current directory.
+makeRelativeToCurrentDirectory :: FilePath -> IO FilePath
+makeRelativeToCurrentDirectory x = do
+    cur <- getCurrentDirectory
+    return $ makeRelative cur x
+
+-- | Given an executable file name, searches for such file
+-- in the directories listed in system PATH. The returned value 
+-- is the path to the found executable or Nothing if there isn't
+-- such executable. For example (findExecutable \"ghc\")
+-- gives you the path to GHC.
+findExecutable :: String -> IO (Maybe FilePath)
+findExecutable binary =
+#if defined(mingw32_HOST_OS)
+  withCString binary $ \c_binary ->
+  withCString ('.':exeExtension) $ \c_ext ->
+  allocaBytes long_path_size $ \pOutPath ->
+  alloca $ \ppFilePart -> do
+    res <- c_SearchPath nullPtr c_binary c_ext (fromIntegral long_path_size) pOutPath ppFilePart
+    if res > 0 && res < fromIntegral long_path_size
+      then do fpath <- peekCString pOutPath
+              return (Just fpath)
+      else return Nothing
+
+foreign import stdcall unsafe "SearchPathA"
+            c_SearchPath :: CString
+                         -> CString
+                         -> CString
+                         -> CInt
+                         -> CString
+                         -> Ptr CString
+                         -> IO CInt
+#else
+ do
+  path <- getEnv "PATH"
+  search (splitSearchPath path)
+  where
+    fileName = binary <.> exeExtension
+
+    search :: [FilePath] -> IO (Maybe FilePath)
+    search [] = return Nothing
+    search (d:ds) = do
+        let path = d </> fileName
+        b <- doesFileExist path
+        if b then return (Just path)
+             else search ds
+#endif
+
+
+#ifdef __GLASGOW_HASKELL__

 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
 in /dir/. 
 
 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
 in /dir/. 
 

@@ -428,6 +683,7 @@ The path refers to an existing non-directory object.
 
 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 -> 

@@ -488,8 +744,8 @@ The operating system has no notion of current directory.
 
 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 

@@ -537,51 +793,69 @@ The path refers to an existing non-directory object.
 
 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.) 
+{- |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)
 

+{- |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 =
 getModificationTime :: FilePath -> IO ClockTime
 getModificationTime name =

- withFileStatus name $ \ st ->
+ withFileStatus "getModificationTime" name $ \ st ->

  modificationTime 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
     allocaBytes sizeof_stat $ \p ->
       withCString (fileNameEndClean name) $ \s -> do

-        throwErrnoIfMinus1Retry_ "withFileStatus" (c_stat s p)
+        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
     
 isDirectory :: Ptr CStat -> IO Bool
 isDirectory stat = do

@@ -589,43 +863,198 @@ isDirectory stat = do
   return (s_isdir mode)
 
 fileNameEndClean :: String -> String
   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
+fileNameEndClean name = if isDrive name then addTrailingPathSeparator name
+                                        else dropTrailingPathSeparator name

 
 

-emptyCMode     :: CMode
-emptyCMode     = 0
+foreign import ccall unsafe "__hscore_R_OK" r_OK :: CInt
+foreign import ccall unsafe "__hscore_W_OK" w_OK :: CInt
+foreign import ccall unsafe "__hscore_X_OK" x_OK :: CInt

 
 

-unionCMode     :: CMode -> CMode -> CMode
-unionCMode     = (+)
+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_IFDIR" s_IFDIR :: CMode

 
 

+foreign import ccall unsafe "__hscore_long_path_size"
+  long_path_size :: Int

 
 

-foreign import ccall unsafe "__hscore_path_max"
-  path_max :: Int
+#else
+long_path_size :: Int
+long_path_size = 2048  --  // guess?

 
 

-foreign import ccall unsafe "__hscore_readdir"
-  readdir  :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
+#endif /* __GLASGOW_HASKELL__ */

 
 

-foreign import ccall unsafe "__hscore_free_dirent"
-  freeDirEnt  :: Ptr CDirent -> IO ()
+{- | Returns the current user's home directory.

 
 

-foreign import ccall unsafe "__hscore_end_of_dir"
-  end_of_dir :: CInt
+The directory returned is expected to be writable by the current user,
+but note that it isn't generally considered good practice to store
+application-specific data here; use 'getAppUserDataDirectory'
+instead.

 
 

-foreign import ccall unsafe "__hscore_d_name"
-  d_name :: Ptr CDirent -> IO CString
+On Unix, 'getHomeDirectory' returns the value of the @HOME@
+environment variable.  On Windows, the system is queried for a
+suitable path; a typical path might be 
+@C:/Documents And Settings/user@.

 
 

-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
+The operation may fail with:

 
 

-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
+* 'UnsupportedOperation'
+The operating system has no notion of home directory.

 
 

+* 'isDoesNotExistError'
+The home directory for the current user does not exist, or
+cannot be found.
+-}
+getHomeDirectory :: IO FilePath
+getHomeDirectory =
+#if defined(mingw32_HOST_OS)
+  allocaBytes long_path_size $ \pPath -> do
+     r <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
+     if (r < 0)
+       then do
+          r <- c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
+         when (r < 0) (raiseUnsupported "System.Directory.getHomeDirectory")
+       else return ()
+     peekCString pPath
+#else
+  getEnv "HOME"

 #endif
 #endif

+
+{- | Returns the pathname of a directory in which application-specific
+data for the current user can be stored.  The result of
+'getAppUserDataDirectory' for a given application is specific to
+the current user.
+
+The argument should be the name of the application, which will be used
+to construct the pathname (so avoid using unusual characters that
+might result in an invalid pathname).
+
+Note: the directory may not actually exist, and may need to be created
+first.  It is expected that the parent directory exists and is
+writable.
+
+On Unix, this function returns @$HOME\/.appName@.  On Windows, a
+typical path might be 
+
+> C:/Documents And Settings/user/Application Data/appName
+
+The operation may fail with:
+
+* 'UnsupportedOperation'
+The operating system has no notion of application-specific data directory.
+
+* 'isDoesNotExistError'
+The home directory for the current user does not exist, or
+cannot be found.
+-}
+getAppUserDataDirectory :: String -> IO FilePath
+getAppUserDataDirectory appName = do
+#if defined(mingw32_HOST_OS)
+  allocaBytes long_path_size $ \pPath -> do
+     r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
+     when (r<0) (raiseUnsupported "System.Directory.getAppUserDataDirectory")
+     s <- peekCString pPath
+     return (s++'\\':appName)
+#else
+  path <- getEnv "HOME"
+  return (path++'/':'.':appName)
+#endif
+
+{- | Returns the current user's document directory.
+
+The directory returned is expected to be writable by the current user,
+but note that it isn't generally considered good practice to store
+application-specific data here; use 'getAppUserDataDirectory'
+instead.
+
+On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@
+environment variable.  On Windows, the system is queried for a
+suitable path; a typical path might be 
+@C:\/Documents and Settings\/user\/My Documents@.
+
+The operation may fail with:
+
+* 'UnsupportedOperation'
+The operating system has no notion of document directory.
+
+* 'isDoesNotExistError'
+The document directory for the current user does not exist, or
+cannot be found.
+-}
+getUserDocumentsDirectory :: IO FilePath
+getUserDocumentsDirectory = do
+#if defined(mingw32_HOST_OS)
+  allocaBytes long_path_size $ \pPath -> do
+     r <- c_SHGetFolderPath nullPtr csidl_PERSONAL nullPtr 0 pPath
+     when (r<0) (raiseUnsupported "System.Directory.getUserDocumentsDirectory")
+     peekCString pPath
+#else
+  getEnv "HOME"
+#endif
+
+{- | Returns the current directory for temporary files.
+
+On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@
+environment variable or \"\/tmp\" if the variable isn\'t defined.
+On Windows, the function checks for the existence of environment variables in 
+the following order and uses the first path found:
+
+* 
+TMP environment variable. 
+
+*
+TEMP environment variable. 
+
+*
+USERPROFILE environment variable. 
+
+*
+The Windows directory
+
+The operation may fail with:
+
+* 'UnsupportedOperation'
+The operating system has no notion of temporary directory.
+
+The function doesn\'t verify whether the path exists.
+-}
+getTemporaryDirectory :: IO FilePath
+getTemporaryDirectory = do
+#if defined(mingw32_HOST_OS)
+  allocaBytes long_path_size $ \pPath -> do
+     r <- c_GetTempPath (fromIntegral long_path_size) pPath
+     peekCString pPath
+#else
+  catch (getEnv "TMPDIR") (\ex -> return "/tmp")
+#endif
+
+#if defined(mingw32_HOST_OS)
+foreign import ccall unsafe "__hscore_getFolderPath"
+            c_SHGetFolderPath :: Ptr () 
+                              -> CInt 
+                              -> Ptr () 
+                              -> CInt 
+                              -> CString 
+                              -> IO CInt
+foreign import ccall unsafe "__hscore_CSIDL_PROFILE"  csidl_PROFILE  :: CInt
+foreign import ccall unsafe "__hscore_CSIDL_APPDATA"  csidl_APPDATA  :: CInt
+foreign import ccall unsafe "__hscore_CSIDL_WINDOWS"  csidl_WINDOWS  :: CInt
+foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt
+
+foreign import stdcall unsafe "GetTempPathA" c_GetTempPath :: CInt -> CString -> IO CInt
+
+raiseUnsupported loc = 
+   ioException (IOError Nothing UnsupportedOperation loc "unsupported operation" Nothing)
+
+#endif
+
+-- ToDo: This should be determined via autoconf (AC_EXEEXT)
+-- | Extension for executable files
+-- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
+exeExtension :: String
+#ifdef mingw32_HOST_OS
+exeExtension = "exe"
+#else
+exeExtension = ""
+#endif
+