+{-# OPTIONS_GHC -w #-}
+-- XXX We get some warnings on Windows
+
-----------------------------------------------------------------------------
---
+-- |
-- Module : System.Directory
-- Copyright : (c) The University of Glasgow 2001
--- License : BSD-style (see the file libraries/core/LICENSE)
+-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : libraries@haskell.org
--- Stability : provisional
+-- Stability : stable
-- Portability : portable
--
--- $Id: Directory.hs,v 1.1 2002/02/05 17:32:27 simonmar Exp $
---
-- 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
(
- Permissions(
- Permissions,
- readable, -- :: Permissions -> Bool
- writable, -- :: Permissions -> Bool
- executable, -- :: Permissions -> Bool
- searchable -- :: Permissions -> Bool
- ),
-
- , createDirectory -- :: FilePath -> IO ()
+ -- $intro
+
+ -- * Actions on directories
+ createDirectory -- :: FilePath -> IO ()
+#ifndef __NHC__
+ , createDirectoryIfMissing -- :: Bool -> FilePath -> IO ()
+#endif
, removeDirectory -- :: FilePath -> IO ()
+ , removeDirectoryRecursive -- :: 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 ()
+ , copyFile -- :: FilePath -> FilePath -> IO ()
+
+ , canonicalizePath
+ , makeRelativeToCurrentDirectory
+ , findExecutable
+ -- * Existence tests
, doesFileExist -- :: FilePath -> IO Bool
, doesDirectoryExist -- :: FilePath -> IO Bool
+ -- * Permissions
+
+ -- $permissions
+
+ , Permissions
+ , readable -- :: Permissions -> Bool
+ , writable -- :: Permissions -> Bool
+ , executable -- :: Permissions -> Bool
+ , searchable -- :: Permissions -> Bool
+ , setOwnerReadable
+ , setOwnerWritable
+ , setOwnerExecutable
+ , setOwnerSearchable
+
, getPermissions -- :: FilePath -> IO Permissions
, setPermissions -- :: FilePath -> Permissions -> IO ()
+ , copyPermissions
+
+ -- * Timestamps
, getModificationTime -- :: FilePath -> IO ClockTime
) where
-import Prelude
+import Prelude hiding ( catch )
+import qualified Prelude
-import System.Time ( ClockTime(..) )
+import Control.Monad (guard)
+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.Base
+
+#ifdef __NHC__
+import Directory -- hiding ( getDirectoryContents
+ -- , doesDirectoryExist, doesFileExist
+ -- , getModificationTime )
+import System (system)
+#endif /* __NHC__ */
+
+#ifdef __HUGS__
+import Hugs.Directory
+#endif /* __HUGS__ */
+
import Foreign
import Foreign.C
+{-# CFILES cbits/directory.c #-}
+
+import System.Time ( ClockTime(..) )
+
#ifdef __GLASGOW_HASKELL__
-import GHC.Posix
+
+#if __GLASGOW_HASKELL__ >= 611
+import GHC.IO.Exception ( IOException(..), IOErrorType(..), ioException )
+#else
import GHC.IOBase ( IOException(..), IOErrorType(..), ioException )
#endif
+#ifdef mingw32_HOST_OS
+import System.Posix.Types
+import System.Posix.Internals
+import qualified System.Win32 as Win32
+#else
+import qualified System.Posix as Posix
+#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/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.
+
+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
--- 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 {
executable, searchable :: Bool
} deriving (Eq, Ord, Read, Show)
+setOwnerReadable :: Bool -> Permissions -> Permissions
+setOwnerReadable b p = p { readable = b }
+
+setOwnerWritable :: Bool -> Permissions -> Permissions
+setOwnerWritable b p = p { writable = b }
+
+setOwnerExecutable :: Bool -> Permissions -> Permissions
+setOwnerExecutable b p = p { executable = b }
+
+setOwnerSearchable :: Bool -> Permissions -> Permissions
+setOwnerSearchable b p = p { searchable = b }
+
+{- |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
+#ifdef mingw32_HOST_OS
+ withFilePath name $ \s -> do
+ -- 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 usr_read = mode .&. s_IRUSR
+ let usr_write = mode .&. s_IWUSR
+ let usr_exec = mode .&. s_IXUSR
+ let is_dir = mode .&. s_IFDIR
+ return (
+ Permissions {
+ readable = usr_read /= 0,
+ writable = usr_write /= 0,
+ executable = is_dir == 0 && usr_exec /= 0,
+ searchable = is_dir /= 0 && usr_exec /= 0
+ }
+ )
+#else
+ read_ok <- Posix.fileAccess name True False False
+ write_ok <- Posix.fileAccess name False True False
+ exec_ok <- Posix.fileAccess name False False True
+ stat <- Posix.getFileStatus name
+ let is_dir = Posix.isDirectory stat
+ return (
+ Permissions {
+ readable = read_ok,
+ writable = write_ok,
+ executable = not is_dir && exec_ok,
+ searchable = is_dir && exec_ok
+ }
+ )
+#endif
+
+{- |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
+#ifdef mingw32_HOST_OS
+ allocaBytes sizeof_stat $ \ p_stat -> do
+ withFilePath 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_wchmod p_name mode3
+ where
+ modifyBit :: Bool -> CMode -> CMode -> CMode
+ modifyBit False m b = m .&. (complement b)
+ modifyBit True m b = m .|. b
+#else
+ stat <- Posix.getFileStatus name
+ let mode = Posix.fileMode stat
+ let mode1 = modifyBit r mode Posix.ownerReadMode
+ let mode2 = modifyBit w mode1 Posix.ownerWriteMode
+ let mode3 = modifyBit (e || s) mode2 Posix.ownerExecuteMode
+ Posix.setFileMode name mode3
+ where
+ modifyBit :: Bool -> Posix.FileMode -> Posix.FileMode -> Posix.FileMode
+ modifyBit False m b = m .&. (complement b)
+ modifyBit True m b = m .|. b
+#endif
+
+#ifdef mingw32_HOST_OS
+foreign import ccall unsafe "_wchmod"
+ c_wchmod :: CWString -> CMode -> IO CInt
+#endif
+
+copyPermissions :: FilePath -> FilePath -> IO ()
+copyPermissions source dest = do
+#ifdef mingw32_HOST_OS
+ allocaBytes sizeof_stat $ \ p_stat -> do
+ withFilePath source $ \p_source -> do
+ withFilePath dest $ \p_dest -> do
+ throwErrnoIfMinus1_ "copyPermissions" $ c_stat p_source p_stat
+ mode <- st_mode p_stat
+ throwErrnoIfMinus1_ "copyPermissions" $ c_wchmod p_dest mode
+#else
+ stat <- Posix.getFileStatus source
+ let mode = Posix.fileMode stat
+ Posix.setFileMode dest mode
+#endif
+
-----------------------------------------------------------------------------
-- 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]@
-\item @isAlreadyExistsError@ / @AlreadyExists@
+
+* 'isAlreadyExistsError' \/ 'AlreadyExists'
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]@
-\item @NoSuchThing@
+
+* 'NoSuchThing'
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]@
-\item @InappropriateType@
+
+* 'InappropriateType'
The path refers to an existing non-directory object.
@[EEXIST]@
-\end{itemize}
+
-}
createDirectory :: FilePath -> IO ()
createDirectory path = do
- withCString path $ \s -> do
- throwErrnoIfMinus1Retry_ "createDirectory" $
- mkdir s 0o777
+#ifdef mingw32_HOST_OS
+ Win32.createDirectory path Nothing
+#else
+ Posix.createDirectory path 0o777
+#endif
+
+#else /* !__GLASGOW_HASKELL__ */
+
+copyPermissions :: FilePath -> FilePath -> IO ()
+copyPermissions fromFPath toFPath
+ = getPermissions fromFPath >>= setPermissions toFPath
-{-
-@removeDirectory dir@ removes an existing directory {\em dir}. The
+#endif
+
+#ifndef __NHC__
+-- | @'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 create_parents path0
+ | create_parents = createDirs (parents path0)
+ | otherwise = createDirs (take 1 (parents path0))
+ where
+ parents = reverse . scanl1 (</>) . splitDirectories . normalise
+
+ createDirs [] = return ()
+ createDirs (dir:[]) = createDir dir throw
+ createDirs (dir:dirs) =
+ createDir dir $ \_ -> do
+ createDirs dirs
+ createDir dir throw
+
+ createDir :: FilePath -> (IOException -> IO ()) -> IO ()
+ createDir dir notExistHandler = do
+ r <- try $ createDirectory dir
+ case (r :: Either IOException ()) of
+ Right () -> return ()
+ Left e
+ | isDoesNotExistError e -> notExistHandler e
+ -- createDirectory (and indeed POSIX mkdir) does not distinguish
+ -- between a dir already existing and a file already existing. So we
+ -- check for it here. Unfortunately there is a slight race condition
+ -- here, but we think it is benign. It could report an exeption in
+ -- the case that the dir did exist but another process deletes the
+ -- directory and creates a file in its place before we can check
+ -- that the directory did indeed exist.
+ | isAlreadyExistsError e -> (do
+#ifdef mingw32_HOST_OS
+ withFileStatus "createDirectoryIfMissing" dir $ \st -> do
+ isDir <- isDirectory st
+ if isDir then return ()
+ else throw e
+#else
+ stat <- Posix.getFileStatus dir
+ if Posix.isDirectory stat
+ then return ()
+ else throw e
+#endif
+ ) `catch` ((\_ -> return ()) :: IOException -> IO ())
+ | otherwise -> throw e
+#endif /* !__NHC__ */
+
+#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
be empty, or may not be in use by other processes). It is not legal
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.
-@[ENAMETOOLONG, ELOOP]@
-\item @isDoesNotExist@ / @NoSuchThing@
+[ENAMETOOLONG, ELOOP]
+
+* 'isDoesNotExistError' \/ 'NoSuchThing'
The directory does not exist.
@[ENOENT, ENOTDIR]@
-\item @isPermissionError@ / @PermissionDenied@
+
+* 'isPermissionError' \/ 'PermissionDenied'
The process has insufficient privileges to perform the operation.
@[EROFS, EACCES, EPERM]@
-\item @UnsatisfiedConstraints@
+
+* 'UnsatisfiedConstraints'
Implementation-dependent constraints are not satisfied.
@[EBUSY, ENOTEMPTY, EEXIST]@
-\item @UnsupportedOperation@
+
+* 'UnsupportedOperation'
The implementation does not support removal in this situation.
@[EINVAL]@
-\item @InappropriateType@
+
+* 'InappropriateType'
The operand refers to an existing non-directory object.
@[ENOTDIR]@
-\end{itemize}
+
-}
removeDirectory :: FilePath -> IO ()
-removeDirectory path = do
- withCString path $ \s ->
- throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
+removeDirectory path =
+#ifdef mingw32_HOST_OS
+ Win32.removeDirectory path
+#else
+ Posix.removeDirectory path
+#endif
-{-
-@Removefile file@ removes the directory entry for an existing file
-{\em file}, where {\em file} is not itself a directory. The
+#endif
+
+-- | @'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 :: SomeException)
+ 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
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]@
-\item @InvalidArgument@
+
+* 'InvalidArgument'
The operand is not a valid file name.
@[ENAMETOOLONG, ELOOP]@
-\item @isDoesNotExist@ / @NoSuchThing@
+
+* 'isDoesNotExistError' \/ 'NoSuchThing'
The file does not exist.
@[ENOENT, ENOTDIR]@
-\item @isPermissionError@ / @PermissionDenied@
+
+* 'isPermissionError' \/ 'PermissionDenied'
The process has insufficient privileges to perform the operation.
@[EROFS, EACCES, EPERM]@
-\item @UnsatisfiedConstraints@
+
+* 'UnsatisfiedConstraints'
Implementation-dependent constraints are not satisfied.
@[EBUSY]@
-\item @InappropriateType@
+
+* 'InappropriateType'
The operand refers to an existing directory.
@[EPERM, EINVAL]@
-\end{itemize}
+
-}
removeFile :: FilePath -> IO ()
-removeFile path = do
- 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
+removeFile path =
+#if mingw32_HOST_OS
+ Win32.deleteFile path
+#else
+ Posix.removeLink path
+#endif
+
+{- |@'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.
+On Win32 platforms, @renameDirectory@ fails if the /new/ directory already
+exists.
+
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]@
-\item @InvalidArgument@
+
+* 'InvalidArgument'
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]@
-\item @isPermissionError@ / @PermissionDenied@
+
+* 'isPermissionError' \/ 'PermissionDenied'
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]@
-\item @UnsatisfiedConstraints@
+
+* 'UnsatisfiedConstraints'
Implementation-dependent constraints are not satisfied.
@[EBUSY, ENOTEMPTY, EEXIST]@
-\item @UnsupportedOperation@
+
+* 'UnsupportedOperation'
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]@
-\end{itemize}
+
-}
renameDirectory :: FilePath -> FilePath -> IO ()
-renameDirectory opath npath =
- withFileStatus opath $ \st -> do
+renameDirectory opath npath = do
+ -- XXX this test isn't performed atomically with the following rename
+#ifdef mingw32_HOST_OS
+ -- ToDo: use Win32 API
+ withFileStatus "renameDirectory" opath $ \st -> do
is_dir <- isDirectory st
+#else
+ stat <- Posix.getFileStatus opath
+ let is_dir = Posix.fileMode stat .&. Posix.directoryMode /= 0
+#endif
if (not is_dir)
- then ioException (IOError Nothing InappropriateType "renameDirectory"
- ("not a directory") (Just opath))
+ then ioException (ioeSetErrorString
+ (mkIOError InappropriateType "renameDirectory" Nothing (Just opath))
+ "not a directory")
else do
+#ifdef mingw32_HOST_OS
+ Win32.moveFileEx opath npath Win32.mOVEFILE_REPLACE_EXISTING
+#else
+ Posix.rename opath npath
+#endif
- withCString opath $ \s1 ->
- 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:
-\begin{itemize}
-\item @HardwareFault@
-A physical I/O error has occurred.
+
+* 'HardwareFault'
+A physical I\/O error has occurred.
@[EIO]@
-\item @InvalidArgument@
+
+* 'InvalidArgument'
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]@
-\item @isPermissionError@ / @PermissionDenied@
+
+* 'isPermissionError' \/ 'PermissionDenied'
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]@
-\item @UnsatisfiedConstraints@
+
+* 'UnsatisfiedConstraints'
Implementation-dependent constraints are not satisfied.
@[EBUSY]@
-\item @UnsupportedOperation@
+
+* 'UnsupportedOperation'
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]@
-\end{itemize}
+
-}
renameFile :: FilePath -> FilePath -> IO ()
-renameFile opath npath =
- withFileOrSymlinkStatus opath $ \st -> do
+renameFile opath npath = do
+ -- XXX this test isn't performed atomically with the following rename
+#ifdef mingw32_HOST_OS
+ -- ToDo: use Win32 API
+ withFileOrSymlinkStatus "renameFile" opath $ \st -> do
is_dir <- isDirectory st
+#else
+ stat <- Posix.getSymbolicLinkStatus opath
+ let is_dir = Posix.isDirectory stat
+#endif
if is_dir
- then ioException (IOError Nothing InappropriateType "renameFile"
- "is a directory" (Just opath))
+ then ioException (ioeSetErrorString
+ (mkIOError InappropriateType "renameFile" Nothing (Just opath))
+ "is a directory")
else do
+#ifdef mingw32_HOST_OS
+ Win32.moveFileEx opath npath Win32.mOVEFILE_REPLACE_EXISTING
+#else
+ Posix.rename opath npath
+#endif
+
+#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
+ Prelude.catch (copyPermissions fromFPath toFPath)
+ (\_ -> return ())
+#else
+copyFile fromFPath toFPath =
+ copy `Prelude.catch` (\exc -> throw $ ioeSetLocation exc "copyFile")
+ where copy = bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
+ bracketOnError openTmp cleanTmp $ \(tmpFPath, hTmp) ->
+ do allocaBytes bufferSize $ copyContents hFrom hTmp
+ hClose hTmp
+ ignoreIOExceptions $ copyPermissions fromFPath tmpFPath
+ renameFile tmpFPath toFPath
+ openTmp = openBinaryTempFile (takeDirectory toFPath) ".copyFile.tmp"
+ cleanTmp (tmpFPath, hTmp)
+ = do ignoreIOExceptions $ hClose hTmp
+ ignoreIOExceptions $ 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
+
+ ignoreIOExceptions io = io `catch` ioExceptionIgnorer
+ ioExceptionIgnorer :: IOException -> IO ()
+ ioExceptionIgnorer _ = return ()
+#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 =
+#if defined(mingw32_HOST_OS)
+ do path <- Win32.getFullPathName fpath
+#else
+ withCString fpath $ \pInPath ->
+ allocaBytes long_path_size $ \pOutPath ->
+ do throwErrnoPathIfNull "canonicalizePath" fpath $ c_realpath pInPath pOutPath
+ path <- peekCString pOutPath
+#endif
+ return (normalise path)
+ -- normalise does more stuff, like upper-casing the drive letter
+
+#if !defined(mingw32_HOST_OS)
+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 an executable with the given
+-- name was not found. For example (findExecutable \"ghc\") gives you
+-- the path to GHC.
+--
+-- The path returned by 'findExecutable' corresponds to the
+-- program that would be executed by 'System.Process.createProcess'
+-- when passed the same string (as a RawCommand, not a ShellCommand).
+--
+-- On Windows, 'findExecutable' calls the Win32 function 'SearchPath',
+-- which may search other places before checking the directories in
+-- @PATH@. Where it actually searches depends on registry settings,
+-- but notably includes the directory containing the current
+-- executable. See
+-- <http://msdn.microsoft.com/en-us/library/aa365527.aspx> for more
+-- details.
+--
+findExecutable :: String -> IO (Maybe FilePath)
+findExecutable binary =
+#if defined(mingw32_HOST_OS)
+ Win32.searchPath Nothing binary ('.':exeExtension)
+#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
- withCString opath $ \s1 ->
- withCString npath $ \s2 ->
- throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
-{-
-@getDirectoryContents dir@ returns a list of {\em all} entries
-in {\em dir}.
+#ifdef __GLASGOW_HASKELL__
+{- |@'getDirectoryContents' dir@ returns a list of /all/ entries
+in /dir/.
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]@
-\item @InvalidArgument@
+
+* 'InvalidArgument'
The operand is not a valid directory name.
@[ENAMETOOLONG, ELOOP]@
-\item @isDoesNotExistError@ / @NoSuchThing@
+
+* 'isDoesNotExistError' \/ 'NoSuchThing'
The directory does not exist.
@[ENOENT, ENOTDIR]@
-\item @isPermissionError@ / @PermissionDenied@
+
+* 'isPermissionError' \/ 'PermissionDenied'
The process has insufficient privileges to perform the operation.
@[EACCES]@
-\item @ResourceExhausted@
+
+* 'ResourceExhausted'
Insufficient resources are available to perform the operation.
@[EMFILE, ENFILE]@
-\item @InappropriateType@
+
+* 'InappropriateType'
The path refers to an existing non-directory object.
@[ENOTDIR]@
-\end{itemize}
+
-}
getDirectoryContents :: FilePath -> IO [FilePath]
-getDirectoryContents path = do
- alloca $ \ ptr_dEnt -> do
- p <- withCString path $ \s ->
- throwErrnoIfNullRetry "getDirectoryContents" (c_opendir s)
- loop ptr_dEnt p
+getDirectoryContents path =
+ modifyIOError ((`ioeSetFileName` path) .
+ (`ioeSetLocation` "getDirectoryContents")) $ do
+#ifndef mingw32_HOST_OS
+ bracket
+ (Posix.openDirStream path)
+ Posix.closeDirStream
+ loop
+ where
+ loop dirp = do
+ e <- Posix.readDirStream dirp
+ if null e then return [] else do
+ es <- loop dirp
+ return (e:es)
+#else
+ bracket
+ (Win32.findFirstFile (path </> "*"))
+ (\(h,_) -> Win32.findClose h)
+ (\(h,fdat) -> loop h fdat [])
where
- loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
- loop ptr_dEnt dir = do
- resetErrno
- r <- readdir dir ptr_dEnt
- if (r == 0)
- then do
- dEnt <- peek ptr_dEnt
- if (dEnt == nullPtr)
- then return []
- else do
- entry <- (d_name dEnt >>= peekCString)
- freeDirEnt dEnt
- entries <- loop ptr_dEnt dir
- return (entry:entries)
- else do errno <- getErrno
- if (errno == eINTR) then loop ptr_dEnt dir else do
- throwErrnoIfMinus1_ "getDirectoryContents" $ c_closedir dir
- let (Errno eo) = errno
- if (eo == end_of_dir)
- then return []
- else throwErrno "getDirectoryContents"
-
-
-
-{-
-If the operating system has a notion of current directories,
-@getCurrentDirectory@ returns an absolute path to the
+ -- we needn't worry about empty directories: adirectory always
+ -- has at least "." and ".." entries
+ loop :: Win32.HANDLE -> Win32.FindData -> [FilePath] -> IO [FilePath]
+ loop h fdat acc = do
+ filename <- Win32.getFindDataFileName fdat
+ more <- Win32.findNextFile h fdat
+ if more
+ then loop h fdat (filename:acc)
+ else return (filename:acc)
+ -- no need to reverse, ordering is undefined
+#endif /* mingw32 */
+
+#endif /* __GLASGOW_HASKELL__ */
+
+
+{- |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:
-\begin{itemize}
-\item @HardwareFault@
-A physical I/O error has occurred.
+
+* 'HardwareFault'
+A physical I\/O error has occurred.
@[EIO]@
-\item @isDoesNotExistError@ / @NoSuchThing@
+
+* 'isDoesNotExistError' \/ 'NoSuchThing'
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]@
-\item @ResourceExhausted@
+
+* 'ResourceExhausted'
Insufficient resources are available to perform the operation.
-\item @UnsupportedOperation@
+
+* 'UnsupportedOperation'
The operating system has no notion of current directory.
-\end{itemize}
--}
+-}
+#ifdef __GLASGOW_HASKELL__
getCurrentDirectory :: IO FilePath
getCurrentDirectory = do
- p <- mallocBytes path_max
- go p path_max
- where go p bytes = do
- p' <- c_getcwd p (fromIntegral bytes)
- if p' /= nullPtr
- then do s <- peekCString p'
- free p'
- return s
- else do errno <- getErrno
- if errno == eRANGE
- then do let bytes' = bytes * 2
- p' <- reallocBytes p bytes'
- 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}.
+#ifdef mingw32_HOST_OS
+ Win32.getCurrentDirectory
+#else
+ Posix.getWorkingDirectory
+#endif
+
+{- |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:
-\begin{itemize}
-\item @HardwareFault@
-A physical I/O error has occurred.
+
+* 'HardwareFault'
+A physical I\/O error has occurred.
@[EIO]@
-\item @InvalidArgument@
+
+* 'InvalidArgument'
The operand is not a valid directory name.
@[ENAMETOOLONG, ELOOP]@
-\item @isDoesNotExistError@ / @NoSuchThing@
+
+* 'isDoesNotExistError' \/ 'NoSuchThing'
The directory does not exist.
@[ENOENT, ENOTDIR]@
-\item @isPermissionError@ / @PermissionDenied@
+
+* 'isPermissionError' \/ 'PermissionDenied'
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.
-\item @InappropriateType@
+
+* 'InappropriateType'
The path refers to an existing non-directory object.
@[ENOTDIR]@
-\end{itemize}
+
-}
setCurrentDirectory :: FilePath -> IO ()
-setCurrentDirectory path = do
- 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.)
+setCurrentDirectory path =
+#ifdef mingw32_HOST_OS
+ Win32.setCurrentDirectory path
+#else
+ Posix.changeWorkingDirectory path
+#endif
+
+#endif /* __GLASGOW_HASKELL__ */
+
+#ifdef __GLASGOW_HASKELL__
+{- |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)
- (\ _ -> return False)
+doesDirectoryExist name =
+#ifdef mingw32_HOST_OS
+ (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
+#else
+ (do stat <- Posix.getFileStatus name
+ return (Posix.isDirectory stat))
+#endif
+ `catch` ((\ _ -> return False) :: IOException -> IO Bool)
+
+{- |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)
+doesFileExist name =
+#ifdef mingw32_HOST_OS
+ (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
+#else
+ (do stat <- Posix.getFileStatus name
+ return (not (Posix.isDirectory stat)))
+#endif
+ `catch` ((\ _ -> return False) :: IOException -> IO Bool)
-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
- is_reg <- isRegularFile st
- return (
- Permissions {
- readable = read == 0,
- writable = write == 0,
- executable = not is_dir && exec == 0,
- searchable = not is_reg && 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
- mode = read `unionCMode` (write `unionCMode` exec)
+* 'isDoesNotExistError' if the file or directory does not exist.
- withCString name $ \s ->
- throwErrnoIfMinus1_ "setPermissions" $ c_chmod s mode
+-}
+
+getModificationTime :: FilePath -> IO ClockTime
+getModificationTime name = do
+#ifdef mingw32_HOST_OS
+ -- ToDo: use Win32 API
+ withFileStatus "getModificationTime" name $ \ st -> do
+ modificationTime st
+#else
+ stat <- Posix.getFileStatus name
+ let mod_time :: Posix.EpochTime
+ mod_time = Posix.modificationTime stat
+ dbl_time :: Double
+ dbl_time = realToFrac mod_time
+ return (TOD (round dbl_time) 0)
+#endif
+ -- For info
+ -- round :: (RealFrac a, Integral b => a -> b
+ -- realToFrac :: (Real a, Fractional b) => a -> b
+
+#endif /* __GLASGOW_HASKELL__ */
-withFileStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a
-withFileStatus name f = do
+#ifdef mingw32_HOST_OS
+withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
+withFileStatus loc name f = do
+ modifyIOError (`ioeSetFileName` name) $
allocaBytes sizeof_stat $ \p ->
- withCString name $ \s -> do
- throwErrnoIfMinus1Retry_ "withFileStatus" (c_stat s p)
+ withFilePath (fileNameEndClean name) $ \s -> do
+ 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)
+ withFilePath name $ \s -> do
+ throwErrnoIfMinus1Retry_ loc (lstat s p)
f p
modificationTime :: Ptr CStat -> IO ClockTime
modificationTime stat = do
mtime <- st_mtime stat
- return (TOD (toInteger (mtime :: CTime)) 0)
+ let dbl_time :: Double
+ dbl_time = realToFrac (mtime :: CTime)
+ return (TOD (round dbl_time) 0)
isDirectory :: Ptr CStat -> IO Bool
isDirectory stat = do
mode <- st_mode stat
return (s_isdir mode)
-isRegularFile :: Ptr CStat -> IO Bool
-isRegularFile stat = do
- mode <- st_mode stat
- return (s_isreg mode)
+fileNameEndClean :: String -> String
+fileNameEndClean name = if isDrive name then addTrailingPathSeparator name
+ else dropTrailingPathSeparator name
+
+foreign import ccall unsafe "HsDirectory.h __hscore_S_IRUSR" s_IRUSR :: CMode
+foreign import ccall unsafe "HsDirectory.h __hscore_S_IWUSR" s_IWUSR :: CMode
+foreign import ccall unsafe "HsDirectory.h __hscore_S_IXUSR" s_IXUSR :: CMode
+foreign import ccall unsafe "__hscore_S_IFDIR" s_IFDIR :: CMode
+#endif
+
+
+#ifdef __GLASGOW_HASKELL__
+foreign import ccall unsafe "__hscore_long_path_size"
+ long_path_size :: Int
+#else
+long_path_size :: Int
+long_path_size = 2048 -- // guess?
+#endif /* __GLASGOW_HASKELL__ */
+
+{- | Returns the current user's home 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, '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@.
-emptyCMode :: CMode
-emptyCMode = 0
+The operation may fail with:
+
+* '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 =
+ modifyIOError ((`ioeSetLocation` "getHomeDirectory")) $ do
+#if defined(mingw32_HOST_OS)
+ r <- try $ Win32.sHGetFolderPath nullPtr Win32.cSIDL_PROFILE nullPtr 0
+ case (r :: Either IOException String) of
+ Right s -> return s
+ Left _ -> do
+ r1 <- try $ Win32.sHGetFolderPath nullPtr Win32.cSIDL_WINDOWS nullPtr 0
+ case r1 of
+ Right s -> return s
+ Left e -> ioError (e :: IOException)
+#else
+ getEnv "HOME"
+#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.
-unionCMode :: CMode -> CMode -> CMode
-unionCMode = (+)
+On Unix, this function returns @$HOME\/.appName@. On Windows, a
+typical path might be
+> C:/Documents And Settings/user/Application Data/appName
-foreign import ccall unsafe "__hscore_path_max"
- path_max :: Int
+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
+ modifyIOError ((`ioeSetLocation` "getAppUserDataDirectory")) $ do
+#if defined(mingw32_HOST_OS)
+ s <- Win32.sHGetFolderPath nullPtr Win32.cSIDL_APPDATA nullPtr 0
+ return (s++'\\':appName)
+#else
+ path <- getEnv "HOME"
+ return (path++'/':'.':appName)
+#endif
-foreign import ccall unsafe "__hscore_readdir"
- readdir :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
+{- | Returns the current user's document directory.
-foreign import ccall unsafe "__hscore_free_dirent"
- freeDirEnt :: Ptr CDirent -> IO ()
+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_end_of_dir"
- end_of_dir :: CInt
+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@.
-foreign import ccall unsafe "__hscore_d_name"
- d_name :: Ptr CDirent -> IO CString
+The operation may fail with:
-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
+* 'UnsupportedOperation'
+The operating system has no notion of document directory.
-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
+* 'isDoesNotExistError'
+The document directory for the current user does not exist, or
+cannot be found.
+-}
+getUserDocumentsDirectory :: IO FilePath
+getUserDocumentsDirectory = do
+ modifyIOError ((`ioeSetLocation` "getUserDocumentsDirectory")) $ do
+#if defined(mingw32_HOST_OS)
+ Win32.sHGetFolderPath nullPtr Win32.cSIDL_PERSONAL nullPtr 0
+#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)
+ Win32.getTemporaryDirectory
+#else
+ getEnv "TMPDIR"
+#if !__NHC__
+ `Prelude.catch` \e -> if isDoesNotExistError e then return "/tmp"
+ else throw e
+#else
+ `Prelude.catch` (\ex -> return "/tmp")
+#endif
+#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