mark System.IO.openTempFile as non-portable in haddocks
[packages/random.git] / System / Directory.hs
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : System.Directory
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/base/LICENSE)
6 --
7 -- Maintainer : libraries@haskell.org
8 -- Stability : stable
9 -- Portability : portable
10 --
11 -- System-independent interface to directory manipulation.
12 --
13 -----------------------------------------------------------------------------
14
15 module System.Directory
16 (
17 -- $intro
18
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 ()
25
26 , getDirectoryContents -- :: FilePath -> IO [FilePath]
27 , getCurrentDirectory -- :: IO FilePath
28 , setCurrentDirectory -- :: FilePath -> IO ()
29
30 -- * Pre-defined directories
31 , getHomeDirectory
32 , getAppUserDataDirectory
33 , getUserDocumentsDirectory
34 , getTemporaryDirectory
35
36 -- * Actions on files
37 , removeFile -- :: FilePath -> IO ()
38 , renameFile -- :: FilePath -> FilePath -> IO ()
39 , copyFile -- :: FilePath -> FilePath -> IO ()
40
41 , canonicalizePath
42 , findExecutable
43
44 -- * Existence tests
45 , doesFileExist -- :: FilePath -> IO Bool
46 , doesDirectoryExist -- :: FilePath -> IO Bool
47
48 -- * Permissions
49
50 -- $permissions
51
52 , Permissions(
53 Permissions,
54 readable, -- :: Permissions -> Bool
55 writable, -- :: Permissions -> Bool
56 executable, -- :: Permissions -> Bool
57 searchable -- :: Permissions -> Bool
58 )
59
60 , getPermissions -- :: FilePath -> IO Permissions
61 , setPermissions -- :: FilePath -> Permissions -> IO ()
62
63 -- * Timestamps
64
65 , getModificationTime -- :: FilePath -> IO ClockTime
66 ) where
67
68 import System.Directory.Internals
69 import System.Environment ( getEnv )
70 import System.IO.Error
71 import Control.Monad ( when, unless )
72
73 #ifdef __NHC__
74 import Directory
75 #endif /* __NHC__ */
76
77 #ifdef __HUGS__
78 import Hugs.Directory
79 #endif /* __HUGS__ */
80
81 import Foreign
82 import Foreign.C
83
84 {-# CFILES cbits/PrelIOUtils.c #-}
85
86 #ifdef __GLASGOW_HASKELL__
87 import Prelude
88
89 import Control.Exception ( bracket )
90 import System.Posix.Types
91 import System.Posix.Internals
92 import System.Time ( ClockTime(..) )
93 import System.IO
94
95 import GHC.IOBase ( IOException(..), IOErrorType(..), ioException )
96
97 {- $intro
98 A directory contains a series of entries, each of which is a named
99 reference to a file system object (file, directory etc.). Some
100 entries may be hidden, inaccessible, or have some administrative
101 function (e.g. `.' or `..' under POSIX
102 <http://www.opengroup.org/onlinepubs/007904975/toc.htm>), but in
103 this standard all such entries are considered to form part of the
104 directory contents. Entries in sub-directories are not, however,
105 considered to form part of the directory contents.
106
107 Each file system object is referenced by a /path/. There is
108 normally at least one absolute path to each file system object. In
109 some operating systems, it may also be possible to have paths which
110 are relative to the current directory.
111 -}
112
113 -----------------------------------------------------------------------------
114 -- Permissions
115
116 {- $permissions
117
118 The 'Permissions' type is used to record whether certain operations are
119 permissible on a file\/directory. 'getPermissions' and 'setPermissions'
120 get and set these permissions, respectively. Permissions apply both to
121 files and directories. For directories, the executable field will be
122 'False', and for files the searchable field will be 'False'. Note that
123 directories may be searchable without being readable, if permission has
124 been given to use them as part of a path, but not to examine the
125 directory contents.
126
127 Note that to change some, but not all permissions, a construct on the following lines must be used.
128
129 > makeReadable f = do
130 > p <- getPermissions f
131 > setPermissions f (p {readable = True})
132
133 -}
134
135 data Permissions
136 = Permissions {
137 readable, writable,
138 executable, searchable :: Bool
139 } deriving (Eq, Ord, Read, Show)
140
141 {- |The 'getPermissions' operation returns the
142 permissions for the file or directory.
143
144 The operation may fail with:
145
146 * 'isPermissionError' if the user is not permitted to access
147 the permissions; or
148
149 * 'isDoesNotExistError' if the file or directory does not exist.
150
151 -}
152
153 getPermissions :: FilePath -> IO Permissions
154 getPermissions name = do
155 withCString name $ \s -> do
156 read <- c_access s r_OK
157 write <- c_access s w_OK
158 exec <- c_access s x_OK
159 withFileStatus "getPermissions" name $ \st -> do
160 is_dir <- isDirectory st
161 return (
162 Permissions {
163 readable = read == 0,
164 writable = write == 0,
165 executable = not is_dir && exec == 0,
166 searchable = is_dir && exec == 0
167 }
168 )
169
170 {- |The 'setPermissions' operation sets the
171 permissions for the file or directory.
172
173 The operation may fail with:
174
175 * 'isPermissionError' if the user is not permitted to set
176 the permissions; or
177
178 * 'isDoesNotExistError' if the file or directory does not exist.
179
180 -}
181
182 setPermissions :: FilePath -> Permissions -> IO ()
183 setPermissions name (Permissions r w e s) = do
184 allocaBytes sizeof_stat $ \ p_stat -> do
185 withCString name $ \p_name -> do
186 throwErrnoIfMinus1_ "setPermissions" $ do
187 c_stat p_name p_stat
188 mode <- st_mode p_stat
189 let mode1 = modifyBit r mode s_IRUSR
190 let mode2 = modifyBit w mode1 s_IWUSR
191 let mode3 = modifyBit (e || s) mode2 s_IXUSR
192 c_chmod p_name mode3
193
194 where
195 modifyBit :: Bool -> CMode -> CMode -> CMode
196 modifyBit False m b = m .&. (complement b)
197 modifyBit True m b = m .|. b
198
199
200 copyPermissions :: FilePath -> FilePath -> IO ()
201 copyPermissions source dest = do
202 allocaBytes sizeof_stat $ \ p_stat -> do
203 withCString source $ \p_source -> do
204 withCString dest $ \p_dest -> do
205 throwErrnoIfMinus1_ "copyPermissions" $ c_stat p_source p_stat
206 mode <- st_mode p_stat
207 throwErrnoIfMinus1_ "copyPermissions" $ c_chmod p_dest mode
208
209 -----------------------------------------------------------------------------
210 -- Implementation
211
212 {- |@'createDirectory' dir@ creates a new directory @dir@ which is
213 initially empty, or as near to empty as the operating system
214 allows.
215
216 The operation may fail with:
217
218 * 'isPermissionError' \/ 'PermissionDenied'
219 The process has insufficient privileges to perform the operation.
220 @[EROFS, EACCES]@
221
222 * 'isAlreadyExistsError' \/ 'AlreadyExists'
223 The operand refers to a directory that already exists.
224 @ [EEXIST]@
225
226 * 'HardwareFault'
227 A physical I\/O error has occurred.
228 @[EIO]@
229
230 * 'InvalidArgument'
231 The operand is not a valid directory name.
232 @[ENAMETOOLONG, ELOOP]@
233
234 * 'NoSuchThing'
235 There is no path to the directory.
236 @[ENOENT, ENOTDIR]@
237
238 * 'ResourceExhausted'
239 Insufficient resources (virtual memory, process file descriptors,
240 physical disk space, etc.) are available to perform the operation.
241 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
242
243 * 'InappropriateType'
244 The path refers to an existing non-directory object.
245 @[EEXIST]@
246
247 -}
248
249 createDirectory :: FilePath -> IO ()
250 createDirectory path = do
251 modifyIOError (`ioeSetFileName` path) $
252 withCString path $ \s -> do
253 throwErrnoIfMinus1Retry_ "createDirectory" $
254 mkdir s 0o777
255
256 #else /* !__GLASGOW_HASKELL__ */
257
258 copyPermissions :: FilePath -> FilePath -> IO ()
259 copyPermissions fromFPath toFPath
260 = getPermissions fromFPath >>= setPermissions toFPath
261
262 #endif
263
264 -- | @'createDirectoryIfMissing' parents dir@ creates a new directory
265 -- @dir@ if it doesn\'t exist. If the first argument is 'True'
266 -- the function will also create all parent directories if they are missing.
267 createDirectoryIfMissing :: Bool -- ^ Create its parents too?
268 -> FilePath -- ^ The path to the directory you want to make
269 -> IO ()
270 createDirectoryIfMissing parents file = do
271 b <- doesDirectoryExist file
272 case (b,parents, file) of
273 (_, _, "") -> return ()
274 (True, _, _) -> return ()
275 (_, True, _) -> mapM_ (createDirectoryIfMissing False) (tail (pathParents file))
276 (_, False, _) -> createDirectory file
277
278 #if __GLASGOW_HASKELL__
279 {- | @'removeDirectory' dir@ removes an existing directory /dir/. The
280 implementation may specify additional constraints which must be
281 satisfied before a directory can be removed (e.g. the directory has to
282 be empty, or may not be in use by other processes). It is not legal
283 for an implementation to partially remove a directory unless the
284 entire directory is removed. A conformant implementation need not
285 support directory removal in all situations (e.g. removal of the root
286 directory).
287
288 The operation may fail with:
289
290 * 'HardwareFault'
291 A physical I\/O error has occurred.
292 EIO
293
294 * 'InvalidArgument'
295 The operand is not a valid directory name.
296 [ENAMETOOLONG, ELOOP]
297
298 * 'isDoesNotExistError' \/ 'NoSuchThing'
299 The directory does not exist.
300 @[ENOENT, ENOTDIR]@
301
302 * 'isPermissionError' \/ 'PermissionDenied'
303 The process has insufficient privileges to perform the operation.
304 @[EROFS, EACCES, EPERM]@
305
306 * 'UnsatisfiedConstraints'
307 Implementation-dependent constraints are not satisfied.
308 @[EBUSY, ENOTEMPTY, EEXIST]@
309
310 * 'UnsupportedOperation'
311 The implementation does not support removal in this situation.
312 @[EINVAL]@
313
314 * 'InappropriateType'
315 The operand refers to an existing non-directory object.
316 @[ENOTDIR]@
317
318 -}
319
320 removeDirectory :: FilePath -> IO ()
321 removeDirectory path = do
322 modifyIOError (`ioeSetFileName` path) $
323 withCString path $ \s ->
324 throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
325 #endif
326
327 -- | @'removeDirectoryRecursive' dir@ removes an existing directory /dir/
328 -- together with its content and all subdirectories. Be careful,
329 -- if the directory contains symlinks, the function will follow them.
330 removeDirectoryRecursive :: FilePath -> IO ()
331 removeDirectoryRecursive startLoc = do
332 cont <- getDirectoryContents startLoc
333 sequence_ [rm (startLoc `joinFileName` x) | x <- cont, x /= "." && x /= ".."]
334 removeDirectory startLoc
335 where
336 rm :: FilePath -> IO ()
337 rm f = do temp <- try (removeFile f)
338 case temp of
339 Left e -> do isDir <- doesDirectoryExist f
340 -- If f is not a directory, re-throw the error
341 unless isDir $ ioError e
342 removeDirectoryRecursive f
343 Right _ -> return ()
344
345 #if __GLASGOW_HASKELL__
346 {- |'removeFile' /file/ removes the directory entry for an existing file
347 /file/, where /file/ is not itself a directory. The
348 implementation may specify additional constraints which must be
349 satisfied before a file can be removed (e.g. the file may not be in
350 use by other processes).
351
352 The operation may fail with:
353
354 * 'HardwareFault'
355 A physical I\/O error has occurred.
356 @[EIO]@
357
358 * 'InvalidArgument'
359 The operand is not a valid file name.
360 @[ENAMETOOLONG, ELOOP]@
361
362 * 'isDoesNotExistError' \/ 'NoSuchThing'
363 The file does not exist.
364 @[ENOENT, ENOTDIR]@
365
366 * 'isPermissionError' \/ 'PermissionDenied'
367 The process has insufficient privileges to perform the operation.
368 @[EROFS, EACCES, EPERM]@
369
370 * 'UnsatisfiedConstraints'
371 Implementation-dependent constraints are not satisfied.
372 @[EBUSY]@
373
374 * 'InappropriateType'
375 The operand refers to an existing directory.
376 @[EPERM, EINVAL]@
377
378 -}
379
380 removeFile :: FilePath -> IO ()
381 removeFile path = do
382 modifyIOError (`ioeSetFileName` path) $
383 withCString path $ \s ->
384 throwErrnoIfMinus1Retry_ "removeFile" (c_unlink s)
385
386 {- |@'renameDirectory' old new@ changes the name of an existing
387 directory from /old/ to /new/. If the /new/ directory
388 already exists, it is atomically replaced by the /old/ directory.
389 If the /new/ directory is neither the /old/ directory nor an
390 alias of the /old/ directory, it is removed as if by
391 'removeDirectory'. A conformant implementation need not support
392 renaming directories in all situations (e.g. renaming to an existing
393 directory, or across different physical devices), but the constraints
394 must be documented.
395
396 On Win32 platforms, @renameDirectory@ fails if the /new/ directory already
397 exists.
398
399 The operation may fail with:
400
401 * 'HardwareFault'
402 A physical I\/O error has occurred.
403 @[EIO]@
404
405 * 'InvalidArgument'
406 Either operand is not a valid directory name.
407 @[ENAMETOOLONG, ELOOP]@
408
409 * 'isDoesNotExistError' \/ 'NoSuchThing'
410 The original directory does not exist, or there is no path to the target.
411 @[ENOENT, ENOTDIR]@
412
413 * 'isPermissionError' \/ 'PermissionDenied'
414 The process has insufficient privileges to perform the operation.
415 @[EROFS, EACCES, EPERM]@
416
417 * 'ResourceExhausted'
418 Insufficient resources are available to perform the operation.
419 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
420
421 * 'UnsatisfiedConstraints'
422 Implementation-dependent constraints are not satisfied.
423 @[EBUSY, ENOTEMPTY, EEXIST]@
424
425 * 'UnsupportedOperation'
426 The implementation does not support renaming in this situation.
427 @[EINVAL, EXDEV]@
428
429 * 'InappropriateType'
430 Either path refers to an existing non-directory object.
431 @[ENOTDIR, EISDIR]@
432
433 -}
434
435 renameDirectory :: FilePath -> FilePath -> IO ()
436 renameDirectory opath npath =
437 withFileStatus "renameDirectory" opath $ \st -> do
438 is_dir <- isDirectory st
439 if (not is_dir)
440 then ioException (IOError Nothing InappropriateType "renameDirectory"
441 ("not a directory") (Just opath))
442 else do
443
444 withCString opath $ \s1 ->
445 withCString npath $ \s2 ->
446 throwErrnoIfMinus1Retry_ "renameDirectory" (c_rename s1 s2)
447
448 {- |@'renameFile' old new@ changes the name of an existing file system
449 object from /old/ to /new/. If the /new/ object already
450 exists, it is atomically replaced by the /old/ object. Neither
451 path may refer to an existing directory. A conformant implementation
452 need not support renaming files in all situations (e.g. renaming
453 across different physical devices), but the constraints must be
454 documented.
455
456 The operation may fail with:
457
458 * 'HardwareFault'
459 A physical I\/O error has occurred.
460 @[EIO]@
461
462 * 'InvalidArgument'
463 Either operand is not a valid file name.
464 @[ENAMETOOLONG, ELOOP]@
465
466 * 'isDoesNotExistError' \/ 'NoSuchThing'
467 The original file does not exist, or there is no path to the target.
468 @[ENOENT, ENOTDIR]@
469
470 * 'isPermissionError' \/ 'PermissionDenied'
471 The process has insufficient privileges to perform the operation.
472 @[EROFS, EACCES, EPERM]@
473
474 * 'ResourceExhausted'
475 Insufficient resources are available to perform the operation.
476 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
477
478 * 'UnsatisfiedConstraints'
479 Implementation-dependent constraints are not satisfied.
480 @[EBUSY]@
481
482 * 'UnsupportedOperation'
483 The implementation does not support renaming in this situation.
484 @[EXDEV]@
485
486 * 'InappropriateType'
487 Either path refers to an existing directory.
488 @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@
489
490 -}
491
492 renameFile :: FilePath -> FilePath -> IO ()
493 renameFile opath npath =
494 withFileOrSymlinkStatus "renameFile" opath $ \st -> do
495 is_dir <- isDirectory st
496 if is_dir
497 then ioException (IOError Nothing InappropriateType "renameFile"
498 "is a directory" (Just opath))
499 else do
500
501 withCString opath $ \s1 ->
502 withCString npath $ \s2 ->
503 throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
504
505 #endif /* __GLASGOW_HASKELL__ */
506
507 {- |@'copyFile' old new@ copies the existing file from /old/ to /new/.
508 If the /new/ file already exists, it is atomically replaced by the /old/ file.
509 Neither path may refer to an existing directory. The permissions of /old/ are
510 copied to /new/, if possible.
511 -}
512
513 {- NOTES:
514
515 It's tempting to try to remove the target file before opening it for
516 writing. This could be useful: for example if the target file is an
517 executable that is in use, writing will fail, but unlinking first
518 would succeed.
519
520 However, it certainly isn't always what you want.
521
522 * if the target file is hardlinked, removing it would break
523 the hard link, but just opening would preserve it.
524
525 * opening and truncating will preserve permissions and
526 ACLs on the target.
527
528 * If the destination file is read-only in a writable directory,
529 we might want copyFile to fail. Removing the target first
530 would succeed, however.
531
532 * If the destination file is special (eg. /dev/null), removing
533 it is probably not the right thing. Copying to /dev/null
534 should leave /dev/null intact, not replace it with a plain
535 file.
536
537 * There's a small race condition between removing the target and
538 opening it for writing during which time someone might
539 create it again.
540 -}
541 copyFile :: FilePath -> FilePath -> IO ()
542 copyFile fromFPath toFPath =
543 #if (!(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 600))
544 do readFile fromFPath >>= writeFile toFPath
545 try (copyPermissions fromFPath toFPath)
546 return ()
547 #else
548 (bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
549 bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo ->
550 allocaBytes bufferSize $ \buffer -> do
551 copyContents hFrom hTo buffer
552 try (copyPermissions fromFPath toFPath)
553 return ()) `catch` (ioError . changeFunName)
554 where
555 bufferSize = 1024
556
557 changeFunName (IOError h iot fun str mb_fp) = IOError h iot "copyFile" str mb_fp
558
559 copyContents hFrom hTo buffer = do
560 count <- hGetBuf hFrom buffer bufferSize
561 when (count > 0) $ do
562 hPutBuf hTo buffer count
563 copyContents hFrom hTo buffer
564 #endif
565
566 -- | Given path referring to a file or directory, returns a
567 -- canonicalized path, with the intent that two paths referring
568 -- to the same file\/directory will map to the same canonicalized
569 -- path. Note that it is impossible to guarantee that the
570 -- implication (same file\/dir \<=\> same canonicalizedPath) holds
571 -- in either direction: this function can make only a best-effort
572 -- attempt.
573 canonicalizePath :: FilePath -> IO FilePath
574 canonicalizePath fpath =
575 withCString fpath $ \pInPath ->
576 allocaBytes long_path_size $ \pOutPath ->
577 #if defined(mingw32_HOST_OS)
578 alloca $ \ppFilePart ->
579 do c_GetFullPathName pInPath (fromIntegral long_path_size) pOutPath ppFilePart
580 #else
581 do c_realpath pInPath pOutPath
582 #endif
583 peekCString pOutPath
584
585 #if defined(mingw32_HOST_OS)
586 foreign import stdcall unsafe "GetFullPathNameA"
587 c_GetFullPathName :: CString
588 -> CInt
589 -> CString
590 -> Ptr CString
591 -> IO CInt
592 #else
593 foreign import ccall unsafe "realpath"
594 c_realpath :: CString
595 -> CString
596 -> IO CString
597 #endif
598
599 -- | Given an executable file name, searches for such file
600 -- in the directories listed in system PATH. The returned value
601 -- is the path to the found executable or Nothing if there isn't
602 -- such executable. For example (findExecutable \"ghc\")
603 -- gives you the path to GHC.
604 findExecutable :: String -> IO (Maybe FilePath)
605 findExecutable binary =
606 #if defined(mingw32_HOST_OS)
607 withCString binary $ \c_binary ->
608 withCString ('.':exeExtension) $ \c_ext ->
609 allocaBytes long_path_size $ \pOutPath ->
610 alloca $ \ppFilePart -> do
611 res <- c_SearchPath nullPtr c_binary c_ext (fromIntegral long_path_size) pOutPath ppFilePart
612 if res > 0 && res < fromIntegral long_path_size
613 then do fpath <- peekCString pOutPath
614 return (Just fpath)
615 else return Nothing
616
617 foreign import stdcall unsafe "SearchPathA"
618 c_SearchPath :: CString
619 -> CString
620 -> CString
621 -> CInt
622 -> CString
623 -> Ptr CString
624 -> IO CInt
625 #else
626 do
627 path <- getEnv "PATH"
628 search (parseSearchPath path)
629 where
630 fileName = binary `joinFileExt` exeExtension
631
632 search :: [FilePath] -> IO (Maybe FilePath)
633 search [] = return Nothing
634 search (d:ds) = do
635 let path = d `joinFileName` fileName
636 b <- doesFileExist path
637 if b then return (Just path)
638 else search ds
639 #endif
640
641
642 #ifdef __GLASGOW_HASKELL__
643 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
644 in /dir/.
645
646 The operation may fail with:
647
648 * 'HardwareFault'
649 A physical I\/O error has occurred.
650 @[EIO]@
651
652 * 'InvalidArgument'
653 The operand is not a valid directory name.
654 @[ENAMETOOLONG, ELOOP]@
655
656 * 'isDoesNotExistError' \/ 'NoSuchThing'
657 The directory does not exist.
658 @[ENOENT, ENOTDIR]@
659
660 * 'isPermissionError' \/ 'PermissionDenied'
661 The process has insufficient privileges to perform the operation.
662 @[EACCES]@
663
664 * 'ResourceExhausted'
665 Insufficient resources are available to perform the operation.
666 @[EMFILE, ENFILE]@
667
668 * 'InappropriateType'
669 The path refers to an existing non-directory object.
670 @[ENOTDIR]@
671
672 -}
673
674 getDirectoryContents :: FilePath -> IO [FilePath]
675 getDirectoryContents path = do
676 modifyIOError (`ioeSetFileName` path) $
677 alloca $ \ ptr_dEnt ->
678 bracket
679 (withCString path $ \s ->
680 throwErrnoIfNullRetry desc (c_opendir s))
681 (\p -> throwErrnoIfMinus1_ desc (c_closedir p))
682 (\p -> loop ptr_dEnt p)
683 where
684 desc = "getDirectoryContents"
685
686 loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
687 loop ptr_dEnt dir = do
688 resetErrno
689 r <- readdir dir ptr_dEnt
690 if (r == 0)
691 then do
692 dEnt <- peek ptr_dEnt
693 if (dEnt == nullPtr)
694 then return []
695 else do
696 entry <- (d_name dEnt >>= peekCString)
697 freeDirEnt dEnt
698 entries <- loop ptr_dEnt dir
699 return (entry:entries)
700 else do errno <- getErrno
701 if (errno == eINTR) then loop ptr_dEnt dir else do
702 let (Errno eo) = errno
703 if (eo == end_of_dir)
704 then return []
705 else throwErrno desc
706
707
708
709 {- |If the operating system has a notion of current directories,
710 'getCurrentDirectory' returns an absolute path to the
711 current directory of the calling process.
712
713 The operation may fail with:
714
715 * 'HardwareFault'
716 A physical I\/O error has occurred.
717 @[EIO]@
718
719 * 'isDoesNotExistError' \/ 'NoSuchThing'
720 There is no path referring to the current directory.
721 @[EPERM, ENOENT, ESTALE...]@
722
723 * 'isPermissionError' \/ 'PermissionDenied'
724 The process has insufficient privileges to perform the operation.
725 @[EACCES]@
726
727 * 'ResourceExhausted'
728 Insufficient resources are available to perform the operation.
729
730 * 'UnsupportedOperation'
731 The operating system has no notion of current directory.
732
733 -}
734
735 getCurrentDirectory :: IO FilePath
736 getCurrentDirectory = do
737 p <- mallocBytes long_path_size
738 go p long_path_size
739 where go p bytes = do
740 p' <- c_getcwd p (fromIntegral bytes)
741 if p' /= nullPtr
742 then do s <- peekCString p'
743 free p'
744 return s
745 else do errno <- getErrno
746 if errno == eRANGE
747 then do let bytes' = bytes * 2
748 p' <- reallocBytes p bytes'
749 go p' bytes'
750 else throwErrno "getCurrentDirectory"
751
752 {- |If the operating system has a notion of current directories,
753 @'setCurrentDirectory' dir@ changes the current
754 directory of the calling process to /dir/.
755
756 The operation may fail with:
757
758 * 'HardwareFault'
759 A physical I\/O error has occurred.
760 @[EIO]@
761
762 * 'InvalidArgument'
763 The operand is not a valid directory name.
764 @[ENAMETOOLONG, ELOOP]@
765
766 * 'isDoesNotExistError' \/ 'NoSuchThing'
767 The directory does not exist.
768 @[ENOENT, ENOTDIR]@
769
770 * 'isPermissionError' \/ 'PermissionDenied'
771 The process has insufficient privileges to perform the operation.
772 @[EACCES]@
773
774 * 'UnsupportedOperation'
775 The operating system has no notion of current directory, or the
776 current directory cannot be dynamically changed.
777
778 * 'InappropriateType'
779 The path refers to an existing non-directory object.
780 @[ENOTDIR]@
781
782 -}
783
784 setCurrentDirectory :: FilePath -> IO ()
785 setCurrentDirectory path = do
786 modifyIOError (`ioeSetFileName` path) $
787 withCString path $ \s ->
788 throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
789 -- ToDo: add path to error
790
791 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
792 exists and is a directory, and 'False' otherwise.
793 -}
794
795 doesDirectoryExist :: FilePath -> IO Bool
796 doesDirectoryExist name =
797 catch
798 (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
799 (\ _ -> return False)
800
801 {- |The operation 'doesFileExist' returns 'True'
802 if the argument file exists and is not a directory, and 'False' otherwise.
803 -}
804
805 doesFileExist :: FilePath -> IO Bool
806 doesFileExist name = do
807 catch
808 (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
809 (\ _ -> return False)
810
811 {- |The 'getModificationTime' operation returns the
812 clock time at which the file or directory was last modified.
813
814 The operation may fail with:
815
816 * 'isPermissionError' if the user is not permitted to access
817 the modification time; or
818
819 * 'isDoesNotExistError' if the file or directory does not exist.
820
821 -}
822
823 getModificationTime :: FilePath -> IO ClockTime
824 getModificationTime name =
825 withFileStatus "getModificationTime" name $ \ st ->
826 modificationTime st
827
828 withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
829 withFileStatus loc name f = do
830 modifyIOError (`ioeSetFileName` name) $
831 allocaBytes sizeof_stat $ \p ->
832 withCString (fileNameEndClean name) $ \s -> do
833 throwErrnoIfMinus1Retry_ loc (c_stat s p)
834 f p
835
836 withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
837 withFileOrSymlinkStatus loc name f = do
838 modifyIOError (`ioeSetFileName` name) $
839 allocaBytes sizeof_stat $ \p ->
840 withCString name $ \s -> do
841 throwErrnoIfMinus1Retry_ loc (lstat s p)
842 f p
843
844 modificationTime :: Ptr CStat -> IO ClockTime
845 modificationTime stat = do
846 mtime <- st_mtime stat
847 let realToInteger = round . realToFrac :: Real a => a -> Integer
848 return (TOD (realToInteger (mtime :: CTime)) 0)
849
850 isDirectory :: Ptr CStat -> IO Bool
851 isDirectory stat = do
852 mode <- st_mode stat
853 return (s_isdir mode)
854
855 fileNameEndClean :: String -> String
856 fileNameEndClean name =
857 if i > 0 && (ec == '\\' || ec == '/') then
858 fileNameEndClean (take i name)
859 else
860 name
861 where
862 i = (length name) - 1
863 ec = name !! i
864
865 foreign import ccall unsafe "__hscore_R_OK" r_OK :: CInt
866 foreign import ccall unsafe "__hscore_W_OK" w_OK :: CInt
867 foreign import ccall unsafe "__hscore_X_OK" x_OK :: CInt
868
869 foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
870 foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
871 foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode
872
873 foreign import ccall unsafe "__hscore_long_path_size"
874 long_path_size :: Int
875
876 #else
877 long_path_size :: Int
878 long_path_size = 2048 /* guess? */
879
880 #endif /* __GLASGOW_HASKELL__ */
881
882 {- | Returns the current user's home directory.
883
884 The directory returned is expected to be writable by the current user,
885 but note that it isn't generally considered good practice to store
886 application-specific data here; use 'getAppUserDataDirectory'
887 instead.
888
889 On Unix, 'getHomeDirectory' returns the value of the @HOME@
890 environment variable. On Windows, the system is queried for a
891 suitable path; a typical path might be
892 @C:/Documents And Settings/user@.
893
894 The operation may fail with:
895
896 * 'UnsupportedOperation'
897 The operating system has no notion of home directory.
898
899 * 'isDoesNotExistError'
900 The home directory for the current user does not exist, or
901 cannot be found.
902 -}
903 getHomeDirectory :: IO FilePath
904 getHomeDirectory =
905 #if defined(mingw32_HOST_OS)
906 allocaBytes long_path_size $ \pPath -> do
907 r <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
908 if (r < 0)
909 then do
910 r <- c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
911 when (r < 0) (raiseUnsupported "System.Directory.getHomeDirectory")
912 else return ()
913 peekCString pPath
914 #else
915 getEnv "HOME"
916 #endif
917
918 {- | Returns the pathname of a directory in which application-specific
919 data for the current user can be stored. The result of
920 'getAppUserDataDirectory' for a given application is specific to
921 the current user.
922
923 The argument should be the name of the application, which will be used
924 to construct the pathname (so avoid using unusual characters that
925 might result in an invalid pathname).
926
927 Note: the directory may not actually exist, and may need to be created
928 first. It is expected that the parent directory exists and is
929 writable.
930
931 On Unix, this function returns @$HOME\/.appName@. On Windows, a
932 typical path might be
933
934 > C:/Documents And Settings/user/Application Data/appName
935
936 The operation may fail with:
937
938 * 'UnsupportedOperation'
939 The operating system has no notion of application-specific data directory.
940
941 * 'isDoesNotExistError'
942 The home directory for the current user does not exist, or
943 cannot be found.
944 -}
945 getAppUserDataDirectory :: String -> IO FilePath
946 getAppUserDataDirectory appName = do
947 #if defined(mingw32_HOST_OS)
948 allocaBytes long_path_size $ \pPath -> do
949 r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
950 when (r<0) (raiseUnsupported "System.Directory.getAppUserDataDirectory")
951 s <- peekCString pPath
952 return (s++'\\':appName)
953 #else
954 path <- getEnv "HOME"
955 return (path++'/':'.':appName)
956 #endif
957
958 {- | Returns the current user's document directory.
959
960 The directory returned is expected to be writable by the current user,
961 but note that it isn't generally considered good practice to store
962 application-specific data here; use 'getAppUserDataDirectory'
963 instead.
964
965 On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@
966 environment variable. On Windows, the system is queried for a
967 suitable path; a typical path might be
968 @C:\/Documents and Settings\/user\/My Documents@.
969
970 The operation may fail with:
971
972 * 'UnsupportedOperation'
973 The operating system has no notion of document directory.
974
975 * 'isDoesNotExistError'
976 The document directory for the current user does not exist, or
977 cannot be found.
978 -}
979 getUserDocumentsDirectory :: IO FilePath
980 getUserDocumentsDirectory = do
981 #if defined(mingw32_HOST_OS)
982 allocaBytes long_path_size $ \pPath -> do
983 r <- c_SHGetFolderPath nullPtr csidl_PERSONAL nullPtr 0 pPath
984 when (r<0) (raiseUnsupported "System.Directory.getUserDocumentsDirectory")
985 peekCString pPath
986 #else
987 getEnv "HOME"
988 #endif
989
990 {- | Returns the current directory for temporary files.
991
992 On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@
993 environment variable or \"\/tmp\" if the variable isn\'t defined.
994 On Windows, the function checks for the existence of environment variables in
995 the following order and uses the first path found:
996
997 *
998 TMP environment variable.
999
1000 *
1001 TEMP environment variable.
1002
1003 *
1004 USERPROFILE environment variable.
1005
1006 *
1007 The Windows directory
1008
1009 The operation may fail with:
1010
1011 * 'UnsupportedOperation'
1012 The operating system has no notion of temporary directory.
1013
1014 The function doesn\'t verify whether the path exists.
1015 -}
1016 getTemporaryDirectory :: IO FilePath
1017 getTemporaryDirectory = do
1018 #if defined(mingw32_HOST_OS)
1019 allocaBytes long_path_size $ \pPath -> do
1020 r <- c_GetTempPath (fromIntegral long_path_size) pPath
1021 peekCString pPath
1022 #else
1023 catch (getEnv "TMPDIR") (\ex -> return "/tmp")
1024 #endif
1025
1026 #if defined(mingw32_HOST_OS)
1027 foreign import ccall unsafe "__hscore_getFolderPath"
1028 c_SHGetFolderPath :: Ptr ()
1029 -> CInt
1030 -> Ptr ()
1031 -> CInt
1032 -> CString
1033 -> IO CInt
1034 foreign import ccall unsafe "__hscore_CSIDL_PROFILE" csidl_PROFILE :: CInt
1035 foreign import ccall unsafe "__hscore_CSIDL_APPDATA" csidl_APPDATA :: CInt
1036 foreign import ccall unsafe "__hscore_CSIDL_WINDOWS" csidl_WINDOWS :: CInt
1037 foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt
1038
1039 foreign import stdcall unsafe "GetTempPathA" c_GetTempPath :: CInt -> CString -> IO CInt
1040
1041 raiseUnsupported loc =
1042 ioException (IOError Nothing UnsupportedOperation loc "unsupported operation" Nothing)
1043
1044 #endif