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