[project @ 2003-08-22 23:44:40 by sof]
[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 : provisional
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 , removeDirectory -- :: FilePath -> IO ()
22 , renameDirectory -- :: FilePath -> FilePath -> IO ()
23
24 , getDirectoryContents -- :: FilePath -> IO [FilePath]
25 , getCurrentDirectory -- :: IO FilePath
26 , setCurrentDirectory -- :: FilePath -> IO ()
27
28 -- * Actions on files
29 , removeFile -- :: FilePath -> IO ()
30 , renameFile -- :: FilePath -> FilePath -> IO ()
31
32 -- * Existence tests
33 , doesFileExist -- :: FilePath -> IO Bool
34 , doesDirectoryExist -- :: FilePath -> IO Bool
35
36 -- * Permissions
37
38 -- $permissions
39
40 , Permissions(
41 Permissions,
42 readable, -- :: Permissions -> Bool
43 writable, -- :: Permissions -> Bool
44 executable, -- :: Permissions -> Bool
45 searchable -- :: Permissions -> Bool
46 )
47
48 , getPermissions -- :: FilePath -> IO Permissions
49 , setPermissions -- :: FilePath -> Permissions -> IO ()
50
51 -- * Timestamps
52
53 , getModificationTime -- :: FilePath -> IO ClockTime
54 ) where
55
56 #ifdef __NHC__
57 import Directory
58 #elif defined(__HUGS__)
59 import Hugs.Directory
60 #else
61
62 import Prelude
63
64 import Control.Exception ( bracket )
65 import System.Posix.Types
66 import System.Time ( ClockTime(..) )
67 import System.IO
68 import System.IO.Error
69 import Foreign
70 import Foreign.C
71
72 #ifdef __GLASGOW_HASKELL__
73 import System.Posix.Internals
74 import GHC.IOBase ( IOException(..), IOErrorType(..), ioException )
75 #endif
76
77 {- $intro
78 A directory contains a series of entries, each of which is a named
79 reference to a file system object (file, directory etc.). Some
80 entries may be hidden, inaccessible, or have some administrative
81 function (e.g. `.' or `..' under POSIX
82 <http://www.opengroup.org/onlinepubs/007904975/toc.htm>), but in
83 this standard all such entries are considered to form part of the
84 directory contents. Entries in sub-directories are not, however,
85 considered to form part of the directory contents.
86
87 Each file system object is referenced by a /path/. There is
88 normally at least one absolute path to each file system object. In
89 some operating systems, it may also be possible to have paths which
90 are relative to the current directory.
91 -}
92
93 -----------------------------------------------------------------------------
94 -- Permissions
95
96 {- $permissions
97
98 The 'Permissions' type is used to record whether certain operations are
99 permissible on a file\/directory. 'getPermissions' and 'setPermissions'
100 get and set these permissions, respectively. Permissions apply both to
101 files and directories. For directories, the executable field will be
102 'False', and for files the searchable field will be 'False'. Note that
103 directories may be searchable without being readable, if permission has
104 been given to use them as part of a path, but not to examine the
105 directory contents.
106
107 Note that to change some, but not all permissions, a construct on the following lines must be used.
108
109 > makeReadable f = do
110 > p <- getPermissions f
111 > setPermissions f (p {readable = True})
112
113 -}
114
115 data Permissions
116 = Permissions {
117 readable, writable,
118 executable, searchable :: Bool
119 } deriving (Eq, Ord, Read, Show)
120
121 {- |The 'getPermissions' operation returns the
122 permissions for the file or directory.
123
124 The operation may fail with:
125
126 * 'isPermissionError' if the user is not permitted to access
127 the permissions; or
128
129 * 'isDoesNotExistError' if the file or directory does not exist.
130
131 -}
132
133 getPermissions :: FilePath -> IO Permissions
134 getPermissions name = do
135 withCString name $ \s -> do
136 read <- c_access s r_OK
137 write <- c_access s w_OK
138 exec <- c_access s x_OK
139 withFileStatus "getPermissions" name $ \st -> do
140 is_dir <- isDirectory st
141 return (
142 Permissions {
143 readable = read == 0,
144 writable = write == 0,
145 executable = not is_dir && exec == 0,
146 searchable = is_dir && exec == 0
147 }
148 )
149
150 {- |The 'setPermissions' operation sets the
151 permissions for the file or directory.
152
153 The operation may fail with:
154
155 * 'isPermissionError' if the user is not permitted to set
156 the permissions; or
157
158 * 'isDoesNotExistError' if the file or directory does not exist.
159
160 -}
161
162 setPermissions :: FilePath -> Permissions -> IO ()
163 setPermissions name (Permissions r w e s) = do
164 let
165 read = if r then s_IRUSR else emptyCMode
166 write = if w then s_IWUSR else emptyCMode
167 exec = if e || s then s_IXUSR else emptyCMode
168
169 mode = read `unionCMode` (write `unionCMode` exec)
170
171 withCString name $ \s ->
172 throwErrnoIfMinus1_ "setPermissions" $ c_chmod s mode
173
174 -----------------------------------------------------------------------------
175 -- Implementation
176
177 {- |@'createDirectory' dir@ creates a new directory @dir@ which is
178 initially empty, or as near to empty as the operating system
179 allows.
180
181 The operation may fail with:
182
183 * 'isPermissionError' \/ 'PermissionDenied'
184 The process has insufficient privileges to perform the operation.
185 @[EROFS, EACCES]@
186
187 * 'isAlreadyExistsError' \/ 'AlreadyExists'
188 The operand refers to a directory that already exists.
189 @ [EEXIST]@
190
191 * 'HardwareFault'
192 A physical I\/O error has occurred.
193 @[EIO]@
194
195 * 'InvalidArgument'
196 The operand is not a valid directory name.
197 @[ENAMETOOLONG, ELOOP]@
198
199 * 'NoSuchThing'
200 There is no path to the directory.
201 @[ENOENT, ENOTDIR]@
202
203 * 'ResourceExhausted'
204 Insufficient resources (virtual memory, process file descriptors,
205 physical disk space, etc.) are available to perform the operation.
206 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
207
208 * 'InappropriateType'
209 The path refers to an existing non-directory object.
210 @[EEXIST]@
211
212 -}
213
214 createDirectory :: FilePath -> IO ()
215 createDirectory path = do
216 withCString path $ \s -> do
217 throwErrnoIfMinus1Retry_ "createDirectory" $
218 mkdir s 0o777
219
220 {- | @'removeDirectory' dir@ removes an existing directory /dir/. The
221 implementation may specify additional constraints which must be
222 satisfied before a directory can be removed (e.g. the directory has to
223 be empty, or may not be in use by other processes). It is not legal
224 for an implementation to partially remove a directory unless the
225 entire directory is removed. A conformant implementation need not
226 support directory removal in all situations (e.g. removal of the root
227 directory).
228
229 The operation may fail with:
230
231 * 'HardwareFault'
232 A physical I\/O error has occurred.
233 EIO
234
235 * 'InvalidArgument'
236 The operand is not a valid directory name.
237 [ENAMETOOLONG, ELOOP]
238
239 * 'isDoesNotExist' 'NoSuchThing'
240 The directory does not exist.
241 @[ENOENT, ENOTDIR]@
242
243 * 'isPermissionError' \/ 'PermissionDenied'
244 The process has insufficient privileges to perform the operation.
245 @[EROFS, EACCES, EPERM]@
246
247 * 'UnsatisfiedConstraints'
248 Implementation-dependent constraints are not satisfied.
249 @[EBUSY, ENOTEMPTY, EEXIST]@
250
251 * 'UnsupportedOperation'
252 The implementation does not support removal in this situation.
253 @[EINVAL]@
254
255 * 'InappropriateType'
256 The operand refers to an existing non-directory object.
257 @[ENOTDIR]@
258
259 -}
260
261 removeDirectory :: FilePath -> IO ()
262 removeDirectory path = do
263 modifyIOError (`ioeSetFileName` path) $
264 withCString path $ \s ->
265 throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
266
267 {- |@'removefile' file@ removes the directory entry for an existing file
268 /file/, where /file/ is not itself a directory. The
269 implementation may specify additional constraints which must be
270 satisfied before a file can be removed (e.g. the file may not be in
271 use by other processes).
272
273 The operation may fail with:
274
275 * 'HardwareFault'
276 A physical I\/O error has occurred.
277 'EIO'
278
279 * 'InvalidArgument'
280 The operand is not a valid file name.
281 @[ENAMETOOLONG, ELOOP]@
282
283 * 'isDoesNotExist' \/ 'NoSuchThing'
284 The file does not exist.
285 @[ENOENT, ENOTDIR]@
286
287 * 'isPermissionError' \/ 'PermissionDenied'
288 The process has insufficient privileges to perform the operation.
289 @[EROFS, EACCES, EPERM]@
290
291 * 'UnsatisfiedConstraints'
292 Implementation-dependent constraints are not satisfied.
293 @[EBUSY]@
294
295 * 'InappropriateType'
296 The operand refers to an existing directory.
297 @[EPERM, EINVAL]@
298
299 -}
300
301 removeFile :: FilePath -> IO ()
302 removeFile path = do
303 modifyIOError (`ioeSetFileName` path) $
304 withCString path $ \s ->
305 throwErrnoIfMinus1Retry_ "removeFile" (c_unlink s)
306
307 {- |@'renameDirectory' old new@ changes the name of an existing
308 directory from /old/ to /new/. If the /new/ directory
309 already exists, it is atomically replaced by the /old/ directory.
310 If the /new/ directory is neither the /old/ directory nor an
311 alias of the /old/ directory, it is removed as if by
312 'removeDirectory'. A conformant implementation need not support
313 renaming directories in all situations (e.g. renaming to an existing
314 directory, or across different physical devices), but the constraints
315 must be documented.
316
317 On Win32 platforms, @renameDirectory@ fails if the /new/ directory already
318 exists.
319
320 The operation may fail with:
321
322 * 'HardwareFault'
323 A physical I\/O error has occurred.
324 @[EIO]@
325
326 * 'InvalidArgument'
327 Either operand is not a valid directory name.
328 @[ENAMETOOLONG, ELOOP]@
329
330 * 'isDoesNotExistError' \/ 'NoSuchThing'
331 The original directory does not exist, or there is no path to the target.
332 @[ENOENT, ENOTDIR]@
333
334 * 'isPermissionError' \/ 'PermissionDenied'
335 The process has insufficient privileges to perform the operation.
336 @[EROFS, EACCES, EPERM]@
337
338 * 'ResourceExhausted'
339 Insufficient resources are available to perform the operation.
340 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
341
342 * 'UnsatisfiedConstraints'
343 Implementation-dependent constraints are not satisfied.
344 @[EBUSY, ENOTEMPTY, EEXIST]@
345
346 * 'UnsupportedOperation'
347 The implementation does not support renaming in this situation.
348 @[EINVAL, EXDEV]@
349
350 * 'InappropriateType'
351 Either path refers to an existing non-directory object.
352 @[ENOTDIR, EISDIR]@
353
354 -}
355
356 renameDirectory :: FilePath -> FilePath -> IO ()
357 renameDirectory opath npath =
358 withFileStatus "renameDirectory" opath $ \st -> do
359 is_dir <- isDirectory st
360 if (not is_dir)
361 then ioException (IOError Nothing InappropriateType "renameDirectory"
362 ("not a directory") (Just opath))
363 else do
364
365 withCString opath $ \s1 ->
366 withCString npath $ \s2 ->
367 throwErrnoIfMinus1Retry_ "renameDirectory" (c_rename s1 s2)
368
369 {- |@'renameFile' old new@ changes the name of an existing file system
370 object from /old/ to /new/. If the /new/ object already
371 exists, it is atomically replaced by the /old/ object. Neither
372 path may refer to an existing directory. A conformant implementation
373 need not support renaming files in all situations (e.g. renaming
374 across different physical devices), but the constraints must be
375 documented.
376
377 The operation may fail with:
378
379 * 'HardwareFault'
380 A physical I\/O error has occurred.
381 @[EIO]@
382
383 * 'InvalidArgument'
384 Either operand is not a valid file name.
385 @[ENAMETOOLONG, ELOOP]@
386
387 * 'isDoesNotExistError' \/ 'NoSuchThing'
388 The original file does not exist, or there is no path to the target.
389 @[ENOENT, ENOTDIR]@
390
391 * 'isPermissionError' \/ 'PermissionDenied'
392 The process has insufficient privileges to perform the operation.
393 @[EROFS, EACCES, EPERM]@
394
395 * 'ResourceExhausted'
396 Insufficient resources are available to perform the operation.
397 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
398
399 * 'UnsatisfiedConstraints'
400 Implementation-dependent constraints are not satisfied.
401 @[EBUSY]@
402
403 * 'UnsupportedOperation'
404 The implementation does not support renaming in this situation.
405 @[EXDEV]@
406
407 * 'InappropriateType'
408 Either path refers to an existing directory.
409 @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@
410
411 -}
412
413 renameFile :: FilePath -> FilePath -> IO ()
414 renameFile opath npath =
415 withFileOrSymlinkStatus "renameFile" opath $ \st -> do
416 is_dir <- isDirectory st
417 if is_dir
418 then ioException (IOError Nothing InappropriateType "renameFile"
419 "is a directory" (Just opath))
420 else do
421
422 withCString opath $ \s1 ->
423 withCString npath $ \s2 ->
424 throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
425
426 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
427 in /dir/.
428
429 The operation may fail with:
430
431 * 'HardwareFault'
432 A physical I\/O error has occurred.
433 @[EIO]@
434
435 * 'InvalidArgument'
436 The operand is not a valid directory name.
437 @[ENAMETOOLONG, ELOOP]@
438
439 * 'isDoesNotExistError' \/ 'NoSuchThing'
440 The directory does not exist.
441 @[ENOENT, ENOTDIR]@
442
443 * 'isPermissionError' \/ 'PermissionDenied'
444 The process has insufficient privileges to perform the operation.
445 @[EACCES]@
446
447 * 'ResourceExhausted'
448 Insufficient resources are available to perform the operation.
449 @[EMFILE, ENFILE]@
450
451 * 'InappropriateType'
452 The path refers to an existing non-directory object.
453 @[ENOTDIR]@
454
455 -}
456
457 getDirectoryContents :: FilePath -> IO [FilePath]
458 getDirectoryContents path = do
459 modifyIOError (`ioeSetFileName` path) $
460 alloca $ \ ptr_dEnt ->
461 bracket
462 (withCString path $ \s ->
463 throwErrnoIfNullRetry desc (c_opendir s))
464 (\p -> throwErrnoIfMinus1_ desc (c_closedir p))
465 (\p -> loop ptr_dEnt p)
466 where
467 desc = "getDirectoryContents"
468
469 loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
470 loop ptr_dEnt dir = do
471 resetErrno
472 r <- readdir dir ptr_dEnt
473 if (r == 0)
474 then do
475 dEnt <- peek ptr_dEnt
476 if (dEnt == nullPtr)
477 then return []
478 else do
479 entry <- (d_name dEnt >>= peekCString)
480 freeDirEnt dEnt
481 entries <- loop ptr_dEnt dir
482 return (entry:entries)
483 else do errno <- getErrno
484 if (errno == eINTR) then loop ptr_dEnt dir else do
485 let (Errno eo) = errno
486 if (eo == end_of_dir)
487 then return []
488 else throwErrno desc
489
490
491
492 {- |If the operating system has a notion of current directories,
493 'getCurrentDirectory' returns an absolute path to the
494 current directory of the calling process.
495
496 The operation may fail with:
497
498 * 'HardwareFault'
499 A physical I\/O error has occurred.
500 @[EIO]@
501
502 * 'isDoesNotExistError' \/ 'NoSuchThing'
503 There is no path referring to the current directory.
504 @[EPERM, ENOENT, ESTALE...]@
505
506 * 'isPermissionError' \/ 'PermissionDenied'
507 The process has insufficient privileges to perform the operation.
508 @[EACCES]@
509
510 * 'ResourceExhausted'
511 Insufficient resources are available to perform the operation.
512
513 * 'UnsupportedOperation'
514 The operating system has no notion of current directory.
515
516 -}
517
518 getCurrentDirectory :: IO FilePath
519 getCurrentDirectory = do
520 p <- mallocBytes path_max
521 go p path_max
522 where go p bytes = do
523 p' <- c_getcwd p (fromIntegral bytes)
524 if p' /= nullPtr
525 then do s <- peekCString p'
526 free p'
527 return s
528 else do errno <- getErrno
529 if errno == eRANGE
530 then do let bytes' = bytes * 2
531 p' <- reallocBytes p bytes'
532 go p' bytes'
533 else throwErrno "getCurrentDirectory"
534
535 {- |If the operating system has a notion of current directories,
536 @'setCurrentDirectory' dir@ changes the current
537 directory of the calling process to /dir/.
538
539 The operation may fail with:
540
541 * 'HardwareFault'
542 A physical I\/O error has occurred.
543 @[EIO]@
544
545 * 'InvalidArgument'
546 The operand is not a valid directory name.
547 @[ENAMETOOLONG, ELOOP]@
548
549 * 'isDoesNotExistError' \/ 'NoSuchThing'
550 The directory does not exist.
551 @[ENOENT, ENOTDIR]@
552
553 * 'isPermissionError' \/ 'PermissionDenied'
554 The process has insufficient privileges to perform the operation.
555 @[EACCES]@
556
557 * 'UnsupportedOperation'
558 The operating system has no notion of current directory, or the
559 current directory cannot be dynamically changed.
560
561 * 'InappropriateType'
562 The path refers to an existing non-directory object.
563 @[ENOTDIR]@
564
565 -}
566
567 setCurrentDirectory :: FilePath -> IO ()
568 setCurrentDirectory path = do
569 modifyIOError (`ioeSetFileName` path) $
570 withCString path $ \s ->
571 throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
572 -- ToDo: add path to error
573
574 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
575 exists and is a directory, and 'False' otherwise.
576 -}
577
578 doesDirectoryExist :: FilePath -> IO Bool
579 doesDirectoryExist name =
580 catch
581 (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
582 (\ _ -> return False)
583
584 {- |The operation 'doesFileExist' returns 'True'
585 if the argument file exists and is not a directory, and 'False' otherwise.
586 -}
587
588 doesFileExist :: FilePath -> IO Bool
589 doesFileExist name = do
590 catch
591 (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
592 (\ _ -> return False)
593
594 {- |The 'getModificationTime' operation returns the
595 clock time at which the file or directory was last modified.
596
597 The operation may fail with:
598
599 * 'isPermissionError' if the user is not permitted to access
600 the modification time; or
601
602 * 'isDoesNotExistError' if the file or directory does not exist.
603
604 -}
605
606 getModificationTime :: FilePath -> IO ClockTime
607 getModificationTime name =
608 withFileStatus "getModificationTime" name $ \ st ->
609 modificationTime st
610
611 withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
612 withFileStatus loc name f = do
613 modifyIOError (`ioeSetFileName` name) $
614 allocaBytes sizeof_stat $ \p ->
615 withCString (fileNameEndClean name) $ \s -> do
616 throwErrnoIfMinus1Retry_ loc (c_stat s p)
617 f p
618
619 withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
620 withFileOrSymlinkStatus loc name f = do
621 modifyIOError (`ioeSetFileName` name) $
622 allocaBytes sizeof_stat $ \p ->
623 withCString name $ \s -> do
624 throwErrnoIfMinus1Retry_ loc (lstat s p)
625 f p
626
627 modificationTime :: Ptr CStat -> IO ClockTime
628 modificationTime stat = do
629 mtime <- st_mtime stat
630 return (TOD (toInteger (mtime :: CTime)) 0)
631
632 isDirectory :: Ptr CStat -> IO Bool
633 isDirectory stat = do
634 mode <- st_mode stat
635 return (s_isdir mode)
636
637 fileNameEndClean :: String -> String
638 fileNameEndClean name =
639 if i >= 0 && (ec == '\\' || ec == '/') then
640 fileNameEndClean (take i name)
641 else
642 name
643 where
644 i = (length name) - 1
645 ec = name !! i
646
647 emptyCMode :: CMode
648 emptyCMode = 0
649
650 unionCMode :: CMode -> CMode -> CMode
651 unionCMode = (+)
652
653
654 foreign import ccall unsafe "__hscore_path_max"
655 path_max :: Int
656
657 foreign import ccall unsafe "__hscore_R_OK" r_OK :: CMode
658 foreign import ccall unsafe "__hscore_W_OK" w_OK :: CMode
659 foreign import ccall unsafe "__hscore_X_OK" x_OK :: CMode
660
661 foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
662 foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
663 foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode
664
665 #endif