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