abccc6875c70685f3e57a59f0ca4390032d84555
[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 System.Posix.Internals
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 On Win32 platforms, @renameDirectory@ fails if the /new/ directory already
296 exists.
297
298 The operation may fail with:
299
300 * 'HardwareFault'
301 A physical I\/O error has occurred.
302 @[EIO]@
303
304 * 'InvalidArgument'
305 Either operand is not a valid directory name.
306 @[ENAMETOOLONG, ELOOP]@
307
308 * 'isDoesNotExistError' \/ 'NoSuchThing'
309 The original directory does not exist, or there is no path to the target.
310 @[ENOENT, ENOTDIR]@
311
312 * 'isPermissionError' \/ 'PermissionDenied'
313 The process has insufficient privileges to perform the operation.
314 @[EROFS, EACCES, EPERM]@
315
316 * 'ResourceExhausted'
317 Insufficient resources are available to perform the operation.
318 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
319
320 * 'UnsatisfiedConstraints'
321 Implementation-dependent constraints are not satisfied.
322 @[EBUSY, ENOTEMPTY, EEXIST]@
323
324 * 'UnsupportedOperation'
325 The implementation does not support renaming in this situation.
326 @[EINVAL, EXDEV]@
327
328 * 'InappropriateType'
329 Either path refers to an existing non-directory object.
330 @[ENOTDIR, EISDIR]@
331
332 -}
333
334 renameDirectory :: FilePath -> FilePath -> IO ()
335 renameDirectory opath npath =
336 withFileStatus opath $ \st -> do
337 is_dir <- isDirectory st
338 if (not is_dir)
339 then ioException (IOError Nothing InappropriateType "renameDirectory"
340 ("not a directory") (Just opath))
341 else do
342
343 withCString opath $ \s1 ->
344 withCString npath $ \s2 ->
345 throwErrnoIfMinus1Retry_ "renameDirectory" (c_rename s1 s2)
346
347 {- |@'renameFile' old new@ changes the name of an existing file system
348 object from /old/ to /new/. If the /new/ object already
349 exists, it is atomically replaced by the /old/ object. Neither
350 path may refer to an existing directory. A conformant implementation
351 need not support renaming files in all situations (e.g. renaming
352 across different physical devices), but the constraints must be
353 documented.
354
355 The operation may fail with:
356
357 * 'HardwareFault'
358 A physical I\/O error has occurred.
359 @[EIO]@
360
361 * 'InvalidArgument'
362 Either operand is not a valid file name.
363 @[ENAMETOOLONG, ELOOP]@
364
365 * 'isDoesNotExistError' \/ 'NoSuchThing'
366 The original file does not exist, or there is no path to the target.
367 @[ENOENT, ENOTDIR]@
368
369 * 'isPermissionError' \/ 'PermissionDenied'
370 The process has insufficient privileges to perform the operation.
371 @[EROFS, EACCES, EPERM]@
372
373 * 'ResourceExhausted'
374 Insufficient resources are available to perform the operation.
375 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
376
377 * 'UnsatisfiedConstraints'
378 Implementation-dependent constraints are not satisfied.
379 @[EBUSY]@
380
381 * 'UnsupportedOperation'
382 The implementation does not support renaming in this situation.
383 @[EXDEV]@
384
385 * 'InappropriateType'
386 Either path refers to an existing directory.
387 @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@
388
389 -}
390
391 renameFile :: FilePath -> FilePath -> IO ()
392 renameFile opath npath =
393 withFileOrSymlinkStatus opath $ \st -> do
394 is_dir <- isDirectory st
395 if is_dir
396 then ioException (IOError Nothing InappropriateType "renameFile"
397 "is a directory" (Just opath))
398 else do
399
400 withCString opath $ \s1 ->
401 withCString npath $ \s2 ->
402 throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
403
404 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
405 in /dir/.
406
407 The operation may fail with:
408
409 * 'HardwareFault'
410 A physical I\/O error has occurred.
411 @[EIO]@
412
413 * 'InvalidArgument'
414 The operand is not a valid directory name.
415 @[ENAMETOOLONG, ELOOP]@
416
417 * 'isDoesNotExistError' \/ 'NoSuchThing'
418 The directory does not exist.
419 @[ENOENT, ENOTDIR]@
420
421 * 'isPermissionError' \/ 'PermissionDenied'
422 The process has insufficient privileges to perform the operation.
423 @[EACCES]@
424
425 * 'ResourceExhausted'
426 Insufficient resources are available to perform the operation.
427 @[EMFILE, ENFILE]@
428
429 * 'InappropriateType'
430 The path refers to an existing non-directory object.
431 @[ENOTDIR]@
432
433 -}
434
435 getDirectoryContents :: FilePath -> IO [FilePath]
436 getDirectoryContents path = do
437 modifyIOError (`ioeSetFileName` path) $
438 alloca $ \ ptr_dEnt ->
439 bracket
440 (withCString path $ \s ->
441 throwErrnoIfNullRetry desc (c_opendir s))
442 (\p -> throwErrnoIfMinus1_ desc (c_closedir p))
443 (\p -> loop ptr_dEnt p)
444 where
445 desc = "getDirectoryContents"
446
447 loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
448 loop ptr_dEnt dir = do
449 resetErrno
450 r <- readdir dir ptr_dEnt
451 if (r == 0)
452 then do
453 dEnt <- peek ptr_dEnt
454 if (dEnt == nullPtr)
455 then return []
456 else do
457 entry <- (d_name dEnt >>= peekCString)
458 freeDirEnt dEnt
459 entries <- loop ptr_dEnt dir
460 return (entry:entries)
461 else do errno <- getErrno
462 if (errno == eINTR) then loop ptr_dEnt dir else do
463 let (Errno eo) = errno
464 if (eo == end_of_dir)
465 then return []
466 else throwErrno desc
467
468
469
470 {- |If the operating system has a notion of current directories,
471 'getCurrentDirectory' returns an absolute path to the
472 current directory of the calling process.
473
474 The operation may fail with:
475
476 * 'HardwareFault'
477 A physical I\/O error has occurred.
478 @[EIO]@
479
480 * 'isDoesNotExistError' \/ 'NoSuchThing'
481 There is no path referring to the current directory.
482 @[EPERM, ENOENT, ESTALE...]@
483
484 * 'isPermissionError' \/ 'PermissionDenied'
485 The process has insufficient privileges to perform the operation.
486 @[EACCES]@
487
488 * 'ResourceExhausted'
489 Insufficient resources are available to perform the operation.
490
491 * 'UnsupportedOperation'
492 The operating system has no notion of current directory.
493
494 -}
495
496 getCurrentDirectory :: IO FilePath
497 getCurrentDirectory = do
498 p <- mallocBytes path_max
499 go p path_max
500 where go p bytes = do
501 p' <- c_getcwd p (fromIntegral bytes)
502 if p' /= nullPtr
503 then do s <- peekCString p'
504 free p'
505 return s
506 else do errno <- getErrno
507 if errno == eRANGE
508 then do let bytes' = bytes * 2
509 p' <- reallocBytes p bytes'
510 go p' bytes'
511 else throwErrno "getCurrentDirectory"
512
513 {- |If the operating system has a notion of current directories,
514 @'setCurrentDirectory' dir@ changes the current
515 directory of the calling process to /dir/.
516
517 The operation may fail with:
518
519 * 'HardwareFault'
520 A physical I\/O error has occurred.
521 @[EIO]@
522
523 * 'InvalidArgument'
524 The operand is not a valid directory name.
525 @[ENAMETOOLONG, ELOOP]@
526
527 * 'isDoesNotExistError' \/ 'NoSuchThing'
528 The directory does not exist.
529 @[ENOENT, ENOTDIR]@
530
531 * 'isPermissionError' \/ 'PermissionDenied'
532 The process has insufficient privileges to perform the operation.
533 @[EACCES]@
534
535 * 'UnsupportedOperation'
536 The operating system has no notion of current directory, or the
537 current directory cannot be dynamically changed.
538
539 * 'InappropriateType'
540 The path refers to an existing non-directory object.
541 @[ENOTDIR]@
542
543 -}
544
545 setCurrentDirectory :: FilePath -> IO ()
546 setCurrentDirectory path = do
547 modifyIOError (`ioeSetFileName` path) $
548 withCString path $ \s ->
549 throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
550 -- ToDo: add path to error
551
552 {- |To clarify, 'doesDirectoryExist' returns 'True' if a file system object
553 exist, and it's a directory. 'doesFileExist' returns 'True' if the file
554 system object exist, but it's not a directory (i.e., for every other
555 file system object that is not a directory.)
556 -}
557
558 doesDirectoryExist :: FilePath -> IO Bool
559 doesDirectoryExist name =
560 catch
561 (withFileStatus name $ \st -> isDirectory st)
562 (\ _ -> return False)
563
564 doesFileExist :: FilePath -> IO Bool
565 doesFileExist name = do
566 catch
567 (withFileStatus name $ \st -> do b <- isDirectory st; return (not b))
568 (\ _ -> return False)
569
570 getModificationTime :: FilePath -> IO ClockTime
571 getModificationTime name =
572 withFileStatus name $ \ st ->
573 modificationTime st
574
575 withFileStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a
576 withFileStatus name f = do
577 modifyIOError (`ioeSetFileName` name) $
578 allocaBytes sizeof_stat $ \p ->
579 withCString (fileNameEndClean name) $ \s -> do
580 throwErrnoIfMinus1Retry_ "withFileStatus" (c_stat s p)
581 f p
582
583 withFileOrSymlinkStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a
584 withFileOrSymlinkStatus name f = do
585 modifyIOError (`ioeSetFileName` name) $
586 allocaBytes sizeof_stat $ \p ->
587 withCString name $ \s -> do
588 throwErrnoIfMinus1Retry_ "withFileOrSymlinkStatus" (lstat s p)
589 f p
590
591 modificationTime :: Ptr CStat -> IO ClockTime
592 modificationTime stat = do
593 mtime <- st_mtime stat
594 return (TOD (toInteger (mtime :: CTime)) 0)
595
596 isDirectory :: Ptr CStat -> IO Bool
597 isDirectory stat = do
598 mode <- st_mode stat
599 return (s_isdir mode)
600
601 fileNameEndClean :: String -> String
602 fileNameEndClean name =
603 if i >= 0 && (ec == '\\' || ec == '/') then
604 fileNameEndClean (take i name)
605 else
606 name
607 where
608 i = (length name) - 1
609 ec = name !! i
610
611 emptyCMode :: CMode
612 emptyCMode = 0
613
614 unionCMode :: CMode -> CMode -> CMode
615 unionCMode = (+)
616
617
618 foreign import ccall unsafe "__hscore_path_max"
619 path_max :: Int
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