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