1 -----------------------------------------------------------------------------
3 -- Module : System.Directory
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/base/LICENSE)
7 -- Maintainer : libraries@haskell.org
9 -- Portability : portable
11 -- System-independent interface to directory manipulation.
13 -----------------------------------------------------------------------------
15 module System.Directory
19 -- * Actions on directories
20 createDirectory -- :: FilePath -> IO ()
21 , createDirectoryIfMissing -- :: Bool -> FilePath -> IO ()
22 , removeDirectory -- :: FilePath -> IO ()
23 , removeDirectoryRecursive -- :: FilePath -> IO ()
24 , renameDirectory -- :: FilePath -> FilePath -> IO ()
26 , getDirectoryContents -- :: FilePath -> IO [FilePath]
27 , getCurrentDirectory -- :: IO FilePath
28 , setCurrentDirectory -- :: FilePath -> IO ()
30 -- * Pre-defined directories
32 , getAppUserDataDirectory
33 , getUserDocumentsDirectory
34 , getTemporaryDirectory
37 , removeFile -- :: FilePath -> IO ()
38 , renameFile -- :: FilePath -> FilePath -> IO ()
39 , copyFile -- :: FilePath -> FilePath -> IO ()
42 , makeRelativeToCurrentDirectory
46 , doesFileExist -- :: FilePath -> IO Bool
47 , doesDirectoryExist -- :: FilePath -> IO Bool
55 readable, -- :: Permissions -> Bool
56 writable, -- :: Permissions -> Bool
57 executable, -- :: Permissions -> Bool
58 searchable -- :: Permissions -> Bool
61 , getPermissions -- :: FilePath -> IO Permissions
62 , setPermissions -- :: FilePath -> Permissions -> IO ()
66 , getModificationTime -- :: FilePath -> IO ClockTime
69 import Prelude hiding ( catch )
71 import System.Environment ( getEnv )
72 import System.FilePath
74 import System.IO.Error hiding ( catch, try )
75 import Control.Monad ( when, unless )
76 import Control.Exception
80 import System (system)
90 {-# CFILES cbits/directory.c #-}
92 #ifdef __GLASGOW_HASKELL__
93 import System.Posix.Types
94 import System.Posix.Internals
95 import System.Time ( ClockTime(..) )
97 import GHC.IOBase ( IOException(..), IOErrorType(..), ioException )
100 A directory contains a series of entries, each of which is a named
101 reference to a file system object (file, directory etc.). Some
102 entries may be hidden, inaccessible, or have some administrative
103 function (e.g. `.' or `..' under POSIX
104 <http://www.opengroup.org/onlinepubs/009695399/>), but in
105 this standard all such entries are considered to form part of the
106 directory contents. Entries in sub-directories are not, however,
107 considered to form part of the directory contents.
109 Each file system object is referenced by a /path/. There is
110 normally at least one absolute path to each file system object. In
111 some operating systems, it may also be possible to have paths which
112 are relative to the current directory.
115 -----------------------------------------------------------------------------
120 The 'Permissions' type is used to record whether certain operations are
121 permissible on a file\/directory. 'getPermissions' and 'setPermissions'
122 get and set these permissions, respectively. Permissions apply both to
123 files and directories. For directories, the executable field will be
124 'False', and for files the searchable field will be 'False'. Note that
125 directories may be searchable without being readable, if permission has
126 been given to use them as part of a path, but not to examine the
129 Note that to change some, but not all permissions, a construct on the following lines must be used.
131 > makeReadable f = do
132 > p <- getPermissions f
133 > setPermissions f (p {readable = True})
140 executable, searchable :: Bool
141 } deriving (Eq, Ord, Read, Show)
143 {- |The 'getPermissions' operation returns the
144 permissions for the file or directory.
146 The operation may fail with:
148 * 'isPermissionError' if the user is not permitted to access
151 * 'isDoesNotExistError' if the file or directory does not exist.
155 getPermissions :: FilePath -> IO Permissions
156 getPermissions name = do
157 withCString name $ \s -> do
158 #ifdef mingw32_HOST_OS
159 -- stat() does a better job of guessing the permissions on Windows
160 -- than access() does. e.g. for execute permission, it looks at the
161 -- filename extension :-)
163 -- I tried for a while to do this properly, using the Windows security API,
164 -- and eventually gave up. getPermissions is a flawed API anyway. -- SimonM
165 allocaBytes sizeof_stat $ \ p_stat -> do
166 throwErrnoIfMinus1_ "getPermissions" $ c_stat s p_stat
167 mode <- st_mode p_stat
168 let read = mode .&. s_IRUSR
169 let write = mode .&. s_IWUSR
170 let exec = mode .&. s_IXUSR
171 let is_dir = mode .&. s_IFDIR
174 readable = read /= 0,
175 writable = write /= 0,
176 executable = is_dir == 0 && exec /= 0,
177 searchable = is_dir /= 0 && exec /= 0
181 read <- c_access s r_OK
182 write <- c_access s w_OK
183 exec <- c_access s x_OK
184 withFileStatus "getPermissions" name $ \st -> do
185 is_dir <- isDirectory st
188 readable = read == 0,
189 writable = write == 0,
190 executable = not is_dir && exec == 0,
191 searchable = is_dir && exec == 0
196 {- |The 'setPermissions' operation sets the
197 permissions for the file or directory.
199 The operation may fail with:
201 * 'isPermissionError' if the user is not permitted to set
204 * 'isDoesNotExistError' if the file or directory does not exist.
208 setPermissions :: FilePath -> Permissions -> IO ()
209 setPermissions name (Permissions r w e s) = do
210 allocaBytes sizeof_stat $ \ p_stat -> do
211 withCString name $ \p_name -> do
212 throwErrnoIfMinus1_ "setPermissions" $ do
214 mode <- st_mode p_stat
215 let mode1 = modifyBit r mode s_IRUSR
216 let mode2 = modifyBit w mode1 s_IWUSR
217 let mode3 = modifyBit (e || s) mode2 s_IXUSR
221 modifyBit :: Bool -> CMode -> CMode -> CMode
222 modifyBit False m b = m .&. (complement b)
223 modifyBit True m b = m .|. b
226 copyPermissions :: FilePath -> FilePath -> IO ()
227 copyPermissions source dest = do
228 allocaBytes sizeof_stat $ \ p_stat -> do
229 withCString source $ \p_source -> do
230 withCString dest $ \p_dest -> do
231 throwErrnoIfMinus1_ "copyPermissions" $ c_stat p_source p_stat
232 mode <- st_mode p_stat
233 throwErrnoIfMinus1_ "copyPermissions" $ c_chmod p_dest mode
235 -----------------------------------------------------------------------------
238 {- |@'createDirectory' dir@ creates a new directory @dir@ which is
239 initially empty, or as near to empty as the operating system
242 The operation may fail with:
244 * 'isPermissionError' \/ 'PermissionDenied'
245 The process has insufficient privileges to perform the operation.
248 * 'isAlreadyExistsError' \/ 'AlreadyExists'
249 The operand refers to a directory that already exists.
253 A physical I\/O error has occurred.
257 The operand is not a valid directory name.
258 @[ENAMETOOLONG, ELOOP]@
261 There is no path to the directory.
264 * 'ResourceExhausted'
265 Insufficient resources (virtual memory, process file descriptors,
266 physical disk space, etc.) are available to perform the operation.
267 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
269 * 'InappropriateType'
270 The path refers to an existing non-directory object.
275 createDirectory :: FilePath -> IO ()
276 createDirectory path = do
277 modifyIOError (`ioeSetFileName` path) $
278 withCString path $ \s -> do
279 throwErrnoIfMinus1Retry_ "createDirectory" $
282 #else /* !__GLASGOW_HASKELL__ */
284 copyPermissions :: FilePath -> FilePath -> IO ()
285 copyPermissions fromFPath toFPath
286 = getPermissions fromFPath >>= setPermissions toFPath
290 -- | @'createDirectoryIfMissing' parents dir@ creates a new directory
291 -- @dir@ if it doesn\'t exist. If the first argument is 'True'
292 -- the function will also create all parent directories if they are missing.
293 createDirectoryIfMissing :: Bool -- ^ Create its parents too?
294 -> FilePath -- ^ The path to the directory you want to make
296 createDirectoryIfMissing parents file = do
297 b <- doesDirectoryExist file
298 case (b,parents, file) of
299 (_, _, "") -> return ()
300 (True, _, _) -> return ()
301 (_, True, _) -> mapM_ (createDirectoryIfMissing False) $ mkParents file
302 (_, False, _) -> createDirectory file
303 where mkParents = scanl1 (</>) . splitDirectories . normalise
305 #if __GLASGOW_HASKELL__
306 {- | @'removeDirectory' dir@ removes an existing directory /dir/. The
307 implementation may specify additional constraints which must be
308 satisfied before a directory can be removed (e.g. the directory has to
309 be empty, or may not be in use by other processes). It is not legal
310 for an implementation to partially remove a directory unless the
311 entire directory is removed. A conformant implementation need not
312 support directory removal in all situations (e.g. removal of the root
315 The operation may fail with:
318 A physical I\/O error has occurred.
322 The operand is not a valid directory name.
323 [ENAMETOOLONG, ELOOP]
325 * 'isDoesNotExistError' \/ 'NoSuchThing'
326 The directory does not exist.
329 * 'isPermissionError' \/ 'PermissionDenied'
330 The process has insufficient privileges to perform the operation.
331 @[EROFS, EACCES, EPERM]@
333 * 'UnsatisfiedConstraints'
334 Implementation-dependent constraints are not satisfied.
335 @[EBUSY, ENOTEMPTY, EEXIST]@
337 * 'UnsupportedOperation'
338 The implementation does not support removal in this situation.
341 * 'InappropriateType'
342 The operand refers to an existing non-directory object.
347 removeDirectory :: FilePath -> IO ()
348 removeDirectory path = do
349 modifyIOError (`ioeSetFileName` path) $
350 withCString path $ \s ->
351 throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
354 -- | @'removeDirectoryRecursive' dir@ removes an existing directory /dir/
355 -- together with its content and all subdirectories. Be careful,
356 -- if the directory contains symlinks, the function will follow them.
357 removeDirectoryRecursive :: FilePath -> IO ()
358 removeDirectoryRecursive startLoc = do
359 cont <- getDirectoryContents startLoc
360 sequence_ [rm (startLoc </> x) | x <- cont, x /= "." && x /= ".."]
361 removeDirectory startLoc
363 rm :: FilePath -> IO ()
364 rm f = do temp <- try (removeFile f)
366 Left e -> do isDir <- doesDirectoryExist f
367 -- If f is not a directory, re-throw the error
368 unless isDir $ throw e
369 removeDirectoryRecursive f
372 #if __GLASGOW_HASKELL__
373 {- |'removeFile' /file/ removes the directory entry for an existing file
374 /file/, where /file/ is not itself a directory. The
375 implementation may specify additional constraints which must be
376 satisfied before a file can be removed (e.g. the file may not be in
377 use by other processes).
379 The operation may fail with:
382 A physical I\/O error has occurred.
386 The operand is not a valid file name.
387 @[ENAMETOOLONG, ELOOP]@
389 * 'isDoesNotExistError' \/ 'NoSuchThing'
390 The file does not exist.
393 * 'isPermissionError' \/ 'PermissionDenied'
394 The process has insufficient privileges to perform the operation.
395 @[EROFS, EACCES, EPERM]@
397 * 'UnsatisfiedConstraints'
398 Implementation-dependent constraints are not satisfied.
401 * 'InappropriateType'
402 The operand refers to an existing directory.
407 removeFile :: FilePath -> IO ()
409 modifyIOError (`ioeSetFileName` path) $
410 withCString path $ \s ->
411 throwErrnoIfMinus1Retry_ "removeFile" (c_unlink s)
413 {- |@'renameDirectory' old new@ changes the name of an existing
414 directory from /old/ to /new/. If the /new/ directory
415 already exists, it is atomically replaced by the /old/ directory.
416 If the /new/ directory is neither the /old/ directory nor an
417 alias of the /old/ directory, it is removed as if by
418 'removeDirectory'. A conformant implementation need not support
419 renaming directories in all situations (e.g. renaming to an existing
420 directory, or across different physical devices), but the constraints
423 On Win32 platforms, @renameDirectory@ fails if the /new/ directory already
426 The operation may fail with:
429 A physical I\/O error has occurred.
433 Either operand is not a valid directory name.
434 @[ENAMETOOLONG, ELOOP]@
436 * 'isDoesNotExistError' \/ 'NoSuchThing'
437 The original directory does not exist, or there is no path to the target.
440 * 'isPermissionError' \/ 'PermissionDenied'
441 The process has insufficient privileges to perform the operation.
442 @[EROFS, EACCES, EPERM]@
444 * 'ResourceExhausted'
445 Insufficient resources are available to perform the operation.
446 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
448 * 'UnsatisfiedConstraints'
449 Implementation-dependent constraints are not satisfied.
450 @[EBUSY, ENOTEMPTY, EEXIST]@
452 * 'UnsupportedOperation'
453 The implementation does not support renaming in this situation.
456 * 'InappropriateType'
457 Either path refers to an existing non-directory object.
462 renameDirectory :: FilePath -> FilePath -> IO ()
463 renameDirectory opath npath =
464 withFileStatus "renameDirectory" opath $ \st -> do
465 is_dir <- isDirectory st
467 then ioException (IOError Nothing InappropriateType "renameDirectory"
468 ("not a directory") (Just opath))
471 withCString opath $ \s1 ->
472 withCString npath $ \s2 ->
473 throwErrnoIfMinus1Retry_ "renameDirectory" (c_rename s1 s2)
475 {- |@'renameFile' old new@ changes the name of an existing file system
476 object from /old/ to /new/. If the /new/ object already
477 exists, it is atomically replaced by the /old/ object. Neither
478 path may refer to an existing directory. A conformant implementation
479 need not support renaming files in all situations (e.g. renaming
480 across different physical devices), but the constraints must be
483 The operation may fail with:
486 A physical I\/O error has occurred.
490 Either operand is not a valid file name.
491 @[ENAMETOOLONG, ELOOP]@
493 * 'isDoesNotExistError' \/ 'NoSuchThing'
494 The original file does not exist, or there is no path to the target.
497 * 'isPermissionError' \/ 'PermissionDenied'
498 The process has insufficient privileges to perform the operation.
499 @[EROFS, EACCES, EPERM]@
501 * 'ResourceExhausted'
502 Insufficient resources are available to perform the operation.
503 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
505 * 'UnsatisfiedConstraints'
506 Implementation-dependent constraints are not satisfied.
509 * 'UnsupportedOperation'
510 The implementation does not support renaming in this situation.
513 * 'InappropriateType'
514 Either path refers to an existing directory.
515 @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@
519 renameFile :: FilePath -> FilePath -> IO ()
520 renameFile opath npath =
521 withFileOrSymlinkStatus "renameFile" opath $ \st -> do
522 is_dir <- isDirectory st
524 then ioException (IOError Nothing InappropriateType "renameFile"
525 "is a directory" (Just opath))
528 withCString opath $ \s1 ->
529 withCString npath $ \s2 ->
530 throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
532 #endif /* __GLASGOW_HASKELL__ */
534 {- |@'copyFile' old new@ copies the existing file from /old/ to /new/.
535 If the /new/ file already exists, it is atomically replaced by the /old/ file.
536 Neither path may refer to an existing directory. The permissions of /old/ are
537 copied to /new/, if possible.
540 copyFile :: FilePath -> FilePath -> IO ()
542 copyFile fromFPath toFPath =
543 do readFile fromFPath >>= writeFile toFPath
544 try (copyPermissions fromFPath toFPath)
547 copyFile fromFPath toFPath =
548 copy `catch` (\e -> case e of
550 throw $ IOException $ ioeSetLocation e "copyFile"
552 where copy = bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
553 bracketOnError openTmp cleanTmp $ \(tmpFPath, hTmp) ->
554 do allocaBytes bufferSize $ copyContents hFrom hTmp
556 try (copyPermissions fromFPath tmpFPath)
557 renameFile tmpFPath toFPath
558 openTmp = openBinaryTempFile (takeDirectory toFPath) ".copyFile.tmp"
559 cleanTmp (tmpFPath, hTmp) = do try $ hClose hTmp
560 try $ removeFile tmpFPath
563 copyContents hFrom hTo buffer = do
564 count <- hGetBuf hFrom buffer bufferSize
565 when (count > 0) $ do
566 hPutBuf hTo buffer count
567 copyContents hFrom hTo buffer
570 -- | Given path referring to a file or directory, returns a
571 -- canonicalized path, with the intent that two paths referring
572 -- to the same file\/directory will map to the same canonicalized
573 -- path. Note that it is impossible to guarantee that the
574 -- implication (same file\/dir \<=\> same canonicalizedPath) holds
575 -- in either direction: this function can make only a best-effort
577 canonicalizePath :: FilePath -> IO FilePath
578 canonicalizePath fpath =
579 withCString fpath $ \pInPath ->
580 allocaBytes long_path_size $ \pOutPath ->
581 #if defined(mingw32_HOST_OS)
582 alloca $ \ppFilePart ->
583 do c_GetFullPathName pInPath (fromIntegral long_path_size) pOutPath ppFilePart
585 do c_realpath pInPath pOutPath
587 path <- peekCString pOutPath
588 return (normalise path)
589 -- normalise does more stuff, like upper-casing the drive letter
591 #if defined(mingw32_HOST_OS)
592 foreign import stdcall unsafe "GetFullPathNameA"
593 c_GetFullPathName :: CString
599 foreign import ccall unsafe "realpath"
600 c_realpath :: CString
605 -- | 'makeRelative' the current directory.
606 makeRelativeToCurrentDirectory :: FilePath -> IO FilePath
607 makeRelativeToCurrentDirectory x = do
608 cur <- getCurrentDirectory
609 return $ makeRelative cur x
611 -- | Given an executable file name, searches for such file
612 -- in the directories listed in system PATH. The returned value
613 -- is the path to the found executable or Nothing if there isn't
614 -- such executable. For example (findExecutable \"ghc\")
615 -- gives you the path to GHC.
616 findExecutable :: String -> IO (Maybe FilePath)
617 findExecutable binary =
618 #if defined(mingw32_HOST_OS)
619 withCString binary $ \c_binary ->
620 withCString ('.':exeExtension) $ \c_ext ->
621 allocaBytes long_path_size $ \pOutPath ->
622 alloca $ \ppFilePart -> do
623 res <- c_SearchPath nullPtr c_binary c_ext (fromIntegral long_path_size) pOutPath ppFilePart
624 if res > 0 && res < fromIntegral long_path_size
625 then do fpath <- peekCString pOutPath
629 foreign import stdcall unsafe "SearchPathA"
630 c_SearchPath :: CString
639 path <- getEnv "PATH"
640 search (splitSearchPath path)
642 fileName = binary <.> exeExtension
644 search :: [FilePath] -> IO (Maybe FilePath)
645 search [] = return Nothing
647 let path = d </> fileName
648 b <- doesFileExist path
649 if b then return (Just path)
654 #ifdef __GLASGOW_HASKELL__
655 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
658 The operation may fail with:
661 A physical I\/O error has occurred.
665 The operand is not a valid directory name.
666 @[ENAMETOOLONG, ELOOP]@
668 * 'isDoesNotExistError' \/ 'NoSuchThing'
669 The directory does not exist.
672 * 'isPermissionError' \/ 'PermissionDenied'
673 The process has insufficient privileges to perform the operation.
676 * 'ResourceExhausted'
677 Insufficient resources are available to perform the operation.
680 * 'InappropriateType'
681 The path refers to an existing non-directory object.
686 getDirectoryContents :: FilePath -> IO [FilePath]
687 getDirectoryContents path = do
688 modifyIOError (`ioeSetFileName` path) $
689 alloca $ \ ptr_dEnt ->
691 (withCString path $ \s ->
692 throwErrnoIfNullRetry desc (c_opendir s))
693 (\p -> throwErrnoIfMinus1_ desc (c_closedir p))
694 (\p -> loop ptr_dEnt p)
696 desc = "getDirectoryContents"
698 loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
699 loop ptr_dEnt dir = do
701 r <- readdir dir ptr_dEnt
704 dEnt <- peek ptr_dEnt
708 entry <- (d_name dEnt >>= peekCString)
710 entries <- loop ptr_dEnt dir
711 return (entry:entries)
712 else do errno <- getErrno
713 if (errno == eINTR) then loop ptr_dEnt dir else do
714 let (Errno eo) = errno
715 if (eo == end_of_dir)
721 {- |If the operating system has a notion of current directories,
722 'getCurrentDirectory' returns an absolute path to the
723 current directory of the calling process.
725 The operation may fail with:
728 A physical I\/O error has occurred.
731 * 'isDoesNotExistError' \/ 'NoSuchThing'
732 There is no path referring to the current directory.
733 @[EPERM, ENOENT, ESTALE...]@
735 * 'isPermissionError' \/ 'PermissionDenied'
736 The process has insufficient privileges to perform the operation.
739 * 'ResourceExhausted'
740 Insufficient resources are available to perform the operation.
742 * 'UnsupportedOperation'
743 The operating system has no notion of current directory.
747 getCurrentDirectory :: IO FilePath
748 getCurrentDirectory = do
749 p <- mallocBytes long_path_size
751 where go p bytes = do
752 p' <- c_getcwd p (fromIntegral bytes)
754 then do s <- peekCString p'
757 else do errno <- getErrno
759 then do let bytes' = bytes * 2
760 p' <- reallocBytes p bytes'
762 else throwErrno "getCurrentDirectory"
764 {- |If the operating system has a notion of current directories,
765 @'setCurrentDirectory' dir@ changes the current
766 directory of the calling process to /dir/.
768 The operation may fail with:
771 A physical I\/O error has occurred.
775 The operand is not a valid directory name.
776 @[ENAMETOOLONG, ELOOP]@
778 * 'isDoesNotExistError' \/ 'NoSuchThing'
779 The directory does not exist.
782 * 'isPermissionError' \/ 'PermissionDenied'
783 The process has insufficient privileges to perform the operation.
786 * 'UnsupportedOperation'
787 The operating system has no notion of current directory, or the
788 current directory cannot be dynamically changed.
790 * 'InappropriateType'
791 The path refers to an existing non-directory object.
796 setCurrentDirectory :: FilePath -> IO ()
797 setCurrentDirectory path = do
798 modifyIOError (`ioeSetFileName` path) $
799 withCString path $ \s ->
800 throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
801 -- ToDo: add path to error
803 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
804 exists and is a directory, and 'False' otherwise.
807 doesDirectoryExist :: FilePath -> IO Bool
808 doesDirectoryExist name =
810 (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
811 (\ _ -> return False)
813 {- |The operation 'doesFileExist' returns 'True'
814 if the argument file exists and is not a directory, and 'False' otherwise.
817 doesFileExist :: FilePath -> IO Bool
818 doesFileExist name = do
820 (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
821 (\ _ -> return False)
823 {- |The 'getModificationTime' operation returns the
824 clock time at which the file or directory was last modified.
826 The operation may fail with:
828 * 'isPermissionError' if the user is not permitted to access
829 the modification time; or
831 * 'isDoesNotExistError' if the file or directory does not exist.
835 getModificationTime :: FilePath -> IO ClockTime
836 getModificationTime name =
837 withFileStatus "getModificationTime" name $ \ st ->
840 withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
841 withFileStatus loc name f = do
842 modifyIOError (`ioeSetFileName` name) $
843 allocaBytes sizeof_stat $ \p ->
844 withCString (fileNameEndClean name) $ \s -> do
845 throwErrnoIfMinus1Retry_ loc (c_stat s p)
848 withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
849 withFileOrSymlinkStatus loc name f = do
850 modifyIOError (`ioeSetFileName` name) $
851 allocaBytes sizeof_stat $ \p ->
852 withCString name $ \s -> do
853 throwErrnoIfMinus1Retry_ loc (lstat s p)
856 modificationTime :: Ptr CStat -> IO ClockTime
857 modificationTime stat = do
858 mtime <- st_mtime stat
859 let realToInteger = round . realToFrac :: Real a => a -> Integer
860 return (TOD (realToInteger (mtime :: CTime)) 0)
862 isDirectory :: Ptr CStat -> IO Bool
863 isDirectory stat = do
865 return (s_isdir mode)
867 fileNameEndClean :: String -> String
868 fileNameEndClean name = if isDrive name then addTrailingPathSeparator name
869 else dropTrailingPathSeparator name
871 foreign import ccall unsafe "__hscore_R_OK" r_OK :: CInt
872 foreign import ccall unsafe "__hscore_W_OK" w_OK :: CInt
873 foreign import ccall unsafe "__hscore_X_OK" x_OK :: CInt
875 foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
876 foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
877 foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode
878 foreign import ccall unsafe "__hscore_S_IFDIR" s_IFDIR :: CMode
880 foreign import ccall unsafe "__hscore_long_path_size"
881 long_path_size :: Int
884 long_path_size :: Int
885 long_path_size = 2048 -- // guess?
887 #endif /* __GLASGOW_HASKELL__ */
889 {- | Returns the current user's home directory.
891 The directory returned is expected to be writable by the current user,
892 but note that it isn't generally considered good practice to store
893 application-specific data here; use 'getAppUserDataDirectory'
896 On Unix, 'getHomeDirectory' returns the value of the @HOME@
897 environment variable. On Windows, the system is queried for a
898 suitable path; a typical path might be
899 @C:/Documents And Settings/user@.
901 The operation may fail with:
903 * 'UnsupportedOperation'
904 The operating system has no notion of home directory.
906 * 'isDoesNotExistError'
907 The home directory for the current user does not exist, or
910 getHomeDirectory :: IO FilePath
912 #if defined(mingw32_HOST_OS)
913 allocaBytes long_path_size $ \pPath -> do
914 r <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
917 r <- c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
918 when (r < 0) (raiseUnsupported "System.Directory.getHomeDirectory")
925 {- | Returns the pathname of a directory in which application-specific
926 data for the current user can be stored. The result of
927 'getAppUserDataDirectory' for a given application is specific to
930 The argument should be the name of the application, which will be used
931 to construct the pathname (so avoid using unusual characters that
932 might result in an invalid pathname).
934 Note: the directory may not actually exist, and may need to be created
935 first. It is expected that the parent directory exists and is
938 On Unix, this function returns @$HOME\/.appName@. On Windows, a
939 typical path might be
941 > C:/Documents And Settings/user/Application Data/appName
943 The operation may fail with:
945 * 'UnsupportedOperation'
946 The operating system has no notion of application-specific data directory.
948 * 'isDoesNotExistError'
949 The home directory for the current user does not exist, or
952 getAppUserDataDirectory :: String -> IO FilePath
953 getAppUserDataDirectory appName = do
954 #if defined(mingw32_HOST_OS)
955 allocaBytes long_path_size $ \pPath -> do
956 r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
957 when (r<0) (raiseUnsupported "System.Directory.getAppUserDataDirectory")
958 s <- peekCString pPath
959 return (s++'\\':appName)
961 path <- getEnv "HOME"
962 return (path++'/':'.':appName)
965 {- | Returns the current user's document directory.
967 The directory returned is expected to be writable by the current user,
968 but note that it isn't generally considered good practice to store
969 application-specific data here; use 'getAppUserDataDirectory'
972 On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@
973 environment variable. On Windows, the system is queried for a
974 suitable path; a typical path might be
975 @C:\/Documents and Settings\/user\/My Documents@.
977 The operation may fail with:
979 * 'UnsupportedOperation'
980 The operating system has no notion of document directory.
982 * 'isDoesNotExistError'
983 The document directory for the current user does not exist, or
986 getUserDocumentsDirectory :: IO FilePath
987 getUserDocumentsDirectory = do
988 #if defined(mingw32_HOST_OS)
989 allocaBytes long_path_size $ \pPath -> do
990 r <- c_SHGetFolderPath nullPtr csidl_PERSONAL nullPtr 0 pPath
991 when (r<0) (raiseUnsupported "System.Directory.getUserDocumentsDirectory")
997 {- | Returns the current directory for temporary files.
999 On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@
1000 environment variable or \"\/tmp\" if the variable isn\'t defined.
1001 On Windows, the function checks for the existence of environment variables in
1002 the following order and uses the first path found:
1005 TMP environment variable.
1008 TEMP environment variable.
1011 USERPROFILE environment variable.
1014 The Windows directory
1016 The operation may fail with:
1018 * 'UnsupportedOperation'
1019 The operating system has no notion of temporary directory.
1021 The function doesn\'t verify whether the path exists.
1023 getTemporaryDirectory :: IO FilePath
1024 getTemporaryDirectory = do
1025 #if defined(mingw32_HOST_OS)
1026 allocaBytes long_path_size $ \pPath -> do
1027 r <- c_GetTempPath (fromIntegral long_path_size) pPath
1032 `catch` \ex -> case ex of
1033 IOException e | isDoesNotExistError e -> return "/tmp"
1036 `catch` (\ex -> return "/tmp")
1040 #if defined(mingw32_HOST_OS)
1041 foreign import ccall unsafe "__hscore_getFolderPath"
1042 c_SHGetFolderPath :: Ptr ()
1048 foreign import ccall unsafe "__hscore_CSIDL_PROFILE" csidl_PROFILE :: CInt
1049 foreign import ccall unsafe "__hscore_CSIDL_APPDATA" csidl_APPDATA :: CInt
1050 foreign import ccall unsafe "__hscore_CSIDL_WINDOWS" csidl_WINDOWS :: CInt
1051 foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt
1053 foreign import stdcall unsafe "GetTempPathA" c_GetTempPath :: CInt -> CString -> IO CInt
1055 raiseUnsupported loc =
1056 ioException (IOError Nothing UnsupportedOperation loc "unsupported operation" Nothing)
1060 -- ToDo: This should be determined via autoconf (AC_EXEEXT)
1061 -- | Extension for executable files
1062 -- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
1063 exeExtension :: String
1064 #ifdef mingw32_HOST_OS
1065 exeExtension = "exe"