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