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 )
74 import System.Environment ( getEnv )
75 import System.FilePath
77 import System.IO.Error hiding ( catch, try )
78 import Control.Monad ( when, unless )
79 import Control.Exception
83 import System (system)
93 {-# CFILES cbits/directory.c #-}
95 #ifdef __GLASGOW_HASKELL__
96 import System.Posix.Types
97 import System.Posix.Internals
98 import System.Time ( ClockTime(..) )
100 import GHC.IOBase ( IOException(..), IOErrorType(..), ioException )
103 A directory contains a series of entries, each of which is a named
104 reference to a file system object (file, directory etc.). Some
105 entries may be hidden, inaccessible, or have some administrative
106 function (e.g. `.' or `..' under POSIX
107 <http://www.opengroup.org/onlinepubs/009695399/>), but in
108 this standard all such entries are considered to form part of the
109 directory contents. Entries in sub-directories are not, however,
110 considered to form part of the directory contents.
112 Each file system object is referenced by a /path/. There is
113 normally at least one absolute path to each file system object. In
114 some operating systems, it may also be possible to have paths which
115 are relative to the current directory.
118 -----------------------------------------------------------------------------
123 The 'Permissions' type is used to record whether certain operations are
124 permissible on a file\/directory. 'getPermissions' and 'setPermissions'
125 get and set these permissions, respectively. Permissions apply both to
126 files and directories. For directories, the executable field will be
127 'False', and for files the searchable field will be 'False'. Note that
128 directories may be searchable without being readable, if permission has
129 been given to use them as part of a path, but not to examine the
132 Note that to change some, but not all permissions, a construct on the following lines must be used.
134 > makeReadable f = do
135 > p <- getPermissions f
136 > setPermissions f (p {readable = True})
143 executable, searchable :: Bool
144 } deriving (Eq, Ord, Read, Show)
146 {- |The 'getPermissions' operation returns the
147 permissions for the file or directory.
149 The operation may fail with:
151 * 'isPermissionError' if the user is not permitted to access
154 * 'isDoesNotExistError' if the file or directory does not exist.
158 getPermissions :: FilePath -> IO Permissions
159 getPermissions name = do
160 withCString name $ \s -> do
161 #ifdef mingw32_HOST_OS
162 -- stat() does a better job of guessing the permissions on Windows
163 -- than access() does. e.g. for execute permission, it looks at the
164 -- filename extension :-)
166 -- I tried for a while to do this properly, using the Windows security API,
167 -- and eventually gave up. getPermissions is a flawed API anyway. -- SimonM
168 allocaBytes sizeof_stat $ \ p_stat -> do
169 throwErrnoIfMinus1_ "getPermissions" $ c_stat s p_stat
170 mode <- st_mode p_stat
171 let usr_read = mode .&. s_IRUSR
172 let usr_write = mode .&. s_IWUSR
173 let usr_exec = mode .&. s_IXUSR
174 let is_dir = mode .&. s_IFDIR
177 readable = usr_read /= 0,
178 writable = usr_write /= 0,
179 executable = is_dir == 0 && usr_exec /= 0,
180 searchable = is_dir /= 0 && usr_exec /= 0
184 read_ok <- c_access s r_OK
185 write_ok <- c_access s w_OK
186 exec_ok <- c_access s x_OK
187 withFileStatus "getPermissions" name $ \st -> do
188 is_dir <- isDirectory st
191 readable = read_ok == 0,
192 writable = write_ok == 0,
193 executable = not is_dir && exec_ok == 0,
194 searchable = is_dir && exec_ok == 0
199 {- |The 'setPermissions' operation sets the
200 permissions for the file or directory.
202 The operation may fail with:
204 * 'isPermissionError' if the user is not permitted to set
207 * 'isDoesNotExistError' if the file or directory does not exist.
211 setPermissions :: FilePath -> Permissions -> IO ()
212 setPermissions name (Permissions r w e s) = do
213 allocaBytes sizeof_stat $ \ p_stat -> do
214 withCString name $ \p_name -> do
215 throwErrnoIfMinus1_ "setPermissions" $ do
217 mode <- st_mode p_stat
218 let mode1 = modifyBit r mode s_IRUSR
219 let mode2 = modifyBit w mode1 s_IWUSR
220 let mode3 = modifyBit (e || s) mode2 s_IXUSR
224 modifyBit :: Bool -> CMode -> CMode -> CMode
225 modifyBit False m b = m .&. (complement b)
226 modifyBit True m b = m .|. b
229 copyPermissions :: FilePath -> FilePath -> IO ()
230 copyPermissions source dest = do
231 allocaBytes sizeof_stat $ \ p_stat -> do
232 withCString source $ \p_source -> do
233 withCString dest $ \p_dest -> do
234 throwErrnoIfMinus1_ "copyPermissions" $ c_stat p_source p_stat
235 mode <- st_mode p_stat
236 throwErrnoIfMinus1_ "copyPermissions" $ c_chmod p_dest mode
238 -----------------------------------------------------------------------------
241 {- |@'createDirectory' dir@ creates a new directory @dir@ which is
242 initially empty, or as near to empty as the operating system
245 The operation may fail with:
247 * 'isPermissionError' \/ 'PermissionDenied'
248 The process has insufficient privileges to perform the operation.
251 * 'isAlreadyExistsError' \/ 'AlreadyExists'
252 The operand refers to a directory that already exists.
256 A physical I\/O error has occurred.
260 The operand is not a valid directory name.
261 @[ENAMETOOLONG, ELOOP]@
264 There is no path to the directory.
267 * 'ResourceExhausted'
268 Insufficient resources (virtual memory, process file descriptors,
269 physical disk space, etc.) are available to perform the operation.
270 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
272 * 'InappropriateType'
273 The path refers to an existing non-directory object.
278 createDirectory :: FilePath -> IO ()
279 createDirectory path = do
280 modifyIOError (`ioeSetFileName` path) $
281 withCString path $ \s -> do
282 throwErrnoIfMinus1Retry_ "createDirectory" $
285 #else /* !__GLASGOW_HASKELL__ */
287 copyPermissions :: FilePath -> FilePath -> IO ()
288 copyPermissions fromFPath toFPath
289 = getPermissions fromFPath >>= setPermissions toFPath
293 -- | @'createDirectoryIfMissing' parents dir@ creates a new directory
294 -- @dir@ if it doesn\'t exist. If the first argument is 'True'
295 -- the function will also create all parent directories if they are missing.
296 createDirectoryIfMissing :: Bool -- ^ Create its parents too?
297 -> FilePath -- ^ The path to the directory you want to make
299 createDirectoryIfMissing parents file = do
300 b <- doesDirectoryExist file
301 case (b,parents, file) of
302 (_, _, "") -> return ()
303 (True, _, _) -> return ()
304 (_, True, _) -> mapM_ (createDirectoryIfMissing False) $ mkParents file
305 (_, False, _) -> createDirectory file
306 where mkParents = scanl1 (</>) . splitDirectories . normalise
308 #if __GLASGOW_HASKELL__
309 {- | @'removeDirectory' dir@ removes an existing directory /dir/. The
310 implementation may specify additional constraints which must be
311 satisfied before a directory can be removed (e.g. the directory has to
312 be empty, or may not be in use by other processes). It is not legal
313 for an implementation to partially remove a directory unless the
314 entire directory is removed. A conformant implementation need not
315 support directory removal in all situations (e.g. removal of the root
318 The operation may fail with:
321 A physical I\/O error has occurred.
325 The operand is not a valid directory name.
326 [ENAMETOOLONG, ELOOP]
328 * 'isDoesNotExistError' \/ 'NoSuchThing'
329 The directory does not exist.
332 * 'isPermissionError' \/ 'PermissionDenied'
333 The process has insufficient privileges to perform the operation.
334 @[EROFS, EACCES, EPERM]@
336 * 'UnsatisfiedConstraints'
337 Implementation-dependent constraints are not satisfied.
338 @[EBUSY, ENOTEMPTY, EEXIST]@
340 * 'UnsupportedOperation'
341 The implementation does not support removal in this situation.
344 * 'InappropriateType'
345 The operand refers to an existing non-directory object.
350 removeDirectory :: FilePath -> IO ()
351 removeDirectory path = do
352 modifyIOError (`ioeSetFileName` path) $
353 withCString path $ \s ->
354 throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
357 -- | @'removeDirectoryRecursive' dir@ removes an existing directory /dir/
358 -- together with its content and all subdirectories. Be careful,
359 -- if the directory contains symlinks, the function will follow them.
360 removeDirectoryRecursive :: FilePath -> IO ()
361 removeDirectoryRecursive startLoc = do
362 cont <- getDirectoryContents startLoc
363 sequence_ [rm (startLoc </> x) | x <- cont, x /= "." && x /= ".."]
364 removeDirectory startLoc
366 rm :: FilePath -> IO ()
367 rm f = do temp <- try (removeFile f)
369 Left e -> do isDir <- doesDirectoryExist f
370 -- If f is not a directory, re-throw the error
371 unless isDir $ throw e
372 removeDirectoryRecursive f
375 #if __GLASGOW_HASKELL__
376 {- |'removeFile' /file/ removes the directory entry for an existing file
377 /file/, where /file/ is not itself a directory. The
378 implementation may specify additional constraints which must be
379 satisfied before a file can be removed (e.g. the file may not be in
380 use by other processes).
382 The operation may fail with:
385 A physical I\/O error has occurred.
389 The operand is not a valid file name.
390 @[ENAMETOOLONG, ELOOP]@
392 * 'isDoesNotExistError' \/ 'NoSuchThing'
393 The file does not exist.
396 * 'isPermissionError' \/ 'PermissionDenied'
397 The process has insufficient privileges to perform the operation.
398 @[EROFS, EACCES, EPERM]@
400 * 'UnsatisfiedConstraints'
401 Implementation-dependent constraints are not satisfied.
404 * 'InappropriateType'
405 The operand refers to an existing directory.
410 removeFile :: FilePath -> IO ()
412 modifyIOError (`ioeSetFileName` path) $
413 withCString path $ \s ->
414 throwErrnoIfMinus1Retry_ "removeFile" (c_unlink s)
416 {- |@'renameDirectory' old new@ changes the name of an existing
417 directory from /old/ to /new/. If the /new/ directory
418 already exists, it is atomically replaced by the /old/ directory.
419 If the /new/ directory is neither the /old/ directory nor an
420 alias of the /old/ directory, it is removed as if by
421 'removeDirectory'. A conformant implementation need not support
422 renaming directories in all situations (e.g. renaming to an existing
423 directory, or across different physical devices), but the constraints
426 On Win32 platforms, @renameDirectory@ fails if the /new/ directory already
429 The operation may fail with:
432 A physical I\/O error has occurred.
436 Either operand is not a valid directory name.
437 @[ENAMETOOLONG, ELOOP]@
439 * 'isDoesNotExistError' \/ 'NoSuchThing'
440 The original directory does not exist, or there is no path to the target.
443 * 'isPermissionError' \/ 'PermissionDenied'
444 The process has insufficient privileges to perform the operation.
445 @[EROFS, EACCES, EPERM]@
447 * 'ResourceExhausted'
448 Insufficient resources are available to perform the operation.
449 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
451 * 'UnsatisfiedConstraints'
452 Implementation-dependent constraints are not satisfied.
453 @[EBUSY, ENOTEMPTY, EEXIST]@
455 * 'UnsupportedOperation'
456 The implementation does not support renaming in this situation.
459 * 'InappropriateType'
460 Either path refers to an existing non-directory object.
465 renameDirectory :: FilePath -> FilePath -> IO ()
466 renameDirectory opath npath =
467 withFileStatus "renameDirectory" opath $ \st -> do
468 is_dir <- isDirectory st
470 then ioException (IOError Nothing InappropriateType "renameDirectory"
471 ("not a directory") (Just opath))
474 withCString opath $ \s1 ->
475 withCString npath $ \s2 ->
476 throwErrnoIfMinus1Retry_ "renameDirectory" (c_rename s1 s2)
478 {- |@'renameFile' old new@ changes the name of an existing file system
479 object from /old/ to /new/. If the /new/ object already
480 exists, it is atomically replaced by the /old/ object. Neither
481 path may refer to an existing directory. A conformant implementation
482 need not support renaming files in all situations (e.g. renaming
483 across different physical devices), but the constraints must be
486 The operation may fail with:
489 A physical I\/O error has occurred.
493 Either operand is not a valid file name.
494 @[ENAMETOOLONG, ELOOP]@
496 * 'isDoesNotExistError' \/ 'NoSuchThing'
497 The original file does not exist, or there is no path to the target.
500 * 'isPermissionError' \/ 'PermissionDenied'
501 The process has insufficient privileges to perform the operation.
502 @[EROFS, EACCES, EPERM]@
504 * 'ResourceExhausted'
505 Insufficient resources are available to perform the operation.
506 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
508 * 'UnsatisfiedConstraints'
509 Implementation-dependent constraints are not satisfied.
512 * 'UnsupportedOperation'
513 The implementation does not support renaming in this situation.
516 * 'InappropriateType'
517 Either path refers to an existing directory.
518 @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@
522 renameFile :: FilePath -> FilePath -> IO ()
523 renameFile opath npath =
524 withFileOrSymlinkStatus "renameFile" opath $ \st -> do
525 is_dir <- isDirectory st
527 then ioException (IOError Nothing InappropriateType "renameFile"
528 "is a directory" (Just opath))
531 withCString opath $ \s1 ->
532 withCString npath $ \s2 ->
533 throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
535 #endif /* __GLASGOW_HASKELL__ */
537 {- |@'copyFile' old new@ copies the existing file from /old/ to /new/.
538 If the /new/ file already exists, it is atomically replaced by the /old/ file.
539 Neither path may refer to an existing directory. The permissions of /old/ are
540 copied to /new/, if possible.
543 copyFile :: FilePath -> FilePath -> IO ()
545 copyFile fromFPath toFPath =
546 do readFile fromFPath >>= writeFile toFPath
547 try (copyPermissions fromFPath toFPath)
550 copyFile fromFPath toFPath =
551 copy `catch` (\e -> case e of
553 throw $ IOException $ ioeSetLocation exc "copyFile"
555 where copy = bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
556 bracketOnError openTmp cleanTmp $ \(tmpFPath, hTmp) ->
557 do allocaBytes bufferSize $ copyContents hFrom hTmp
559 try (copyPermissions fromFPath tmpFPath)
560 renameFile tmpFPath toFPath
561 openTmp = openBinaryTempFile (takeDirectory toFPath) ".copyFile.tmp"
562 cleanTmp (tmpFPath, hTmp) = do try $ hClose hTmp
563 try $ removeFile tmpFPath
566 copyContents hFrom hTo buffer = do
567 count <- hGetBuf hFrom buffer bufferSize
568 when (count > 0) $ do
569 hPutBuf hTo buffer count
570 copyContents hFrom hTo buffer
573 -- | Given path referring to a file or directory, returns a
574 -- canonicalized path, with the intent that two paths referring
575 -- to the same file\/directory will map to the same canonicalized
576 -- path. Note that it is impossible to guarantee that the
577 -- implication (same file\/dir \<=\> same canonicalizedPath) holds
578 -- in either direction: this function can make only a best-effort
580 canonicalizePath :: FilePath -> IO FilePath
581 canonicalizePath fpath =
582 withCString fpath $ \pInPath ->
583 allocaBytes long_path_size $ \pOutPath ->
584 #if defined(mingw32_HOST_OS)
585 alloca $ \ppFilePart ->
586 do c_GetFullPathName pInPath (fromIntegral long_path_size) pOutPath ppFilePart
588 do c_realpath pInPath pOutPath
590 path <- peekCString pOutPath
591 return (normalise path)
592 -- normalise does more stuff, like upper-casing the drive letter
594 #if defined(mingw32_HOST_OS)
595 foreign import stdcall unsafe "GetFullPathNameA"
596 c_GetFullPathName :: CString
602 foreign import ccall unsafe "realpath"
603 c_realpath :: CString
608 -- | 'makeRelative' the current directory.
609 makeRelativeToCurrentDirectory :: FilePath -> IO FilePath
610 makeRelativeToCurrentDirectory x = do
611 cur <- getCurrentDirectory
612 return $ makeRelative cur x
614 -- | Given an executable file name, searches for such file
615 -- in the directories listed in system PATH. The returned value
616 -- is the path to the found executable or Nothing if there isn't
617 -- such executable. For example (findExecutable \"ghc\")
618 -- gives you the path to GHC.
619 findExecutable :: String -> IO (Maybe FilePath)
620 findExecutable binary =
621 #if defined(mingw32_HOST_OS)
622 withCString binary $ \c_binary ->
623 withCString ('.':exeExtension) $ \c_ext ->
624 allocaBytes long_path_size $ \pOutPath ->
625 alloca $ \ppFilePart -> do
626 res <- c_SearchPath nullPtr c_binary c_ext (fromIntegral long_path_size) pOutPath ppFilePart
627 if res > 0 && res < fromIntegral long_path_size
628 then do fpath <- peekCString pOutPath
632 foreign import stdcall unsafe "SearchPathA"
633 c_SearchPath :: CString
642 path <- getEnv "PATH"
643 search (splitSearchPath path)
645 fileName = binary <.> exeExtension
647 search :: [FilePath] -> IO (Maybe FilePath)
648 search [] = return Nothing
650 let path = d </> fileName
651 b <- doesFileExist path
652 if b then return (Just path)
657 #ifdef __GLASGOW_HASKELL__
658 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
661 The operation may fail with:
664 A physical I\/O error has occurred.
668 The operand is not a valid directory name.
669 @[ENAMETOOLONG, ELOOP]@
671 * 'isDoesNotExistError' \/ 'NoSuchThing'
672 The directory does not exist.
675 * 'isPermissionError' \/ 'PermissionDenied'
676 The process has insufficient privileges to perform the operation.
679 * 'ResourceExhausted'
680 Insufficient resources are available to perform the operation.
683 * 'InappropriateType'
684 The path refers to an existing non-directory object.
689 getDirectoryContents :: FilePath -> IO [FilePath]
690 getDirectoryContents path = do
691 modifyIOError (`ioeSetFileName` path) $
692 alloca $ \ ptr_dEnt ->
694 (withCString path $ \s ->
695 throwErrnoIfNullRetry desc (c_opendir s))
696 (\p -> throwErrnoIfMinus1_ desc (c_closedir p))
697 (\p -> loop ptr_dEnt p)
699 desc = "getDirectoryContents"
701 loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
702 loop ptr_dEnt dir = do
704 r <- readdir dir ptr_dEnt
707 dEnt <- peek ptr_dEnt
711 entry <- (d_name dEnt >>= peekCString)
713 entries <- loop ptr_dEnt dir
714 return (entry:entries)
715 else do errno <- getErrno
716 if (errno == eINTR) then loop ptr_dEnt dir else do
717 let (Errno eo) = errno
718 if (eo == end_of_dir)
724 {- |If the operating system has a notion of current directories,
725 'getCurrentDirectory' returns an absolute path to the
726 current directory of the calling process.
728 The operation may fail with:
731 A physical I\/O error has occurred.
734 * 'isDoesNotExistError' \/ 'NoSuchThing'
735 There is no path referring to the current directory.
736 @[EPERM, ENOENT, ESTALE...]@
738 * 'isPermissionError' \/ 'PermissionDenied'
739 The process has insufficient privileges to perform the operation.
742 * 'ResourceExhausted'
743 Insufficient resources are available to perform the operation.
745 * 'UnsupportedOperation'
746 The operating system has no notion of current directory.
750 getCurrentDirectory :: IO FilePath
751 getCurrentDirectory = do
752 p <- mallocBytes long_path_size
754 where go p bytes = do
755 p' <- c_getcwd p (fromIntegral bytes)
757 then do s <- peekCString p'
760 else do errno <- getErrno
762 then do let bytes' = bytes * 2
763 p'' <- reallocBytes p bytes'
765 else throwErrno "getCurrentDirectory"
767 {- |If the operating system has a notion of current directories,
768 @'setCurrentDirectory' dir@ changes the current
769 directory of the calling process to /dir/.
771 The operation may fail with:
774 A physical I\/O error has occurred.
778 The operand is not a valid directory name.
779 @[ENAMETOOLONG, ELOOP]@
781 * 'isDoesNotExistError' \/ 'NoSuchThing'
782 The directory does not exist.
785 * 'isPermissionError' \/ 'PermissionDenied'
786 The process has insufficient privileges to perform the operation.
789 * 'UnsupportedOperation'
790 The operating system has no notion of current directory, or the
791 current directory cannot be dynamically changed.
793 * 'InappropriateType'
794 The path refers to an existing non-directory object.
799 setCurrentDirectory :: FilePath -> IO ()
800 setCurrentDirectory path = do
801 modifyIOError (`ioeSetFileName` path) $
802 withCString path $ \s ->
803 throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
804 -- ToDo: add path to error
806 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
807 exists and is a directory, and 'False' otherwise.
810 doesDirectoryExist :: FilePath -> IO Bool
811 doesDirectoryExist name =
813 (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
814 (\ _ -> return False)
816 {- |The operation 'doesFileExist' returns 'True'
817 if the argument file exists and is not a directory, and 'False' otherwise.
820 doesFileExist :: FilePath -> IO Bool
821 doesFileExist name = do
823 (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
824 (\ _ -> return False)
826 {- |The 'getModificationTime' operation returns the
827 clock time at which the file or directory was last modified.
829 The operation may fail with:
831 * 'isPermissionError' if the user is not permitted to access
832 the modification time; or
834 * 'isDoesNotExistError' if the file or directory does not exist.
838 getModificationTime :: FilePath -> IO ClockTime
839 getModificationTime name =
840 withFileStatus "getModificationTime" name $ \ st ->
843 withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
844 withFileStatus loc name f = do
845 modifyIOError (`ioeSetFileName` name) $
846 allocaBytes sizeof_stat $ \p ->
847 withCString (fileNameEndClean name) $ \s -> do
848 throwErrnoIfMinus1Retry_ loc (c_stat s p)
851 withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
852 withFileOrSymlinkStatus loc name f = do
853 modifyIOError (`ioeSetFileName` name) $
854 allocaBytes sizeof_stat $ \p ->
855 withCString name $ \s -> do
856 throwErrnoIfMinus1Retry_ loc (lstat s p)
859 modificationTime :: Ptr CStat -> IO ClockTime
860 modificationTime stat = do
861 mtime <- st_mtime stat
862 let realToInteger = round . realToFrac :: Real a => a -> Integer
863 return (TOD (realToInteger (mtime :: CTime)) 0)
865 isDirectory :: Ptr CStat -> IO Bool
866 isDirectory stat = do
868 return (s_isdir mode)
870 fileNameEndClean :: String -> String
871 fileNameEndClean name = if isDrive name then addTrailingPathSeparator name
872 else dropTrailingPathSeparator name
874 foreign import ccall unsafe "__hscore_R_OK" r_OK :: CInt
875 foreign import ccall unsafe "__hscore_W_OK" w_OK :: CInt
876 foreign import ccall unsafe "__hscore_X_OK" x_OK :: CInt
878 foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
879 foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
880 foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode
881 #ifdef mingw32_HOST_OS
882 foreign import ccall unsafe "__hscore_S_IFDIR" s_IFDIR :: CMode
885 foreign import ccall unsafe "__hscore_long_path_size"
886 long_path_size :: Int
889 long_path_size :: Int
890 long_path_size = 2048 -- // guess?
892 #endif /* __GLASGOW_HASKELL__ */
894 {- | Returns the current user's home directory.
896 The directory returned is expected to be writable by the current user,
897 but note that it isn't generally considered good practice to store
898 application-specific data here; use 'getAppUserDataDirectory'
901 On Unix, 'getHomeDirectory' returns the value of the @HOME@
902 environment variable. On Windows, the system is queried for a
903 suitable path; a typical path might be
904 @C:/Documents And Settings/user@.
906 The operation may fail with:
908 * 'UnsupportedOperation'
909 The operating system has no notion of home directory.
911 * 'isDoesNotExistError'
912 The home directory for the current user does not exist, or
915 getHomeDirectory :: IO FilePath
917 #if defined(mingw32_HOST_OS)
918 allocaBytes long_path_size $ \pPath -> do
919 r0 <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
922 r1 <- c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
923 when (r1 < 0) (raiseUnsupported "System.Directory.getHomeDirectory")
930 {- | Returns the pathname of a directory in which application-specific
931 data for the current user can be stored. The result of
932 'getAppUserDataDirectory' for a given application is specific to
935 The argument should be the name of the application, which will be used
936 to construct the pathname (so avoid using unusual characters that
937 might result in an invalid pathname).
939 Note: the directory may not actually exist, and may need to be created
940 first. It is expected that the parent directory exists and is
943 On Unix, this function returns @$HOME\/.appName@. On Windows, a
944 typical path might be
946 > C:/Documents And Settings/user/Application Data/appName
948 The operation may fail with:
950 * 'UnsupportedOperation'
951 The operating system has no notion of application-specific data directory.
953 * 'isDoesNotExistError'
954 The home directory for the current user does not exist, or
957 getAppUserDataDirectory :: String -> IO FilePath
958 getAppUserDataDirectory appName = do
959 #if defined(mingw32_HOST_OS)
960 allocaBytes long_path_size $ \pPath -> do
961 r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
962 when (r<0) (raiseUnsupported "System.Directory.getAppUserDataDirectory")
963 s <- peekCString pPath
964 return (s++'\\':appName)
966 path <- getEnv "HOME"
967 return (path++'/':'.':appName)
970 {- | Returns the current user's document directory.
972 The directory returned is expected to be writable by the current user,
973 but note that it isn't generally considered good practice to store
974 application-specific data here; use 'getAppUserDataDirectory'
977 On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@
978 environment variable. On Windows, the system is queried for a
979 suitable path; a typical path might be
980 @C:\/Documents and Settings\/user\/My Documents@.
982 The operation may fail with:
984 * 'UnsupportedOperation'
985 The operating system has no notion of document directory.
987 * 'isDoesNotExistError'
988 The document directory for the current user does not exist, or
991 getUserDocumentsDirectory :: IO FilePath
992 getUserDocumentsDirectory = do
993 #if defined(mingw32_HOST_OS)
994 allocaBytes long_path_size $ \pPath -> do
995 r <- c_SHGetFolderPath nullPtr csidl_PERSONAL nullPtr 0 pPath
996 when (r<0) (raiseUnsupported "System.Directory.getUserDocumentsDirectory")
1002 {- | Returns the current directory for temporary files.
1004 On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@
1005 environment variable or \"\/tmp\" if the variable isn\'t defined.
1006 On Windows, the function checks for the existence of environment variables in
1007 the following order and uses the first path found:
1010 TMP environment variable.
1013 TEMP environment variable.
1016 USERPROFILE environment variable.
1019 The Windows directory
1021 The operation may fail with:
1023 * 'UnsupportedOperation'
1024 The operating system has no notion of temporary directory.
1026 The function doesn\'t verify whether the path exists.
1028 getTemporaryDirectory :: IO FilePath
1029 getTemporaryDirectory = do
1030 #if defined(mingw32_HOST_OS)
1031 allocaBytes long_path_size $ \pPath -> do
1032 _r <- c_GetTempPath (fromIntegral long_path_size) pPath
1037 `catch` \ex -> case ex of
1038 IOException e | isDoesNotExistError e -> return "/tmp"
1041 `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"