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
73 import System.IO.Error hiding ( catch, try )
74 import Control.Monad ( when, unless )
75 import Control.Exception
79 import System (system)
89 {-# CFILES cbits/directory.c #-}
91 #ifdef __GLASGOW_HASKELL__
92 import System.Posix.Types
93 import System.Posix.Internals
94 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/007904975/toc.htm>), 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
589 #if defined(mingw32_HOST_OS)
590 foreign import stdcall unsafe "GetFullPathNameA"
591 c_GetFullPathName :: CString
597 foreign import ccall unsafe "realpath"
598 c_realpath :: CString
603 -- | 'makeRelative' the current directory.
604 makeRelativeToCurrentDirectory :: FilePath -> IO FilePath
605 makeRelativeToCurrentDirectory x = do
606 cur <- getCurrentDirectory
607 return $ makeRelative cur x
609 -- | Given an executable file name, searches for such file
610 -- in the directories listed in system PATH. The returned value
611 -- is the path to the found executable or Nothing if there isn't
612 -- such executable. For example (findExecutable \"ghc\")
613 -- gives you the path to GHC.
614 findExecutable :: String -> IO (Maybe FilePath)
615 findExecutable binary =
616 #if defined(mingw32_HOST_OS)
617 withCString binary $ \c_binary ->
618 withCString ('.':exeExtension) $ \c_ext ->
619 allocaBytes long_path_size $ \pOutPath ->
620 alloca $ \ppFilePart -> do
621 res <- c_SearchPath nullPtr c_binary c_ext (fromIntegral long_path_size) pOutPath ppFilePart
622 if res > 0 && res < fromIntegral long_path_size
623 then do fpath <- peekCString pOutPath
627 foreign import stdcall unsafe "SearchPathA"
628 c_SearchPath :: CString
637 path <- getEnv "PATH"
638 search (splitSearchPath path)
640 fileName = binary <.> exeExtension
642 search :: [FilePath] -> IO (Maybe FilePath)
643 search [] = return Nothing
645 let path = d </> fileName
646 b <- doesFileExist path
647 if b then return (Just path)
652 #ifdef __GLASGOW_HASKELL__
653 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
656 The operation may fail with:
659 A physical I\/O error has occurred.
663 The operand is not a valid directory name.
664 @[ENAMETOOLONG, ELOOP]@
666 * 'isDoesNotExistError' \/ 'NoSuchThing'
667 The directory does not exist.
670 * 'isPermissionError' \/ 'PermissionDenied'
671 The process has insufficient privileges to perform the operation.
674 * 'ResourceExhausted'
675 Insufficient resources are available to perform the operation.
678 * 'InappropriateType'
679 The path refers to an existing non-directory object.
684 getDirectoryContents :: FilePath -> IO [FilePath]
685 getDirectoryContents path = do
686 modifyIOError (`ioeSetFileName` path) $
687 alloca $ \ ptr_dEnt ->
689 (withCString path $ \s ->
690 throwErrnoIfNullRetry desc (c_opendir s))
691 (\p -> throwErrnoIfMinus1_ desc (c_closedir p))
692 (\p -> loop ptr_dEnt p)
694 desc = "getDirectoryContents"
696 loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
697 loop ptr_dEnt dir = do
699 r <- readdir dir ptr_dEnt
702 dEnt <- peek ptr_dEnt
706 entry <- (d_name dEnt >>= peekCString)
708 entries <- loop ptr_dEnt dir
709 return (entry:entries)
710 else do errno <- getErrno
711 if (errno == eINTR) then loop ptr_dEnt dir else do
712 let (Errno eo) = errno
713 if (eo == end_of_dir)
719 {- |If the operating system has a notion of current directories,
720 'getCurrentDirectory' returns an absolute path to the
721 current directory of the calling process.
723 The operation may fail with:
726 A physical I\/O error has occurred.
729 * 'isDoesNotExistError' \/ 'NoSuchThing'
730 There is no path referring to the current directory.
731 @[EPERM, ENOENT, ESTALE...]@
733 * 'isPermissionError' \/ 'PermissionDenied'
734 The process has insufficient privileges to perform the operation.
737 * 'ResourceExhausted'
738 Insufficient resources are available to perform the operation.
740 * 'UnsupportedOperation'
741 The operating system has no notion of current directory.
745 getCurrentDirectory :: IO FilePath
746 getCurrentDirectory = do
747 p <- mallocBytes long_path_size
749 where go p bytes = do
750 p' <- c_getcwd p (fromIntegral bytes)
752 then do s <- peekCString p'
755 else do errno <- getErrno
757 then do let bytes' = bytes * 2
758 p' <- reallocBytes p bytes'
760 else throwErrno "getCurrentDirectory"
762 {- |If the operating system has a notion of current directories,
763 @'setCurrentDirectory' dir@ changes the current
764 directory of the calling process to /dir/.
766 The operation may fail with:
769 A physical I\/O error has occurred.
773 The operand is not a valid directory name.
774 @[ENAMETOOLONG, ELOOP]@
776 * 'isDoesNotExistError' \/ 'NoSuchThing'
777 The directory does not exist.
780 * 'isPermissionError' \/ 'PermissionDenied'
781 The process has insufficient privileges to perform the operation.
784 * 'UnsupportedOperation'
785 The operating system has no notion of current directory, or the
786 current directory cannot be dynamically changed.
788 * 'InappropriateType'
789 The path refers to an existing non-directory object.
794 setCurrentDirectory :: FilePath -> IO ()
795 setCurrentDirectory path = do
796 modifyIOError (`ioeSetFileName` path) $
797 withCString path $ \s ->
798 throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
799 -- ToDo: add path to error
801 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
802 exists and is a directory, and 'False' otherwise.
805 doesDirectoryExist :: FilePath -> IO Bool
806 doesDirectoryExist name =
808 (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
809 (\ _ -> return False)
811 {- |The operation 'doesFileExist' returns 'True'
812 if the argument file exists and is not a directory, and 'False' otherwise.
815 doesFileExist :: FilePath -> IO Bool
816 doesFileExist name = do
818 (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
819 (\ _ -> return False)
821 {- |The 'getModificationTime' operation returns the
822 clock time at which the file or directory was last modified.
824 The operation may fail with:
826 * 'isPermissionError' if the user is not permitted to access
827 the modification time; or
829 * 'isDoesNotExistError' if the file or directory does not exist.
833 getModificationTime :: FilePath -> IO ClockTime
834 getModificationTime name =
835 withFileStatus "getModificationTime" name $ \ st ->
838 withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
839 withFileStatus loc name f = do
840 modifyIOError (`ioeSetFileName` name) $
841 allocaBytes sizeof_stat $ \p ->
842 withCString (fileNameEndClean name) $ \s -> do
843 throwErrnoIfMinus1Retry_ loc (c_stat s p)
846 withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
847 withFileOrSymlinkStatus loc name f = do
848 modifyIOError (`ioeSetFileName` name) $
849 allocaBytes sizeof_stat $ \p ->
850 withCString name $ \s -> do
851 throwErrnoIfMinus1Retry_ loc (lstat s p)
854 modificationTime :: Ptr CStat -> IO ClockTime
855 modificationTime stat = do
856 mtime <- st_mtime stat
857 let realToInteger = round . realToFrac :: Real a => a -> Integer
858 return (TOD (realToInteger (mtime :: CTime)) 0)
860 isDirectory :: Ptr CStat -> IO Bool
861 isDirectory stat = do
863 return (s_isdir mode)
865 fileNameEndClean :: String -> String
866 fileNameEndClean name = if isDrive name then addTrailingPathSeparator name
867 else dropTrailingPathSeparator name
869 foreign import ccall unsafe "__hscore_R_OK" r_OK :: CInt
870 foreign import ccall unsafe "__hscore_W_OK" w_OK :: CInt
871 foreign import ccall unsafe "__hscore_X_OK" x_OK :: CInt
873 foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
874 foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
875 foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode
876 foreign import ccall unsafe "__hscore_S_IFDIR" s_IFDIR :: CMode
878 foreign import ccall unsafe "__hscore_long_path_size"
879 long_path_size :: Int
882 long_path_size :: Int
883 long_path_size = 2048 -- // guess?
885 #endif /* __GLASGOW_HASKELL__ */
887 {- | Returns the current user's home directory.
889 The directory returned is expected to be writable by the current user,
890 but note that it isn't generally considered good practice to store
891 application-specific data here; use 'getAppUserDataDirectory'
894 On Unix, 'getHomeDirectory' returns the value of the @HOME@
895 environment variable. On Windows, the system is queried for a
896 suitable path; a typical path might be
897 @C:/Documents And Settings/user@.
899 The operation may fail with:
901 * 'UnsupportedOperation'
902 The operating system has no notion of home directory.
904 * 'isDoesNotExistError'
905 The home directory for the current user does not exist, or
908 getHomeDirectory :: IO FilePath
910 #if defined(mingw32_HOST_OS)
911 allocaBytes long_path_size $ \pPath -> do
912 r <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
915 r <- c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
916 when (r < 0) (raiseUnsupported "System.Directory.getHomeDirectory")
923 {- | Returns the pathname of a directory in which application-specific
924 data for the current user can be stored. The result of
925 'getAppUserDataDirectory' for a given application is specific to
928 The argument should be the name of the application, which will be used
929 to construct the pathname (so avoid using unusual characters that
930 might result in an invalid pathname).
932 Note: the directory may not actually exist, and may need to be created
933 first. It is expected that the parent directory exists and is
936 On Unix, this function returns @$HOME\/.appName@. On Windows, a
937 typical path might be
939 > C:/Documents And Settings/user/Application Data/appName
941 The operation may fail with:
943 * 'UnsupportedOperation'
944 The operating system has no notion of application-specific data directory.
946 * 'isDoesNotExistError'
947 The home directory for the current user does not exist, or
950 getAppUserDataDirectory :: String -> IO FilePath
951 getAppUserDataDirectory appName = do
952 #if defined(mingw32_HOST_OS)
953 allocaBytes long_path_size $ \pPath -> do
954 r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
955 when (r<0) (raiseUnsupported "System.Directory.getAppUserDataDirectory")
956 s <- peekCString pPath
957 return (s++'\\':appName)
959 path <- getEnv "HOME"
960 return (path++'/':'.':appName)
963 {- | Returns the current user's document directory.
965 The directory returned is expected to be writable by the current user,
966 but note that it isn't generally considered good practice to store
967 application-specific data here; use 'getAppUserDataDirectory'
970 On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@
971 environment variable. On Windows, the system is queried for a
972 suitable path; a typical path might be
973 @C:\/Documents and Settings\/user\/My Documents@.
975 The operation may fail with:
977 * 'UnsupportedOperation'
978 The operating system has no notion of document directory.
980 * 'isDoesNotExistError'
981 The document directory for the current user does not exist, or
984 getUserDocumentsDirectory :: IO FilePath
985 getUserDocumentsDirectory = do
986 #if defined(mingw32_HOST_OS)
987 allocaBytes long_path_size $ \pPath -> do
988 r <- c_SHGetFolderPath nullPtr csidl_PERSONAL nullPtr 0 pPath
989 when (r<0) (raiseUnsupported "System.Directory.getUserDocumentsDirectory")
995 {- | Returns the current directory for temporary files.
997 On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@
998 environment variable or \"\/tmp\" if the variable isn\'t defined.
999 On Windows, the function checks for the existence of environment variables in
1000 the following order and uses the first path found:
1003 TMP environment variable.
1006 TEMP environment variable.
1009 USERPROFILE environment variable.
1012 The Windows directory
1014 The operation may fail with:
1016 * 'UnsupportedOperation'
1017 The operating system has no notion of temporary directory.
1019 The function doesn\'t verify whether the path exists.
1021 getTemporaryDirectory :: IO FilePath
1022 getTemporaryDirectory = do
1023 #if defined(mingw32_HOST_OS)
1024 allocaBytes long_path_size $ \pPath -> do
1025 r <- c_GetTempPath (fromIntegral long_path_size) pPath
1028 catch (getEnv "TMPDIR") (\ex -> return "/tmp")
1031 #if defined(mingw32_HOST_OS)
1032 foreign import ccall unsafe "__hscore_getFolderPath"
1033 c_SHGetFolderPath :: Ptr ()
1039 foreign import ccall unsafe "__hscore_CSIDL_PROFILE" csidl_PROFILE :: CInt
1040 foreign import ccall unsafe "__hscore_CSIDL_APPDATA" csidl_APPDATA :: CInt
1041 foreign import ccall unsafe "__hscore_CSIDL_WINDOWS" csidl_WINDOWS :: CInt
1042 foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt
1044 foreign import stdcall unsafe "GetTempPathA" c_GetTempPath :: CInt -> CString -> IO CInt
1046 raiseUnsupported loc =
1047 ioException (IOError Nothing UnsupportedOperation loc "unsupported operation" Nothing)
1051 -- ToDo: This should be determined via autoconf (AC_EXEEXT)
1052 -- | Extension for executable files
1053 -- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
1054 exeExtension :: String
1055 #ifdef mingw32_HOST_OS
1056 exeExtension = "exe"