2 -- XXX We get some warnings on Windows
4 -----------------------------------------------------------------------------
6 -- Module : System.Directory
7 -- Copyright : (c) The University of Glasgow 2001
8 -- License : BSD-style (see the file libraries/base/LICENSE)
10 -- Maintainer : libraries@haskell.org
12 -- Portability : portable
14 -- System-independent interface to directory manipulation.
16 -----------------------------------------------------------------------------
18 module System.Directory
22 -- * Actions on directories
23 createDirectory -- :: FilePath -> IO ()
24 , createDirectoryIfMissing -- :: Bool -> FilePath -> IO ()
25 , removeDirectory -- :: FilePath -> IO ()
26 , removeDirectoryRecursive -- :: FilePath -> IO ()
27 , renameDirectory -- :: FilePath -> FilePath -> IO ()
29 , getDirectoryContents -- :: FilePath -> IO [FilePath]
30 , getCurrentDirectory -- :: IO FilePath
31 , setCurrentDirectory -- :: FilePath -> IO ()
33 -- * Pre-defined directories
35 , getAppUserDataDirectory
36 , getUserDocumentsDirectory
37 , getTemporaryDirectory
40 , removeFile -- :: FilePath -> IO ()
41 , renameFile -- :: FilePath -> FilePath -> IO ()
42 , copyFile -- :: FilePath -> FilePath -> IO ()
45 , makeRelativeToCurrentDirectory
49 , doesFileExist -- :: FilePath -> IO Bool
50 , doesDirectoryExist -- :: FilePath -> IO Bool
58 readable, -- :: Permissions -> Bool
59 writable, -- :: Permissions -> Bool
60 executable, -- :: Permissions -> Bool
61 searchable -- :: Permissions -> Bool
64 , getPermissions -- :: FilePath -> IO Permissions
65 , setPermissions -- :: FilePath -> Permissions -> IO ()
69 , getModificationTime -- :: FilePath -> IO ClockTime
72 import Prelude hiding ( catch )
73 import qualified Prelude
75 import System.Environment ( getEnv )
76 import System.FilePath
78 import System.IO.Error hiding ( catch, try )
79 import Control.Monad ( when, unless )
80 import Control.Exception
84 import System (system)
94 {-# CFILES cbits/directory.c #-}
96 #ifdef __GLASGOW_HASKELL__
97 import System.Posix.Types
98 import System.Posix.Internals
99 import System.Time ( ClockTime(..) )
101 import GHC.IOBase ( IOException(..), IOErrorType(..), ioException )
104 A directory contains a series of entries, each of which is a named
105 reference to a file system object (file, directory etc.). Some
106 entries may be hidden, inaccessible, or have some administrative
107 function (e.g. `.' or `..' under POSIX
108 <http://www.opengroup.org/onlinepubs/009695399/>), but in
109 this standard all such entries are considered to form part of the
110 directory contents. Entries in sub-directories are not, however,
111 considered to form part of the directory contents.
113 Each file system object is referenced by a /path/. There is
114 normally at least one absolute path to each file system object. In
115 some operating systems, it may also be possible to have paths which
116 are relative to the current directory.
119 -----------------------------------------------------------------------------
124 The 'Permissions' type is used to record whether certain operations are
125 permissible on a file\/directory. 'getPermissions' and 'setPermissions'
126 get and set these permissions, respectively. Permissions apply both to
127 files and directories. For directories, the executable field will be
128 'False', and for files the searchable field will be 'False'. Note that
129 directories may be searchable without being readable, if permission has
130 been given to use them as part of a path, but not to examine the
133 Note that to change some, but not all permissions, a construct on the following lines must be used.
135 > makeReadable f = do
136 > p <- getPermissions f
137 > setPermissions f (p {readable = True})
144 executable, searchable :: Bool
145 } deriving (Eq, Ord, Read, Show)
147 {- |The 'getPermissions' operation returns the
148 permissions for the file or directory.
150 The operation may fail with:
152 * 'isPermissionError' if the user is not permitted to access
155 * 'isDoesNotExistError' if the file or directory does not exist.
159 getPermissions :: FilePath -> IO Permissions
160 getPermissions name = do
161 withCString name $ \s -> do
162 #ifdef mingw32_HOST_OS
163 -- stat() does a better job of guessing the permissions on Windows
164 -- than access() does. e.g. for execute permission, it looks at the
165 -- filename extension :-)
167 -- I tried for a while to do this properly, using the Windows security API,
168 -- and eventually gave up. getPermissions is a flawed API anyway. -- SimonM
169 allocaBytes sizeof_stat $ \ p_stat -> do
170 throwErrnoIfMinus1_ "getPermissions" $ c_stat s p_stat
171 mode <- st_mode p_stat
172 let usr_read = mode .&. s_IRUSR
173 let usr_write = mode .&. s_IWUSR
174 let usr_exec = mode .&. s_IXUSR
175 let is_dir = mode .&. s_IFDIR
178 readable = usr_read /= 0,
179 writable = usr_write /= 0,
180 executable = is_dir == 0 && usr_exec /= 0,
181 searchable = is_dir /= 0 && usr_exec /= 0
185 read_ok <- c_access s r_OK
186 write_ok <- c_access s w_OK
187 exec_ok <- c_access s x_OK
188 withFileStatus "getPermissions" name $ \st -> do
189 is_dir <- isDirectory st
192 readable = read_ok == 0,
193 writable = write_ok == 0,
194 executable = not is_dir && exec_ok == 0,
195 searchable = is_dir && exec_ok == 0
200 {- |The 'setPermissions' operation sets the
201 permissions for the file or directory.
203 The operation may fail with:
205 * 'isPermissionError' if the user is not permitted to set
208 * 'isDoesNotExistError' if the file or directory does not exist.
212 setPermissions :: FilePath -> Permissions -> IO ()
213 setPermissions name (Permissions r w e s) = do
214 allocaBytes sizeof_stat $ \ p_stat -> do
215 withCString name $ \p_name -> do
216 throwErrnoIfMinus1_ "setPermissions" $ do
218 mode <- st_mode p_stat
219 let mode1 = modifyBit r mode s_IRUSR
220 let mode2 = modifyBit w mode1 s_IWUSR
221 let mode3 = modifyBit (e || s) mode2 s_IXUSR
225 modifyBit :: Bool -> CMode -> CMode -> CMode
226 modifyBit False m b = m .&. (complement b)
227 modifyBit True m b = m .|. b
230 copyPermissions :: FilePath -> FilePath -> IO ()
231 copyPermissions source dest = do
232 allocaBytes sizeof_stat $ \ p_stat -> do
233 withCString source $ \p_source -> do
234 withCString dest $ \p_dest -> do
235 throwErrnoIfMinus1_ "copyPermissions" $ c_stat p_source p_stat
236 mode <- st_mode p_stat
237 throwErrnoIfMinus1_ "copyPermissions" $ c_chmod p_dest mode
239 -----------------------------------------------------------------------------
242 {- |@'createDirectory' dir@ creates a new directory @dir@ which is
243 initially empty, or as near to empty as the operating system
246 The operation may fail with:
248 * 'isPermissionError' \/ 'PermissionDenied'
249 The process has insufficient privileges to perform the operation.
252 * 'isAlreadyExistsError' \/ 'AlreadyExists'
253 The operand refers to a directory that already exists.
257 A physical I\/O error has occurred.
261 The operand is not a valid directory name.
262 @[ENAMETOOLONG, ELOOP]@
265 There is no path to the directory.
268 * 'ResourceExhausted'
269 Insufficient resources (virtual memory, process file descriptors,
270 physical disk space, etc.) are available to perform the operation.
271 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
273 * 'InappropriateType'
274 The path refers to an existing non-directory object.
279 createDirectory :: FilePath -> IO ()
280 createDirectory path = do
281 modifyIOError (`ioeSetFileName` path) $
282 withCString path $ \s -> do
283 throwErrnoIfMinus1Retry_ "createDirectory" $
286 #else /* !__GLASGOW_HASKELL__ */
288 copyPermissions :: FilePath -> FilePath -> IO ()
289 copyPermissions fromFPath toFPath
290 = getPermissions fromFPath >>= setPermissions toFPath
294 -- | @'createDirectoryIfMissing' parents dir@ creates a new directory
295 -- @dir@ if it doesn\'t exist. If the first argument is 'True'
296 -- the function will also create all parent directories if they are missing.
297 createDirectoryIfMissing :: Bool -- ^ Create its parents too?
298 -> FilePath -- ^ The path to the directory you want to make
300 createDirectoryIfMissing parents file = do
301 b <- doesDirectoryExist file
302 case (b,parents, file) of
303 (_, _, "") -> return ()
304 (True, _, _) -> return ()
305 (_, True, _) -> mapM_ (createDirectoryIfMissing False) $ mkParents file
306 (_, False, _) -> createDirectory file
307 where mkParents = scanl1 (</>) . splitDirectories . normalise
309 #if __GLASGOW_HASKELL__
310 {- | @'removeDirectory' dir@ removes an existing directory /dir/. The
311 implementation may specify additional constraints which must be
312 satisfied before a directory can be removed (e.g. the directory has to
313 be empty, or may not be in use by other processes). It is not legal
314 for an implementation to partially remove a directory unless the
315 entire directory is removed. A conformant implementation need not
316 support directory removal in all situations (e.g. removal of the root
319 The operation may fail with:
322 A physical I\/O error has occurred.
326 The operand is not a valid directory name.
327 [ENAMETOOLONG, ELOOP]
329 * 'isDoesNotExistError' \/ 'NoSuchThing'
330 The directory does not exist.
333 * 'isPermissionError' \/ 'PermissionDenied'
334 The process has insufficient privileges to perform the operation.
335 @[EROFS, EACCES, EPERM]@
337 * 'UnsatisfiedConstraints'
338 Implementation-dependent constraints are not satisfied.
339 @[EBUSY, ENOTEMPTY, EEXIST]@
341 * 'UnsupportedOperation'
342 The implementation does not support removal in this situation.
345 * 'InappropriateType'
346 The operand refers to an existing non-directory object.
351 removeDirectory :: FilePath -> IO ()
352 removeDirectory path = do
353 modifyIOError (`ioeSetFileName` path) $
354 withCString path $ \s ->
355 throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
358 -- | @'removeDirectoryRecursive' dir@ removes an existing directory /dir/
359 -- together with its content and all subdirectories. Be careful,
360 -- if the directory contains symlinks, the function will follow them.
361 removeDirectoryRecursive :: FilePath -> IO ()
362 removeDirectoryRecursive startLoc = do
363 cont <- getDirectoryContents startLoc
364 sequence_ [rm (startLoc </> x) | x <- cont, x /= "." && x /= ".."]
365 removeDirectory startLoc
367 rm :: FilePath -> IO ()
368 rm f = do temp <- try (removeFile f)
370 Left e -> do isDir <- doesDirectoryExist f
371 -- If f is not a directory, re-throw the error
372 unless isDir $ throw (e :: SomeException)
373 removeDirectoryRecursive f
376 #if __GLASGOW_HASKELL__
377 {- |'removeFile' /file/ removes the directory entry for an existing file
378 /file/, where /file/ is not itself a directory. The
379 implementation may specify additional constraints which must be
380 satisfied before a file can be removed (e.g. the file may not be in
381 use by other processes).
383 The operation may fail with:
386 A physical I\/O error has occurred.
390 The operand is not a valid file name.
391 @[ENAMETOOLONG, ELOOP]@
393 * 'isDoesNotExistError' \/ 'NoSuchThing'
394 The file does not exist.
397 * 'isPermissionError' \/ 'PermissionDenied'
398 The process has insufficient privileges to perform the operation.
399 @[EROFS, EACCES, EPERM]@
401 * 'UnsatisfiedConstraints'
402 Implementation-dependent constraints are not satisfied.
405 * 'InappropriateType'
406 The operand refers to an existing directory.
411 removeFile :: FilePath -> IO ()
413 modifyIOError (`ioeSetFileName` path) $
414 withCString path $ \s ->
415 throwErrnoIfMinus1Retry_ "removeFile" (c_unlink s)
417 {- |@'renameDirectory' old new@ changes the name of an existing
418 directory from /old/ to /new/. If the /new/ directory
419 already exists, it is atomically replaced by the /old/ directory.
420 If the /new/ directory is neither the /old/ directory nor an
421 alias of the /old/ directory, it is removed as if by
422 'removeDirectory'. A conformant implementation need not support
423 renaming directories in all situations (e.g. renaming to an existing
424 directory, or across different physical devices), but the constraints
427 On Win32 platforms, @renameDirectory@ fails if the /new/ directory already
430 The operation may fail with:
433 A physical I\/O error has occurred.
437 Either operand is not a valid directory name.
438 @[ENAMETOOLONG, ELOOP]@
440 * 'isDoesNotExistError' \/ 'NoSuchThing'
441 The original directory does not exist, or there is no path to the target.
444 * 'isPermissionError' \/ 'PermissionDenied'
445 The process has insufficient privileges to perform the operation.
446 @[EROFS, EACCES, EPERM]@
448 * 'ResourceExhausted'
449 Insufficient resources are available to perform the operation.
450 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
452 * 'UnsatisfiedConstraints'
453 Implementation-dependent constraints are not satisfied.
454 @[EBUSY, ENOTEMPTY, EEXIST]@
456 * 'UnsupportedOperation'
457 The implementation does not support renaming in this situation.
460 * 'InappropriateType'
461 Either path refers to an existing non-directory object.
466 renameDirectory :: FilePath -> FilePath -> IO ()
467 renameDirectory opath npath =
468 withFileStatus "renameDirectory" opath $ \st -> do
469 is_dir <- isDirectory st
471 then ioException (IOError Nothing InappropriateType "renameDirectory"
472 ("not a directory") (Just opath))
475 withCString opath $ \s1 ->
476 withCString npath $ \s2 ->
477 throwErrnoIfMinus1Retry_ "renameDirectory" (c_rename s1 s2)
479 {- |@'renameFile' old new@ changes the name of an existing file system
480 object from /old/ to /new/. If the /new/ object already
481 exists, it is atomically replaced by the /old/ object. Neither
482 path may refer to an existing directory. A conformant implementation
483 need not support renaming files in all situations (e.g. renaming
484 across different physical devices), but the constraints must be
487 The operation may fail with:
490 A physical I\/O error has occurred.
494 Either operand is not a valid file name.
495 @[ENAMETOOLONG, ELOOP]@
497 * 'isDoesNotExistError' \/ 'NoSuchThing'
498 The original file does not exist, or there is no path to the target.
501 * 'isPermissionError' \/ 'PermissionDenied'
502 The process has insufficient privileges to perform the operation.
503 @[EROFS, EACCES, EPERM]@
505 * 'ResourceExhausted'
506 Insufficient resources are available to perform the operation.
507 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
509 * 'UnsatisfiedConstraints'
510 Implementation-dependent constraints are not satisfied.
513 * 'UnsupportedOperation'
514 The implementation does not support renaming in this situation.
517 * 'InappropriateType'
518 Either path refers to an existing directory.
519 @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@
523 renameFile :: FilePath -> FilePath -> IO ()
524 renameFile opath npath =
525 withFileOrSymlinkStatus "renameFile" opath $ \st -> do
526 is_dir <- isDirectory st
528 then ioException (IOError Nothing InappropriateType "renameFile"
529 "is a directory" (Just opath))
532 withCString opath $ \s1 ->
533 withCString npath $ \s2 ->
534 throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
536 #endif /* __GLASGOW_HASKELL__ */
538 {- |@'copyFile' old new@ copies the existing file from /old/ to /new/.
539 If the /new/ file already exists, it is atomically replaced by the /old/ file.
540 Neither path may refer to an existing directory. The permissions of /old/ are
541 copied to /new/, if possible.
544 copyFile :: FilePath -> FilePath -> IO ()
546 copyFile fromFPath toFPath =
547 do readFile fromFPath >>= writeFile toFPath
548 Prelude.catch (copyPermissions fromFPath toFPath)
551 copyFile fromFPath toFPath =
552 copy `Prelude.catch` (\exc -> throw $ ioeSetLocation exc "copyFile")
553 where copy = bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
554 bracketOnError openTmp cleanTmp $ \(tmpFPath, hTmp) ->
555 do allocaBytes bufferSize $ copyContents hFrom hTmp
557 ignoreIOExceptions $ copyPermissions fromFPath tmpFPath
558 renameFile tmpFPath toFPath
559 openTmp = openBinaryTempFile (takeDirectory toFPath) ".copyFile.tmp"
560 cleanTmp (tmpFPath, hTmp)
561 = do ignoreIOExceptions $ hClose hTmp
562 ignoreIOExceptions $ removeFile tmpFPath
565 copyContents hFrom hTo buffer = do
566 count <- hGetBuf hFrom buffer bufferSize
567 when (count > 0) $ do
568 hPutBuf hTo buffer count
569 copyContents hFrom hTo buffer
571 ignoreIOExceptions io = io `catch` ioExceptionIgnorer
572 ioExceptionIgnorer :: IOException -> IO ()
573 ioExceptionIgnorer _ = return ()
576 -- | Given path referring to a file or directory, returns a
577 -- canonicalized path, with the intent that two paths referring
578 -- to the same file\/directory will map to the same canonicalized
579 -- path. Note that it is impossible to guarantee that the
580 -- implication (same file\/dir \<=\> same canonicalizedPath) holds
581 -- in either direction: this function can make only a best-effort
583 canonicalizePath :: FilePath -> IO FilePath
584 canonicalizePath fpath =
585 withCString fpath $ \pInPath ->
586 allocaBytes long_path_size $ \pOutPath ->
587 #if defined(mingw32_HOST_OS)
588 alloca $ \ppFilePart ->
589 do c_GetFullPathName pInPath (fromIntegral long_path_size) pOutPath ppFilePart
591 do c_realpath pInPath pOutPath
593 path <- peekCString pOutPath
594 return (normalise path)
595 -- normalise does more stuff, like upper-casing the drive letter
597 #if defined(mingw32_HOST_OS)
598 foreign import stdcall unsafe "GetFullPathNameA"
599 c_GetFullPathName :: CString
605 foreign import ccall unsafe "realpath"
606 c_realpath :: CString
611 -- | 'makeRelative' the current directory.
612 makeRelativeToCurrentDirectory :: FilePath -> IO FilePath
613 makeRelativeToCurrentDirectory x = do
614 cur <- getCurrentDirectory
615 return $ makeRelative cur x
617 -- | Given an executable file name, searches for such file
618 -- in the directories listed in system PATH. The returned value
619 -- is the path to the found executable or Nothing if there isn't
620 -- such executable. For example (findExecutable \"ghc\")
621 -- gives you the path to GHC.
622 findExecutable :: String -> IO (Maybe FilePath)
623 findExecutable binary =
624 #if defined(mingw32_HOST_OS)
625 withCString binary $ \c_binary ->
626 withCString ('.':exeExtension) $ \c_ext ->
627 allocaBytes long_path_size $ \pOutPath ->
628 alloca $ \ppFilePart -> do
629 res <- c_SearchPath nullPtr c_binary c_ext (fromIntegral long_path_size) pOutPath ppFilePart
630 if res > 0 && res < fromIntegral long_path_size
631 then do fpath <- peekCString pOutPath
635 foreign import stdcall unsafe "SearchPathA"
636 c_SearchPath :: CString
645 path <- getEnv "PATH"
646 search (splitSearchPath path)
648 fileName = binary <.> exeExtension
650 search :: [FilePath] -> IO (Maybe FilePath)
651 search [] = return Nothing
653 let path = d </> fileName
654 b <- doesFileExist path
655 if b then return (Just path)
660 #ifdef __GLASGOW_HASKELL__
661 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
664 The operation may fail with:
667 A physical I\/O error has occurred.
671 The operand is not a valid directory name.
672 @[ENAMETOOLONG, ELOOP]@
674 * 'isDoesNotExistError' \/ 'NoSuchThing'
675 The directory does not exist.
678 * 'isPermissionError' \/ 'PermissionDenied'
679 The process has insufficient privileges to perform the operation.
682 * 'ResourceExhausted'
683 Insufficient resources are available to perform the operation.
686 * 'InappropriateType'
687 The path refers to an existing non-directory object.
692 getDirectoryContents :: FilePath -> IO [FilePath]
693 getDirectoryContents path = do
694 modifyIOError (`ioeSetFileName` path) $
695 alloca $ \ ptr_dEnt ->
697 (withCString path $ \s ->
698 throwErrnoIfNullRetry desc (c_opendir s))
699 (\p -> throwErrnoIfMinus1_ desc (c_closedir p))
700 (\p -> loop ptr_dEnt p)
702 desc = "getDirectoryContents"
704 loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
705 loop ptr_dEnt dir = do
707 r <- readdir dir ptr_dEnt
710 dEnt <- peek ptr_dEnt
714 entry <- (d_name dEnt >>= peekCString)
716 entries <- loop ptr_dEnt dir
717 return (entry:entries)
718 else do errno <- getErrno
719 if (errno == eINTR) then loop ptr_dEnt dir else do
720 let (Errno eo) = errno
721 if (eo == end_of_dir)
727 {- |If the operating system has a notion of current directories,
728 'getCurrentDirectory' returns an absolute path to the
729 current directory of the calling process.
731 The operation may fail with:
734 A physical I\/O error has occurred.
737 * 'isDoesNotExistError' \/ 'NoSuchThing'
738 There is no path referring to the current directory.
739 @[EPERM, ENOENT, ESTALE...]@
741 * 'isPermissionError' \/ 'PermissionDenied'
742 The process has insufficient privileges to perform the operation.
745 * 'ResourceExhausted'
746 Insufficient resources are available to perform the operation.
748 * 'UnsupportedOperation'
749 The operating system has no notion of current directory.
753 getCurrentDirectory :: IO FilePath
754 getCurrentDirectory = do
755 p <- mallocBytes long_path_size
757 where go p bytes = do
758 p' <- c_getcwd p (fromIntegral bytes)
760 then do s <- peekCString p'
763 else do errno <- getErrno
765 then do let bytes' = bytes * 2
766 p'' <- reallocBytes p bytes'
768 else throwErrno "getCurrentDirectory"
770 {- |If the operating system has a notion of current directories,
771 @'setCurrentDirectory' dir@ changes the current
772 directory of the calling process to /dir/.
774 The operation may fail with:
777 A physical I\/O error has occurred.
781 The operand is not a valid directory name.
782 @[ENAMETOOLONG, ELOOP]@
784 * 'isDoesNotExistError' \/ 'NoSuchThing'
785 The directory does not exist.
788 * 'isPermissionError' \/ 'PermissionDenied'
789 The process has insufficient privileges to perform the operation.
792 * 'UnsupportedOperation'
793 The operating system has no notion of current directory, or the
794 current directory cannot be dynamically changed.
796 * 'InappropriateType'
797 The path refers to an existing non-directory object.
802 setCurrentDirectory :: FilePath -> IO ()
803 setCurrentDirectory path = do
804 modifyIOError (`ioeSetFileName` path) $
805 withCString path $ \s ->
806 throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
807 -- ToDo: add path to error
809 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
810 exists and is a directory, and 'False' otherwise.
813 doesDirectoryExist :: FilePath -> IO Bool
814 doesDirectoryExist name =
815 (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
816 `catch` ((\ _ -> return False) :: IOException -> IO Bool)
818 {- |The operation 'doesFileExist' returns 'True'
819 if the argument file exists and is not a directory, and 'False' otherwise.
822 doesFileExist :: FilePath -> IO Bool
824 (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
825 `catch` ((\ _ -> return False) :: IOException -> IO Bool)
827 {- |The 'getModificationTime' operation returns the
828 clock time at which the file or directory was last modified.
830 The operation may fail with:
832 * 'isPermissionError' if the user is not permitted to access
833 the modification time; or
835 * 'isDoesNotExistError' if the file or directory does not exist.
839 getModificationTime :: FilePath -> IO ClockTime
840 getModificationTime name =
841 withFileStatus "getModificationTime" name $ \ st ->
844 withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
845 withFileStatus loc name f = do
846 modifyIOError (`ioeSetFileName` name) $
847 allocaBytes sizeof_stat $ \p ->
848 withCString (fileNameEndClean name) $ \s -> do
849 throwErrnoIfMinus1Retry_ loc (c_stat s p)
852 withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
853 withFileOrSymlinkStatus loc name f = do
854 modifyIOError (`ioeSetFileName` name) $
855 allocaBytes sizeof_stat $ \p ->
856 withCString name $ \s -> do
857 throwErrnoIfMinus1Retry_ loc (lstat s p)
860 modificationTime :: Ptr CStat -> IO ClockTime
861 modificationTime stat = do
862 mtime <- st_mtime stat
863 let realToInteger = round . realToFrac :: Real a => a -> Integer
864 return (TOD (realToInteger (mtime :: CTime)) 0)
866 isDirectory :: Ptr CStat -> IO Bool
867 isDirectory stat = do
869 return (s_isdir mode)
871 fileNameEndClean :: String -> String
872 fileNameEndClean name = if isDrive name then addTrailingPathSeparator name
873 else dropTrailingPathSeparator name
875 foreign import ccall unsafe "__hscore_R_OK" r_OK :: CInt
876 foreign import ccall unsafe "__hscore_W_OK" w_OK :: CInt
877 foreign import ccall unsafe "__hscore_X_OK" x_OK :: CInt
879 foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
880 foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
881 foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode
882 #ifdef mingw32_HOST_OS
883 foreign import ccall unsafe "__hscore_S_IFDIR" s_IFDIR :: CMode
886 foreign import ccall unsafe "__hscore_long_path_size"
887 long_path_size :: Int
890 long_path_size :: Int
891 long_path_size = 2048 -- // guess?
893 #endif /* __GLASGOW_HASKELL__ */
895 {- | Returns the current user's home directory.
897 The directory returned is expected to be writable by the current user,
898 but note that it isn't generally considered good practice to store
899 application-specific data here; use 'getAppUserDataDirectory'
902 On Unix, 'getHomeDirectory' returns the value of the @HOME@
903 environment variable. On Windows, the system is queried for a
904 suitable path; a typical path might be
905 @C:/Documents And Settings/user@.
907 The operation may fail with:
909 * 'UnsupportedOperation'
910 The operating system has no notion of home directory.
912 * 'isDoesNotExistError'
913 The home directory for the current user does not exist, or
916 getHomeDirectory :: IO FilePath
918 #if defined(mingw32_HOST_OS)
919 allocaBytes long_path_size $ \pPath -> do
920 r0 <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
923 r1 <- c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
924 when (r1 < 0) (raiseUnsupported "System.Directory.getHomeDirectory")
931 {- | Returns the pathname of a directory in which application-specific
932 data for the current user can be stored. The result of
933 'getAppUserDataDirectory' for a given application is specific to
936 The argument should be the name of the application, which will be used
937 to construct the pathname (so avoid using unusual characters that
938 might result in an invalid pathname).
940 Note: the directory may not actually exist, and may need to be created
941 first. It is expected that the parent directory exists and is
944 On Unix, this function returns @$HOME\/.appName@. On Windows, a
945 typical path might be
947 > C:/Documents And Settings/user/Application Data/appName
949 The operation may fail with:
951 * 'UnsupportedOperation'
952 The operating system has no notion of application-specific data directory.
954 * 'isDoesNotExistError'
955 The home directory for the current user does not exist, or
958 getAppUserDataDirectory :: String -> IO FilePath
959 getAppUserDataDirectory appName = do
960 #if defined(mingw32_HOST_OS)
961 allocaBytes long_path_size $ \pPath -> do
962 r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
963 when (r<0) (raiseUnsupported "System.Directory.getAppUserDataDirectory")
964 s <- peekCString pPath
965 return (s++'\\':appName)
967 path <- getEnv "HOME"
968 return (path++'/':'.':appName)
971 {- | Returns the current user's document directory.
973 The directory returned is expected to be writable by the current user,
974 but note that it isn't generally considered good practice to store
975 application-specific data here; use 'getAppUserDataDirectory'
978 On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@
979 environment variable. On Windows, the system is queried for a
980 suitable path; a typical path might be
981 @C:\/Documents and Settings\/user\/My Documents@.
983 The operation may fail with:
985 * 'UnsupportedOperation'
986 The operating system has no notion of document directory.
988 * 'isDoesNotExistError'
989 The document directory for the current user does not exist, or
992 getUserDocumentsDirectory :: IO FilePath
993 getUserDocumentsDirectory = do
994 #if defined(mingw32_HOST_OS)
995 allocaBytes long_path_size $ \pPath -> do
996 r <- c_SHGetFolderPath nullPtr csidl_PERSONAL nullPtr 0 pPath
997 when (r<0) (raiseUnsupported "System.Directory.getUserDocumentsDirectory")
1003 {- | Returns the current directory for temporary files.
1005 On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@
1006 environment variable or \"\/tmp\" if the variable isn\'t defined.
1007 On Windows, the function checks for the existence of environment variables in
1008 the following order and uses the first path found:
1011 TMP environment variable.
1014 TEMP environment variable.
1017 USERPROFILE environment variable.
1020 The Windows directory
1022 The operation may fail with:
1024 * 'UnsupportedOperation'
1025 The operating system has no notion of temporary directory.
1027 The function doesn\'t verify whether the path exists.
1029 getTemporaryDirectory :: IO FilePath
1030 getTemporaryDirectory = do
1031 #if defined(mingw32_HOST_OS)
1032 allocaBytes long_path_size $ \pPath -> do
1033 _r <- c_GetTempPath (fromIntegral long_path_size) pPath
1038 `Prelude.catch` \e -> if isDoesNotExistError e then return "/tmp"
1041 `Prelude.catch` (\ex -> return "/tmp")
1045 #if defined(mingw32_HOST_OS)
1046 foreign import ccall unsafe "__hscore_getFolderPath"
1047 c_SHGetFolderPath :: Ptr ()
1053 foreign import ccall unsafe "__hscore_CSIDL_PROFILE" csidl_PROFILE :: CInt
1054 foreign import ccall unsafe "__hscore_CSIDL_APPDATA" csidl_APPDATA :: CInt
1055 foreign import ccall unsafe "__hscore_CSIDL_WINDOWS" csidl_WINDOWS :: CInt
1056 foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt
1058 foreign import stdcall unsafe "GetTempPathA" c_GetTempPath :: CInt -> CString -> IO CInt
1060 raiseUnsupported :: String -> IO ()
1061 raiseUnsupported loc =
1062 ioException (IOError Nothing UnsupportedOperation loc "unsupported operation" Nothing)
1066 -- ToDo: This should be determined via autoconf (AC_EXEEXT)
1067 -- | Extension for executable files
1068 -- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
1069 exeExtension :: String
1070 #ifdef mingw32_HOST_OS
1071 exeExtension = "exe"