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