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 getHomeDirectory :: IO FilePath
 617 getHomeDirectory =
 618 #ifdef mingw32_TARGET_OS
 619   allocaBytes long_path_size $ \pPath -> do
 620      r <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
 621      if (r < 0)
 622        then c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
 623        else return 0
 624      peekCString pPath
 625 #else
 626   getEnv "HOME"
 627 #endif
 628
 629 getAppUserDataDirectory :: String -> IO FilePath
 630 getAppUserDataDirectory appName = do
 631 #ifdef mingw32_TARGET_OS
 632   allocaBytes long_path_size $ \pPath -> do
 633      r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
 634      s <- peekCString pPath
 635      return (s++'\\':appName)
 636 #else
 637   path <- getEnv "HOME"
 638   return (path++'/':'.':appName)
 639 #endif
 640
 641 #ifdef mingw32_TARGET_OS
 642 foreign import stdcall unsafe "SHGetFolderPath"
 643             c_SHGetFolderPath :: Ptr ()
 644                               -> CInt
 645                               -> Ptr ()
 646                               -> CInt
 647                               -> CString
 648                               -> IO CInt
 649 foreign import ccall unsafe "__hscore_CSIDL_PROFILE" csidl_PROFILE :: Int
 650 foreign import ccall unsafe "__hscore_CSIDL_APPDATA" csidl_APPDATA :: Int
 651 foreign import ccall unsafe "__hscore_CSIDL_WINDOWS" csidl_WINDOWS :: Int
 652 #endif
 653
 654 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
 655 exists and is a directory, and 'False' otherwise.
 656 -}
 657
 658 doesDirectoryExist :: FilePath -> IO Bool
 659 doesDirectoryExist name =
 660  catch
 661    (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
 662    (\ _ -> return False)
 663
 664 {- |The operation 'doesFileExist' returns 'True'
 665 if the argument file exists and is not a directory, and 'False' otherwise.
 666 -}
 667
 668 doesFileExist :: FilePath -> IO Bool
 669 doesFileExist name = do
 670  catch
 671    (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
 672    (\ _ -> return False)
 673
 674 {- |The 'getModificationTime' operation returns the
 675 clock time at which the file or directory was last modified.
 676
 677 The operation may fail with:
 678
 679 * 'isPermissionError' if the user is not permitted to access
 680   the modification time; or
 681
 682 * 'isDoesNotExistError' if the file or directory does not exist.
 683
 684 -}
 685
 686 getModificationTime :: FilePath -> IO ClockTime
 687 getModificationTime name =
 688  withFileStatus "getModificationTime" name $ \ st ->
 689  modificationTime st
 690
 691 withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 692 withFileStatus loc name f = do
 693   modifyIOError (`ioeSetFileName` name) $
 694     allocaBytes sizeof_stat $ \p ->
 695       withCString (fileNameEndClean name) $ \s -> do
 696         throwErrnoIfMinus1Retry_ loc (c_stat s p)
 697         f p
 698
 699 withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 700 withFileOrSymlinkStatus loc name f = do
 701   modifyIOError (`ioeSetFileName` name) $
 702     allocaBytes sizeof_stat $ \p ->
 703       withCString name $ \s -> do
 704         throwErrnoIfMinus1Retry_ loc (lstat s p)
 705         f p
 706
 707 modificationTime :: Ptr CStat -> IO ClockTime
 708 modificationTime stat = do
 709     mtime <- st_mtime stat
 710     let realToInteger = round . realToFrac :: Real a => a -> Integer
 711     return (TOD (realToInteger (mtime :: CTime)) 0)
 712
 713 isDirectory :: Ptr CStat -> IO Bool
 714 isDirectory stat = do
 715   mode <- st_mode stat
 716   return (s_isdir mode)
 717
 718 fileNameEndClean :: String -> String
 719 fileNameEndClean name =
 720   if i > 0 && (ec == '\\' || ec == '/') then
 721      fileNameEndClean (take i name)
 722    else
 723      name
 724   where
 725       i  = (length name) - 1
 726       ec = name !! i
 727
 728 foreign import ccall unsafe "__hscore_long_path_size"
 729   long_path_size :: Int
 730
 731 foreign import ccall unsafe "__hscore_R_OK" r_OK :: CMode
 732 foreign import ccall unsafe "__hscore_W_OK" w_OK :: CMode
 733 foreign import ccall unsafe "__hscore_X_OK" x_OK :: CMode
 734
 735 foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
 736 foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
 737 foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode
 738
 739 #endif