[project @ 2005-03-10 17:23:06 by malcolm]
[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 import NHC.FFI
76 #endif /* __NHC__ */
77
78 #ifdef __HUGS__
79 import Hugs.Directory
80 import Control.Exception ( bracket )
81 import System.IO
82 #endif /* __HUGS__ */
83
84 #ifdef __GLASGOW_HASKELL__
85 import Prelude
86
87 import Control.Exception ( bracket )
88 import System.Posix.Types
89 import System.Posix.Internals
90 import System.Time ( ClockTime(..) )
91 import System.IO
92 import Foreign
93 import Foreign.C
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 -- Implementation
201
202 {- |@'createDirectory' dir@ creates a new directory @dir@ which is
203 initially empty, or as near to empty as the operating system
204 allows.
205
206 The operation may fail with:
207
208 * 'isPermissionError' \/ 'PermissionDenied'
209 The process has insufficient privileges to perform the operation.
210 @[EROFS, EACCES]@
211
212 * 'isAlreadyExistsError' \/ 'AlreadyExists'
213 The operand refers to a directory that already exists.
214 @ [EEXIST]@
215
216 * 'HardwareFault'
217 A physical I\/O error has occurred.
218 @[EIO]@
219
220 * 'InvalidArgument'
221 The operand is not a valid directory name.
222 @[ENAMETOOLONG, ELOOP]@
223
224 * 'NoSuchThing'
225 There is no path to the directory.
226 @[ENOENT, ENOTDIR]@
227
228 * 'ResourceExhausted'
229 Insufficient resources (virtual memory, process file descriptors,
230 physical disk space, etc.) are available to perform the operation.
231 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
232
233 * 'InappropriateType'
234 The path refers to an existing non-directory object.
235 @[EEXIST]@
236
237 -}
238
239 createDirectory :: FilePath -> IO ()
240 createDirectory path = do
241 modifyIOError (`ioeSetFileName` path) $
242 withCString path $ \s -> do
243 throwErrnoIfMinus1Retry_ "createDirectory" $
244 mkdir s 0o777
245 #endif
246
247 -- | @'createDirectoryIfMissing' parents dir@ creates a new directory
248 -- @dir@ if it doesn\'t exist. If the first argument is 'True'
249 -- the function will also create all parent directories if they are missing.
250 createDirectoryIfMissing :: Bool -- ^ Create its parents too?
251 -> FilePath -- ^ The path to the directory you want to make
252 -> IO ()
253 createDirectoryIfMissing parents file = do
254 b <- doesDirectoryExist file
255 case (b,parents, file) of
256 (_, _, "") -> return ()
257 (True, _, _) -> return ()
258 (_, True, _) -> mapM_ (createDirectoryIfMissing False) (tail (pathParents file))
259 (_, False, _) -> createDirectory file
260
261 #if __GLASGOW_HASKELL__
262 {- | @'removeDirectory' dir@ removes an existing directory /dir/. The
263 implementation may specify additional constraints which must be
264 satisfied before a directory can be removed (e.g. the directory has to
265 be empty, or may not be in use by other processes). It is not legal
266 for an implementation to partially remove a directory unless the
267 entire directory is removed. A conformant implementation need not
268 support directory removal in all situations (e.g. removal of the root
269 directory).
270
271 The operation may fail with:
272
273 * 'HardwareFault'
274 A physical I\/O error has occurred.
275 EIO
276
277 * 'InvalidArgument'
278 The operand is not a valid directory name.
279 [ENAMETOOLONG, ELOOP]
280
281 * 'isDoesNotExistError' \/ 'NoSuchThing'
282 The directory does not exist.
283 @[ENOENT, ENOTDIR]@
284
285 * 'isPermissionError' \/ 'PermissionDenied'
286 The process has insufficient privileges to perform the operation.
287 @[EROFS, EACCES, EPERM]@
288
289 * 'UnsatisfiedConstraints'
290 Implementation-dependent constraints are not satisfied.
291 @[EBUSY, ENOTEMPTY, EEXIST]@
292
293 * 'UnsupportedOperation'
294 The implementation does not support removal in this situation.
295 @[EINVAL]@
296
297 * 'InappropriateType'
298 The operand refers to an existing non-directory object.
299 @[ENOTDIR]@
300
301 -}
302
303 removeDirectory :: FilePath -> IO ()
304 removeDirectory path = do
305 modifyIOError (`ioeSetFileName` path) $
306 withCString path $ \s ->
307 throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
308 #endif
309
310 -- | @'removeDirectoryRecursive' dir@ removes an existing directory /dir/
311 -- together with its content and all subdirectories. Be careful,
312 -- if the directory contains symlinks, the function will follow them.
313 removeDirectoryRecursive :: FilePath -> IO ()
314 removeDirectoryRecursive startLoc = do
315 cont <- getDirectoryContents startLoc
316 sequence_ [rm (startLoc `joinFileName` x) | x <- cont, x /= "." && x /= ".."]
317 removeDirectory startLoc
318 where
319 rm :: FilePath -> IO ()
320 rm f = do temp <- try (removeFile f)
321 case temp of
322 Left e -> do isDir <- doesDirectoryExist f
323 -- If f is not a directory, re-throw the error
324 unless isDir $ ioError e
325 removeDirectoryRecursive f
326 Right _ -> return ()
327
328 #if __GLASGOW_HASKELL__
329 {- |'removeFile' /file/ removes the directory entry for an existing file
330 /file/, where /file/ is not itself a directory. The
331 implementation may specify additional constraints which must be
332 satisfied before a file can be removed (e.g. the file may not be in
333 use by other processes).
334
335 The operation may fail with:
336
337 * 'HardwareFault'
338 A physical I\/O error has occurred.
339 @[EIO]@
340
341 * 'InvalidArgument'
342 The operand is not a valid file name.
343 @[ENAMETOOLONG, ELOOP]@
344
345 * 'isDoesNotExistError' \/ 'NoSuchThing'
346 The file does not exist.
347 @[ENOENT, ENOTDIR]@
348
349 * 'isPermissionError' \/ 'PermissionDenied'
350 The process has insufficient privileges to perform the operation.
351 @[EROFS, EACCES, EPERM]@
352
353 * 'UnsatisfiedConstraints'
354 Implementation-dependent constraints are not satisfied.
355 @[EBUSY]@
356
357 * 'InappropriateType'
358 The operand refers to an existing directory.
359 @[EPERM, EINVAL]@
360
361 -}
362
363 removeFile :: FilePath -> IO ()
364 removeFile path = do
365 modifyIOError (`ioeSetFileName` path) $
366 withCString path $ \s ->
367 throwErrnoIfMinus1Retry_ "removeFile" (c_unlink s)
368
369 {- |@'renameDirectory' old new@ changes the name of an existing
370 directory from /old/ to /new/. If the /new/ directory
371 already exists, it is atomically replaced by the /old/ directory.
372 If the /new/ directory is neither the /old/ directory nor an
373 alias of the /old/ directory, it is removed as if by
374 'removeDirectory'. A conformant implementation need not support
375 renaming directories in all situations (e.g. renaming to an existing
376 directory, or across different physical devices), but the constraints
377 must be documented.
378
379 On Win32 platforms, @renameDirectory@ fails if the /new/ directory already
380 exists.
381
382 The operation may fail with:
383
384 * 'HardwareFault'
385 A physical I\/O error has occurred.
386 @[EIO]@
387
388 * 'InvalidArgument'
389 Either operand is not a valid directory name.
390 @[ENAMETOOLONG, ELOOP]@
391
392 * 'isDoesNotExistError' \/ 'NoSuchThing'
393 The original directory does not exist, or there is no path to the target.
394 @[ENOENT, ENOTDIR]@
395
396 * 'isPermissionError' \/ 'PermissionDenied'
397 The process has insufficient privileges to perform the operation.
398 @[EROFS, EACCES, EPERM]@
399
400 * 'ResourceExhausted'
401 Insufficient resources are available to perform the operation.
402 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
403
404 * 'UnsatisfiedConstraints'
405 Implementation-dependent constraints are not satisfied.
406 @[EBUSY, ENOTEMPTY, EEXIST]@
407
408 * 'UnsupportedOperation'
409 The implementation does not support renaming in this situation.
410 @[EINVAL, EXDEV]@
411
412 * 'InappropriateType'
413 Either path refers to an existing non-directory object.
414 @[ENOTDIR, EISDIR]@
415
416 -}
417
418 renameDirectory :: FilePath -> FilePath -> IO ()
419 renameDirectory opath npath =
420 withFileStatus "renameDirectory" opath $ \st -> do
421 is_dir <- isDirectory st
422 if (not is_dir)
423 then ioException (IOError Nothing InappropriateType "renameDirectory"
424 ("not a directory") (Just opath))
425 else do
426
427 withCString opath $ \s1 ->
428 withCString npath $ \s2 ->
429 throwErrnoIfMinus1Retry_ "renameDirectory" (c_rename s1 s2)
430
431 {- |@'renameFile' old new@ changes the name of an existing file system
432 object from /old/ to /new/. If the /new/ object already
433 exists, it is atomically replaced by the /old/ object. Neither
434 path may refer to an existing directory. A conformant implementation
435 need not support renaming files in all situations (e.g. renaming
436 across different physical devices), but the constraints must be
437 documented.
438
439 The operation may fail with:
440
441 * 'HardwareFault'
442 A physical I\/O error has occurred.
443 @[EIO]@
444
445 * 'InvalidArgument'
446 Either operand is not a valid file name.
447 @[ENAMETOOLONG, ELOOP]@
448
449 * 'isDoesNotExistError' \/ 'NoSuchThing'
450 The original file does not exist, or there is no path to the target.
451 @[ENOENT, ENOTDIR]@
452
453 * 'isPermissionError' \/ 'PermissionDenied'
454 The process has insufficient privileges to perform the operation.
455 @[EROFS, EACCES, EPERM]@
456
457 * 'ResourceExhausted'
458 Insufficient resources are available to perform the operation.
459 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
460
461 * 'UnsatisfiedConstraints'
462 Implementation-dependent constraints are not satisfied.
463 @[EBUSY]@
464
465 * 'UnsupportedOperation'
466 The implementation does not support renaming in this situation.
467 @[EXDEV]@
468
469 * 'InappropriateType'
470 Either path refers to an existing directory.
471 @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@
472
473 -}
474
475 renameFile :: FilePath -> FilePath -> IO ()
476 renameFile opath npath =
477 withFileOrSymlinkStatus "renameFile" opath $ \st -> do
478 is_dir <- isDirectory st
479 if is_dir
480 then ioException (IOError Nothing InappropriateType "renameFile"
481 "is a directory" (Just opath))
482 else do
483
484 withCString opath $ \s1 ->
485 withCString npath $ \s2 ->
486 throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
487
488 #endif /* __GLASGOW_HASKELL__ */
489
490 {- |@'copyFile' old new@ copies the existing file from /old/ to /new/.
491 If the /new/ file already exists, it is atomically replaced by the /old/ file.
492 Neither path may refer to an existing directory.
493 -}
494 copyFile :: FilePath -> FilePath -> IO ()
495 copyFile fromFPath toFPath =
496 #if defined(__HUGS__)
497 (bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
498 bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo -> do
499 hGetContents hFrom >>= hPutStr hTo
500 try (getPermissions fromFPath >>= setPermissions toFPath)
501 return ()) `catch` \err ->
502 ioError (annotateIOError err "copyFile" Nothing Nothing)
503 #elif (!defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ <= 600)
504 do readFile fromFPath >>= writeFile toFPath
505 try (getPermissions fromFPath >>= setPermissions toFPath)
506 return ()
507 #else
508 (bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
509 bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo ->
510 allocaBytes bufferSize $ \buffer -> do
511 copyContents hFrom hTo buffer
512 try (getPermissions fromFPath >>= setPermissions toFPath)
513 return ()) `catch` (ioError . changeFunName)
514 where
515 bufferSize = 1024
516
517 changeFunName (IOError h iot fun str mb_fp) = IOError h iot "copyFile" str mb_fp
518
519 copyContents hFrom hTo buffer = do
520 count <- hGetBuf hFrom buffer bufferSize
521 when (count > 0) $ do
522 hPutBuf hTo buffer count
523 copyContents hFrom hTo buffer
524 #endif
525
526 #ifdef __GLASGOW_HASKELL__
527 -- | Given path referring to a file or directory, returns a
528 -- canonicalized path, with the intent that two paths referring
529 -- to the same file\/directory will map to the same canonicalized
530 -- path. Note that it is impossible to guarantee that the
531 -- implication (same file\/dir \<=\> same canonicalizedPath) holds
532 -- in either direction: this function can make only a best-effort
533 -- attempt.
534 canonicalizePath :: FilePath -> IO FilePath
535 canonicalizePath fpath =
536 withCString fpath $ \pInPath ->
537 allocaBytes long_path_size $ \pOutPath ->
538 #if defined(mingw32_HOST_OS)
539 alloca $ \ppFilePart ->
540 do c_GetFullPathName pInPath (fromIntegral long_path_size) pOutPath ppFilePart
541 #else
542 do c_realpath pInPath pOutPath
543 #endif
544 peekCString pOutPath
545
546 #if defined(mingw32_HOST_OS)
547 foreign import stdcall unsafe "GetFullPathName"
548 c_GetFullPathName :: CString
549 -> CInt
550 -> CString
551 -> Ptr CString
552 -> IO CInt
553 #else
554 foreign import ccall unsafe "realpath"
555 c_realpath :: CString
556 -> CString
557 -> IO CString
558 #endif
559 #else /* !__GLASGOW_HASKELL__ */
560 -- dummy implementation
561 canonicalizePath :: FilePath -> IO FilePath
562 canonicalizePath fpath = return fpath
563 #endif /* !__GLASGOW_HASKELL__ */
564
565 -- | Given an executable file name, searches for such file
566 -- in the directories listed in system PATH. The returned value
567 -- is the path to the found executable or Nothing if there isn't
568 -- such executable. For example (findExecutable \"ghc\")
569 -- gives you the path to GHC.
570 findExecutable :: String -> IO (Maybe FilePath)
571 findExecutable binary = do
572 path <- getEnv "PATH"
573 search (parseSearchPath path)
574 where
575 fileName = binary `joinFileExt` exeExtension
576
577 search :: [FilePath] -> IO (Maybe FilePath)
578 search [] = return Nothing
579 search (d:ds) = do
580 let path = d `joinFileName` fileName
581 b <- doesFileExist path
582 if b then return (Just path)
583 else search ds
584
585 #ifdef __GLASGOW_HASKELL__
586 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
587 in /dir/.
588
589 The operation may fail with:
590
591 * 'HardwareFault'
592 A physical I\/O error has occurred.
593 @[EIO]@
594
595 * 'InvalidArgument'
596 The operand is not a valid directory name.
597 @[ENAMETOOLONG, ELOOP]@
598
599 * 'isDoesNotExistError' \/ 'NoSuchThing'
600 The directory does not exist.
601 @[ENOENT, ENOTDIR]@
602
603 * 'isPermissionError' \/ 'PermissionDenied'
604 The process has insufficient privileges to perform the operation.
605 @[EACCES]@
606
607 * 'ResourceExhausted'
608 Insufficient resources are available to perform the operation.
609 @[EMFILE, ENFILE]@
610
611 * 'InappropriateType'
612 The path refers to an existing non-directory object.
613 @[ENOTDIR]@
614
615 -}
616
617 getDirectoryContents :: FilePath -> IO [FilePath]
618 getDirectoryContents path = do
619 modifyIOError (`ioeSetFileName` path) $
620 alloca $ \ ptr_dEnt ->
621 bracket
622 (withCString path $ \s ->
623 throwErrnoIfNullRetry desc (c_opendir s))
624 (\p -> throwErrnoIfMinus1_ desc (c_closedir p))
625 (\p -> loop ptr_dEnt p)
626 where
627 desc = "getDirectoryContents"
628
629 loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
630 loop ptr_dEnt dir = do
631 resetErrno
632 r <- readdir dir ptr_dEnt
633 if (r == 0)
634 then do
635 dEnt <- peek ptr_dEnt
636 if (dEnt == nullPtr)
637 then return []
638 else do
639 entry <- (d_name dEnt >>= peekCString)
640 freeDirEnt dEnt
641 entries <- loop ptr_dEnt dir
642 return (entry:entries)
643 else do errno <- getErrno
644 if (errno == eINTR) then loop ptr_dEnt dir else do
645 let (Errno eo) = errno
646 if (eo == end_of_dir)
647 then return []
648 else throwErrno desc
649
650
651
652 {- |If the operating system has a notion of current directories,
653 'getCurrentDirectory' returns an absolute path to the
654 current directory of the calling process.
655
656 The operation may fail with:
657
658 * 'HardwareFault'
659 A physical I\/O error has occurred.
660 @[EIO]@
661
662 * 'isDoesNotExistError' \/ 'NoSuchThing'
663 There is no path referring to the current directory.
664 @[EPERM, ENOENT, ESTALE...]@
665
666 * 'isPermissionError' \/ 'PermissionDenied'
667 The process has insufficient privileges to perform the operation.
668 @[EACCES]@
669
670 * 'ResourceExhausted'
671 Insufficient resources are available to perform the operation.
672
673 * 'UnsupportedOperation'
674 The operating system has no notion of current directory.
675
676 -}
677
678 getCurrentDirectory :: IO FilePath
679 getCurrentDirectory = do
680 p <- mallocBytes long_path_size
681 go p long_path_size
682 where go p bytes = do
683 p' <- c_getcwd p (fromIntegral bytes)
684 if p' /= nullPtr
685 then do s <- peekCString p'
686 free p'
687 return s
688 else do errno <- getErrno
689 if errno == eRANGE
690 then do let bytes' = bytes * 2
691 p' <- reallocBytes p bytes'
692 go p' bytes'
693 else throwErrno "getCurrentDirectory"
694
695 {- |If the operating system has a notion of current directories,
696 @'setCurrentDirectory' dir@ changes the current
697 directory of the calling process to /dir/.
698
699 The operation may fail with:
700
701 * 'HardwareFault'
702 A physical I\/O error has occurred.
703 @[EIO]@
704
705 * 'InvalidArgument'
706 The operand is not a valid directory name.
707 @[ENAMETOOLONG, ELOOP]@
708
709 * 'isDoesNotExistError' \/ 'NoSuchThing'
710 The directory does not exist.
711 @[ENOENT, ENOTDIR]@
712
713 * 'isPermissionError' \/ 'PermissionDenied'
714 The process has insufficient privileges to perform the operation.
715 @[EACCES]@
716
717 * 'UnsupportedOperation'
718 The operating system has no notion of current directory, or the
719 current directory cannot be dynamically changed.
720
721 * 'InappropriateType'
722 The path refers to an existing non-directory object.
723 @[ENOTDIR]@
724
725 -}
726
727 setCurrentDirectory :: FilePath -> IO ()
728 setCurrentDirectory path = do
729 modifyIOError (`ioeSetFileName` path) $
730 withCString path $ \s ->
731 throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
732 -- ToDo: add path to error
733
734 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
735 exists and is a directory, and 'False' otherwise.
736 -}
737
738 doesDirectoryExist :: FilePath -> IO Bool
739 doesDirectoryExist name =
740 catch
741 (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
742 (\ _ -> return False)
743
744 {- |The operation 'doesFileExist' returns 'True'
745 if the argument file exists and is not a directory, and 'False' otherwise.
746 -}
747
748 doesFileExist :: FilePath -> IO Bool
749 doesFileExist name = do
750 catch
751 (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
752 (\ _ -> return False)
753
754 {- |The 'getModificationTime' operation returns the
755 clock time at which the file or directory was last modified.
756
757 The operation may fail with:
758
759 * 'isPermissionError' if the user is not permitted to access
760 the modification time; or
761
762 * 'isDoesNotExistError' if the file or directory does not exist.
763
764 -}
765
766 getModificationTime :: FilePath -> IO ClockTime
767 getModificationTime name =
768 withFileStatus "getModificationTime" name $ \ st ->
769 modificationTime st
770
771 withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
772 withFileStatus loc name f = do
773 modifyIOError (`ioeSetFileName` name) $
774 allocaBytes sizeof_stat $ \p ->
775 withCString (fileNameEndClean name) $ \s -> do
776 throwErrnoIfMinus1Retry_ loc (c_stat s p)
777 f p
778
779 withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
780 withFileOrSymlinkStatus loc name f = do
781 modifyIOError (`ioeSetFileName` name) $
782 allocaBytes sizeof_stat $ \p ->
783 withCString name $ \s -> do
784 throwErrnoIfMinus1Retry_ loc (lstat s p)
785 f p
786
787 modificationTime :: Ptr CStat -> IO ClockTime
788 modificationTime stat = do
789 mtime <- st_mtime stat
790 let realToInteger = round . realToFrac :: Real a => a -> Integer
791 return (TOD (realToInteger (mtime :: CTime)) 0)
792
793 isDirectory :: Ptr CStat -> IO Bool
794 isDirectory stat = do
795 mode <- st_mode stat
796 return (s_isdir mode)
797
798 fileNameEndClean :: String -> String
799 fileNameEndClean name =
800 if i > 0 && (ec == '\\' || ec == '/') then
801 fileNameEndClean (take i name)
802 else
803 name
804 where
805 i = (length name) - 1
806 ec = name !! i
807
808 foreign import ccall unsafe "__hscore_long_path_size"
809 long_path_size :: Int
810
811 foreign import ccall unsafe "__hscore_R_OK" r_OK :: CMode
812 foreign import ccall unsafe "__hscore_W_OK" w_OK :: CMode
813 foreign import ccall unsafe "__hscore_X_OK" x_OK :: CMode
814
815 foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
816 foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
817 foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode
818
819 #endif /* __GLASGOW_HASKELL__ */
820
821 {- | Returns the current user's home directory.
822
823 The directory returned is expected to be writable by the current user,
824 but note that it isn't generally considered good practice to store
825 application-specific data here; use 'getAppUserDataDirectory'
826 instead.
827
828 On Unix, 'getHomeDirectory' returns the value of the @HOME@
829 environment variable. On Windows, the system is queried for a
830 suitable path; a typical path might be
831 @C:/Documents And Settings/user@.
832
833 The operation may fail with:
834
835 * 'UnsupportedOperation'
836 The operating system has no notion of home directory.
837
838 * 'isDoesNotExistError'
839 The home directory for the current user does not exist, or
840 cannot be found.
841 -}
842 getHomeDirectory :: IO FilePath
843 getHomeDirectory =
844 #if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS)
845 allocaBytes long_path_size $ \pPath -> do
846 r <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
847 if (r < 0)
848 then c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
849 else return 0
850 peekCString pPath
851 #else
852 getEnv "HOME"
853 #endif
854
855 {- | Returns the pathname of a directory in which application-specific
856 data for the current user can be stored. The result of
857 'getAppUserDataDirectory' for a given application is specific to
858 the current user.
859
860 The argument should be the name of the application, which will be used
861 to construct the pathname (so avoid using unusual characters that
862 might result in an invalid pathname).
863
864 Note: the directory may not actually exist, and may need to be created
865 first. It is expected that the parent directory exists and is
866 writable.
867
868 On Unix, this function returns @$HOME\/.appName@. On Windows, a
869 typical path might be
870
871 > C:/Documents And Settings/user/Application Data/appName
872
873 The operation may fail with:
874
875 * 'UnsupportedOperation'
876 The operating system has no notion of application-specific data directory.
877
878 * 'isDoesNotExistError'
879 The home directory for the current user does not exist, or
880 cannot be found.
881 -}
882 getAppUserDataDirectory :: String -> IO FilePath
883 getAppUserDataDirectory appName = do
884 #if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS)
885 allocaBytes long_path_size $ \pPath -> do
886 r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
887 s <- peekCString pPath
888 return (s++'\\':appName)
889 #else
890 path <- getEnv "HOME"
891 return (path++'/':'.':appName)
892 #endif
893
894 {- | Returns the current user's document directory.
895
896 The directory returned is expected to be writable by the current user,
897 but note that it isn't generally considered good practice to store
898 application-specific data here; use 'getAppUserDataDirectory'
899 instead.
900
901 On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@
902 environment variable. On Windows, the system is queried for a
903 suitable path; a typical path might be
904 @C:\/Documents and Settings\/user\/My Documents@.
905
906 The operation may fail with:
907
908 * 'UnsupportedOperation'
909 The operating system has no notion of document directory.
910
911 * 'isDoesNotExistError'
912 The document directory for the current user does not exist, or
913 cannot be found.
914 -}
915 getUserDocumentsDirectory :: IO FilePath
916 getUserDocumentsDirectory = do
917 #if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS)
918 allocaBytes long_path_size $ \pPath -> do
919 r <- c_SHGetFolderPath nullPtr csidl_PERSONAL nullPtr 0 pPath
920 peekCString pPath
921 #else
922 getEnv "HOME"
923 #endif
924
925 {- | Returns the current directory for temporary files.
926
927 On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@
928 environment variable or \"\/tmp\" if the variable isn\'t defined.
929 On Windows, the function checks for the existence of environment variables in
930 the following order and uses the first path found:
931
932 *
933 TMP environment variable.
934
935 *
936 TEMP environment variable.
937
938 *
939 USERPROFILE environment variable.
940
941 *
942 The Windows directory
943
944 The operation may fail with:
945
946 * 'UnsupportedOperation'
947 The operating system has no notion of temporary directory.
948
949 The function doesn\'t verify whether the path exists.
950 -}
951 getTemporaryDirectory :: IO FilePath
952 getTemporaryDirectory = do
953 #if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS)
954 allocaBytes long_path_size $ \pPath -> do
955 r <- c_GetTempPath (fromIntegral long_path_size) pPath
956 peekCString pPath
957 #else
958 catch (getEnv "TMPDIR") (\ex -> return "/tmp")
959 #endif
960
961 #if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS)
962 foreign import stdcall unsafe "SHGetFolderPath"
963 c_SHGetFolderPath :: Ptr ()
964 -> CInt
965 -> Ptr ()
966 -> CInt
967 -> CString
968 -> IO CInt
969 foreign import ccall unsafe "__hscore_CSIDL_PROFILE" csidl_PROFILE :: CInt
970 foreign import ccall unsafe "__hscore_CSIDL_APPDATA" csidl_APPDATA :: CInt
971 foreign import ccall unsafe "__hscore_CSIDL_WINDOWS" csidl_WINDOWS :: CInt
972 foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt
973
974 foreign import stdcall unsafe "GetTempPath" c_GetTempPath :: CInt -> CString -> IO CInt
975 #endif