[project @ 2004-06-13 21:03:46 by panne]
[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 , 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.Posix.Internals
67 import System.Time ( ClockTime(..) )
68 import System.IO
69 import System.IO.Error
70 import Foreign
71 import Foreign.C
72
73 #ifdef __GLASGOW_HASKELL__
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 allocaBytes sizeof_stat $ \ p_stat -> do
165 withCString name $ \p_name -> do
166 throwErrnoIfMinus1_ "setPermissions" $ do
167 c_stat p_name p_stat
168 mode <- st_mode p_stat
169 let mode1 = modifyBit r mode s_IRUSR
170 let mode2 = modifyBit w mode1 s_IWUSR
171 let mode3 = modifyBit (e || s) mode2 s_IXUSR
172 c_chmod p_name mode3
173
174 where
175 modifyBit :: Bool -> CMode -> CMode -> CMode
176 modifyBit False m b = m .&. (complement b)
177 modifyBit True m b = m .|. b
178
179 -----------------------------------------------------------------------------
180 -- Implementation
181
182 {- |@'createDirectory' dir@ creates a new directory @dir@ which is
183 initially empty, or as near to empty as the operating system
184 allows.
185
186 The operation may fail with:
187
188 * 'isPermissionError' \/ 'PermissionDenied'
189 The process has insufficient privileges to perform the operation.
190 @[EROFS, EACCES]@
191
192 * 'isAlreadyExistsError' \/ 'AlreadyExists'
193 The operand refers to a directory that already exists.
194 @ [EEXIST]@
195
196 * 'HardwareFault'
197 A physical I\/O error has occurred.
198 @[EIO]@
199
200 * 'InvalidArgument'
201 The operand is not a valid directory name.
202 @[ENAMETOOLONG, ELOOP]@
203
204 * 'NoSuchThing'
205 There is no path to the directory.
206 @[ENOENT, ENOTDIR]@
207
208 * 'ResourceExhausted'
209 Insufficient resources (virtual memory, process file descriptors,
210 physical disk space, etc.) are available to perform the operation.
211 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
212
213 * 'InappropriateType'
214 The path refers to an existing non-directory object.
215 @[EEXIST]@
216
217 -}
218
219 createDirectory :: FilePath -> IO ()
220 createDirectory path = do
221 withCString path $ \s -> do
222 throwErrnoIfMinus1Retry_ "createDirectory" $
223 mkdir s 0o777
224
225 {- | @'removeDirectory' dir@ removes an existing directory /dir/. The
226 implementation may specify additional constraints which must be
227 satisfied before a directory can be removed (e.g. the directory has to
228 be empty, or may not be in use by other processes). It is not legal
229 for an implementation to partially remove a directory unless the
230 entire directory is removed. A conformant implementation need not
231 support directory removal in all situations (e.g. removal of the root
232 directory).
233
234 The operation may fail with:
235
236 * 'HardwareFault'
237 A physical I\/O error has occurred.
238 EIO
239
240 * 'InvalidArgument'
241 The operand is not a valid directory name.
242 [ENAMETOOLONG, ELOOP]
243
244 * 'isDoesNotExistError' \/ 'NoSuchThing'
245 The directory does not exist.
246 @[ENOENT, ENOTDIR]@
247
248 * 'isPermissionError' \/ 'PermissionDenied'
249 The process has insufficient privileges to perform the operation.
250 @[EROFS, EACCES, EPERM]@
251
252 * 'UnsatisfiedConstraints'
253 Implementation-dependent constraints are not satisfied.
254 @[EBUSY, ENOTEMPTY, EEXIST]@
255
256 * 'UnsupportedOperation'
257 The implementation does not support removal in this situation.
258 @[EINVAL]@
259
260 * 'InappropriateType'
261 The operand refers to an existing non-directory object.
262 @[ENOTDIR]@
263
264 -}
265
266 removeDirectory :: FilePath -> IO ()
267 removeDirectory path = do
268 modifyIOError (`ioeSetFileName` path) $
269 withCString path $ \s ->
270 throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
271
272 {- |'removeFile' /file/ removes the directory entry for an existing file
273 /file/, where /file/ is not itself a directory. The
274 implementation may specify additional constraints which must be
275 satisfied before a file can be removed (e.g. the file may not be in
276 use by other processes).
277
278 The operation may fail with:
279
280 * 'HardwareFault'
281 A physical I\/O error has occurred.
282 @[EIO]@
283
284 * 'InvalidArgument'
285 The operand is not a valid file name.
286 @[ENAMETOOLONG, ELOOP]@
287
288 * 'isDoesNotExistError' \/ 'NoSuchThing'
289 The file does not exist.
290 @[ENOENT, ENOTDIR]@
291
292 * 'isPermissionError' \/ 'PermissionDenied'
293 The process has insufficient privileges to perform the operation.
294 @[EROFS, EACCES, EPERM]@
295
296 * 'UnsatisfiedConstraints'
297 Implementation-dependent constraints are not satisfied.
298 @[EBUSY]@
299
300 * 'InappropriateType'
301 The operand refers to an existing directory.
302 @[EPERM, EINVAL]@
303
304 -}
305
306 removeFile :: FilePath -> IO ()
307 removeFile path = do
308 modifyIOError (`ioeSetFileName` path) $
309 withCString path $ \s ->
310 throwErrnoIfMinus1Retry_ "removeFile" (c_unlink s)
311
312 {- |@'renameDirectory' old new@ changes the name of an existing
313 directory from /old/ to /new/. If the /new/ directory
314 already exists, it is atomically replaced by the /old/ directory.
315 If the /new/ directory is neither the /old/ directory nor an
316 alias of the /old/ directory, it is removed as if by
317 'removeDirectory'. A conformant implementation need not support
318 renaming directories in all situations (e.g. renaming to an existing
319 directory, or across different physical devices), but the constraints
320 must be documented.
321
322 On Win32 platforms, @renameDirectory@ fails if the /new/ directory already
323 exists.
324
325 The operation may fail with:
326
327 * 'HardwareFault'
328 A physical I\/O error has occurred.
329 @[EIO]@
330
331 * 'InvalidArgument'
332 Either operand is not a valid directory name.
333 @[ENAMETOOLONG, ELOOP]@
334
335 * 'isDoesNotExistError' \/ 'NoSuchThing'
336 The original directory does not exist, or there is no path to the target.
337 @[ENOENT, ENOTDIR]@
338
339 * 'isPermissionError' \/ 'PermissionDenied'
340 The process has insufficient privileges to perform the operation.
341 @[EROFS, EACCES, EPERM]@
342
343 * 'ResourceExhausted'
344 Insufficient resources are available to perform the operation.
345 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
346
347 * 'UnsatisfiedConstraints'
348 Implementation-dependent constraints are not satisfied.
349 @[EBUSY, ENOTEMPTY, EEXIST]@
350
351 * 'UnsupportedOperation'
352 The implementation does not support renaming in this situation.
353 @[EINVAL, EXDEV]@
354
355 * 'InappropriateType'
356 Either path refers to an existing non-directory object.
357 @[ENOTDIR, EISDIR]@
358
359 -}
360
361 renameDirectory :: FilePath -> FilePath -> IO ()
362 renameDirectory opath npath =
363 withFileStatus "renameDirectory" opath $ \st -> do
364 is_dir <- isDirectory st
365 if (not is_dir)
366 then ioException (IOError Nothing InappropriateType "renameDirectory"
367 ("not a directory") (Just opath))
368 else do
369
370 withCString opath $ \s1 ->
371 withCString npath $ \s2 ->
372 throwErrnoIfMinus1Retry_ "renameDirectory" (c_rename s1 s2)
373
374 {- |@'renameFile' old new@ changes the name of an existing file system
375 object from /old/ to /new/. If the /new/ object already
376 exists, it is atomically replaced by the /old/ object. Neither
377 path may refer to an existing directory. A conformant implementation
378 need not support renaming files in all situations (e.g. renaming
379 across different physical devices), but the constraints must be
380 documented.
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 file name.
390 @[ENAMETOOLONG, ELOOP]@
391
392 * 'isDoesNotExistError' \/ 'NoSuchThing'
393 The original file 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]@
407
408 * 'UnsupportedOperation'
409 The implementation does not support renaming in this situation.
410 @[EXDEV]@
411
412 * 'InappropriateType'
413 Either path refers to an existing directory.
414 @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@
415
416 -}
417
418 renameFile :: FilePath -> FilePath -> IO ()
419 renameFile opath npath =
420 withFileOrSymlinkStatus "renameFile" opath $ \st -> do
421 is_dir <- isDirectory st
422 if is_dir
423 then ioException (IOError Nothing InappropriateType "renameFile"
424 "is a directory" (Just opath))
425 else do
426
427 withCString opath $ \s1 ->
428 withCString npath $ \s2 ->
429 throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
430
431 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
432 in /dir/.
433
434 The operation may fail with:
435
436 * 'HardwareFault'
437 A physical I\/O error has occurred.
438 @[EIO]@
439
440 * 'InvalidArgument'
441 The operand is not a valid directory name.
442 @[ENAMETOOLONG, ELOOP]@
443
444 * 'isDoesNotExistError' \/ 'NoSuchThing'
445 The directory does not exist.
446 @[ENOENT, ENOTDIR]@
447
448 * 'isPermissionError' \/ 'PermissionDenied'
449 The process has insufficient privileges to perform the operation.
450 @[EACCES]@
451
452 * 'ResourceExhausted'
453 Insufficient resources are available to perform the operation.
454 @[EMFILE, ENFILE]@
455
456 * 'InappropriateType'
457 The path refers to an existing non-directory object.
458 @[ENOTDIR]@
459
460 -}
461
462 getDirectoryContents :: FilePath -> IO [FilePath]
463 getDirectoryContents path = do
464 modifyIOError (`ioeSetFileName` path) $
465 alloca $ \ ptr_dEnt ->
466 bracket
467 (withCString path $ \s ->
468 throwErrnoIfNullRetry desc (c_opendir s))
469 (\p -> throwErrnoIfMinus1_ desc (c_closedir p))
470 (\p -> loop ptr_dEnt p)
471 where
472 desc = "getDirectoryContents"
473
474 loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
475 loop ptr_dEnt dir = do
476 resetErrno
477 r <- readdir dir ptr_dEnt
478 if (r == 0)
479 then do
480 dEnt <- peek ptr_dEnt
481 if (dEnt == nullPtr)
482 then return []
483 else do
484 entry <- (d_name dEnt >>= peekCString)
485 freeDirEnt dEnt
486 entries <- loop ptr_dEnt dir
487 return (entry:entries)
488 else do errno <- getErrno
489 if (errno == eINTR) then loop ptr_dEnt dir else do
490 let (Errno eo) = errno
491 if (eo == end_of_dir)
492 then return []
493 else throwErrno desc
494
495
496
497 {- |If the operating system has a notion of current directories,
498 'getCurrentDirectory' returns an absolute path to the
499 current directory of the calling process.
500
501 The operation may fail with:
502
503 * 'HardwareFault'
504 A physical I\/O error has occurred.
505 @[EIO]@
506
507 * 'isDoesNotExistError' \/ 'NoSuchThing'
508 There is no path referring to the current directory.
509 @[EPERM, ENOENT, ESTALE...]@
510
511 * 'isPermissionError' \/ 'PermissionDenied'
512 The process has insufficient privileges to perform the operation.
513 @[EACCES]@
514
515 * 'ResourceExhausted'
516 Insufficient resources are available to perform the operation.
517
518 * 'UnsupportedOperation'
519 The operating system has no notion of current directory.
520
521 -}
522
523 getCurrentDirectory :: IO FilePath
524 getCurrentDirectory = do
525 p <- mallocBytes long_path_size
526 go p long_path_size
527 where go p bytes = do
528 p' <- c_getcwd p (fromIntegral bytes)
529 if p' /= nullPtr
530 then do s <- peekCString p'
531 free p'
532 return s
533 else do errno <- getErrno
534 if errno == eRANGE
535 then do let bytes' = bytes * 2
536 p' <- reallocBytes p bytes'
537 go p' bytes'
538 else throwErrno "getCurrentDirectory"
539
540 {- |If the operating system has a notion of current directories,
541 @'setCurrentDirectory' dir@ changes the current
542 directory of the calling process to /dir/.
543
544 The operation may fail with:
545
546 * 'HardwareFault'
547 A physical I\/O error has occurred.
548 @[EIO]@
549
550 * 'InvalidArgument'
551 The operand is not a valid directory name.
552 @[ENAMETOOLONG, ELOOP]@
553
554 * 'isDoesNotExistError' \/ 'NoSuchThing'
555 The directory does not exist.
556 @[ENOENT, ENOTDIR]@
557
558 * 'isPermissionError' \/ 'PermissionDenied'
559 The process has insufficient privileges to perform the operation.
560 @[EACCES]@
561
562 * 'UnsupportedOperation'
563 The operating system has no notion of current directory, or the
564 current directory cannot be dynamically changed.
565
566 * 'InappropriateType'
567 The path refers to an existing non-directory object.
568 @[ENOTDIR]@
569
570 -}
571
572 setCurrentDirectory :: FilePath -> IO ()
573 setCurrentDirectory path = do
574 modifyIOError (`ioeSetFileName` path) $
575 withCString path $ \s ->
576 throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
577 -- ToDo: add path to error
578
579 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
580 exists and is a directory, and 'False' otherwise.
581 -}
582
583 doesDirectoryExist :: FilePath -> IO Bool
584 doesDirectoryExist name =
585 catch
586 (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
587 (\ _ -> return False)
588
589 {- |The operation 'doesFileExist' returns 'True'
590 if the argument file exists and is not a directory, and 'False' otherwise.
591 -}
592
593 doesFileExist :: FilePath -> IO Bool
594 doesFileExist name = do
595 catch
596 (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
597 (\ _ -> return False)
598
599 {- |The 'getModificationTime' operation returns the
600 clock time at which the file or directory was last modified.
601
602 The operation may fail with:
603
604 * 'isPermissionError' if the user is not permitted to access
605 the modification time; or
606
607 * 'isDoesNotExistError' if the file or directory does not exist.
608
609 -}
610
611 getModificationTime :: FilePath -> IO ClockTime
612 getModificationTime name =
613 withFileStatus "getModificationTime" name $ \ st ->
614 modificationTime st
615
616 withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
617 withFileStatus loc name f = do
618 modifyIOError (`ioeSetFileName` name) $
619 allocaBytes sizeof_stat $ \p ->
620 withCString (fileNameEndClean name) $ \s -> do
621 throwErrnoIfMinus1Retry_ loc (c_stat s p)
622 f p
623
624 withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
625 withFileOrSymlinkStatus loc name f = do
626 modifyIOError (`ioeSetFileName` name) $
627 allocaBytes sizeof_stat $ \p ->
628 withCString name $ \s -> do
629 throwErrnoIfMinus1Retry_ loc (lstat s p)
630 f p
631
632 modificationTime :: Ptr CStat -> IO ClockTime
633 modificationTime stat = do
634 mtime <- st_mtime stat
635 let realToInteger = round . realToFrac :: Real a => a -> Integer
636 return (TOD (realToInteger (mtime :: CTime)) 0)
637
638 isDirectory :: Ptr CStat -> IO Bool
639 isDirectory stat = do
640 mode <- st_mode stat
641 return (s_isdir mode)
642
643 fileNameEndClean :: String -> String
644 fileNameEndClean name =
645 if i > 0 && (ec == '\\' || ec == '/') then
646 fileNameEndClean (take i name)
647 else
648 name
649 where
650 i = (length name) - 1
651 ec = name !! i
652
653 foreign import ccall unsafe "__hscore_long_path_size"
654 long_path_size :: Int
655
656 foreign import ccall unsafe "__hscore_R_OK" r_OK :: CMode
657 foreign import ccall unsafe "__hscore_W_OK" w_OK :: CMode
658 foreign import ccall unsafe "__hscore_X_OK" x_OK :: CMode
659
660 foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
661 foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
662 foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode
663
664 #endif