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