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