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