System/Directory.hs

   1 {-# OPTIONS_GHC -w #-}
   2 -- XXX We get some warnings on Windows
   3
   4 -----------------------------------------------------------------------------
   5 -- |
   6 -- Module      :  System.Directory
   7 -- Copyright   :  (c) The University of Glasgow 2001
   8 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   9 --
  10 -- Maintainer  :  libraries@haskell.org
  11 -- Stability   :  stable
  12 -- Portability :  portable
  13 --
  14 -- System-independent interface to directory manipulation.
  15 --
  16 -----------------------------------------------------------------------------
  17
  18 module System.Directory
  19    (
  20     -- $intro
  21
  22     -- * Actions on directories
  23       createDirectory           -- :: FilePath -> IO ()
  24     , createDirectoryIfMissing  -- :: Bool -> FilePath -> IO ()
  25     , removeDirectory           -- :: FilePath -> IO ()
  26     , removeDirectoryRecursive  -- :: FilePath -> IO ()
  27     , renameDirectory           -- :: FilePath -> FilePath -> IO ()
  28
  29     , getDirectoryContents      -- :: FilePath -> IO [FilePath]
  30     , getCurrentDirectory       -- :: IO FilePath
  31     , setCurrentDirectory       -- :: FilePath -> IO ()
  32
  33     -- * Pre-defined directories
  34     , getHomeDirectory
  35     , getAppUserDataDirectory
  36     , getUserDocumentsDirectory
  37     , getTemporaryDirectory
  38
  39     -- * Actions on files
  40     , removeFile                -- :: FilePath -> IO ()
  41     , renameFile                -- :: FilePath -> FilePath -> IO ()
  42     , copyFile                  -- :: FilePath -> FilePath -> IO ()
  43
  44     , canonicalizePath
  45     , makeRelativeToCurrentDirectory
  46     , findExecutable
  47
  48     -- * Existence tests
  49     , doesFileExist             -- :: FilePath -> IO Bool
  50     , doesDirectoryExist        -- :: FilePath -> IO Bool
  51
  52     -- * Permissions
  53
  54     -- $permissions
  55
  56     , Permissions(
  57         Permissions,
  58         readable,               -- :: Permissions -> Bool
  59         writable,               -- :: Permissions -> Bool
  60         executable,             -- :: Permissions -> Bool
  61         searchable              -- :: Permissions -> Bool
  62       )
  63
  64     , getPermissions            -- :: FilePath -> IO Permissions
  65     , setPermissions            -- :: FilePath -> Permissions -> IO ()
  66
  67     -- * Timestamps
  68
  69     , getModificationTime       -- :: FilePath -> IO ClockTime
  70    ) where
  71
  72 import Prelude hiding ( catch )
  73 import qualified Prelude
  74
  75 import Control.Monad (guard)
  76 import System.Environment      ( getEnv )
  77 import System.FilePath
  78 import System.IO
  79 import System.IO.Error hiding ( catch, try )
  80 import Control.Monad           ( when, unless )
  81 import Control.Exception.Base
  82
  83 #ifdef __NHC__
  84 import Directory hiding ( getDirectoryContents
  85                         , doesDirectoryExist, doesFileExist
  86                         , getModificationTime )
  87 import System (system)
  88 #endif /* __NHC__ */
  89
  90 #ifdef __HUGS__
  91 import Hugs.Directory
  92 #endif /* __HUGS__ */
  93
  94 import Foreign
  95 import Foreign.C
  96
  97 {-# CFILES cbits/directory.c #-}
  98
  99 import System.Time             ( ClockTime(..) )
 100
 101 #ifdef __GLASGOW_HASKELL__
 102
 103 #if __GLASGOW_HASKELL__ >= 611
 104 import GHC.IO.Exception ( IOException(..), IOErrorType(..), ioException )
 105 #else
 106 import GHC.IOBase       ( IOException(..), IOErrorType(..), ioException )
 107 #endif
 108
 109 #ifdef mingw32_HOST_OS
 110 import System.Posix.Types
 111 import System.Posix.Internals
 112 import qualified System.Win32 as Win32
 113 #else
 114 import qualified System.Posix as Posix
 115 #endif
 116
 117 {- $intro
 118 A directory contains a series of entries, each of which is a named
 119 reference to a file system object (file, directory etc.).  Some
 120 entries may be hidden, inaccessible, or have some administrative
 121 function (e.g. `.' or `..' under POSIX
 122 <http://www.opengroup.org/onlinepubs/009695399/>), but in
 123 this standard all such entries are considered to form part of the
 124 directory contents. Entries in sub-directories are not, however,
 125 considered to form part of the directory contents.
 126
 127 Each file system object is referenced by a /path/.  There is
 128 normally at least one absolute path to each file system object.  In
 129 some operating systems, it may also be possible to have paths which
 130 are relative to the current directory.
 131 -}
 132
 133 -----------------------------------------------------------------------------
 134 -- Permissions
 135
 136 {- $permissions
 137
 138  The 'Permissions' type is used to record whether certain operations are
 139  permissible on a file\/directory. 'getPermissions' and 'setPermissions'
 140  get and set these permissions, respectively. Permissions apply both to
 141  files and directories. For directories, the executable field will be
 142  'False', and for files the searchable field will be 'False'. Note that
 143  directories may be searchable without being readable, if permission has
 144  been given to use them as part of a path, but not to examine the
 145  directory contents.
 146
 147 Note that to change some, but not all permissions, a construct on the following lines must be used.
 148
 149 >  makeReadable f = do
 150 >     p <- getPermissions f
 151 >     setPermissions f (p {readable = True})
 152
 153 -}
 154
 155 data Permissions
 156  = Permissions {
 157     readable,   writable,
 158     executable, searchable :: Bool
 159    } deriving (Eq, Ord, Read, Show)
 160
 161 {- |The 'getPermissions' operation returns the
 162 permissions for the file or directory.
 163
 164 The operation may fail with:
 165
 166 * 'isPermissionError' if the user is not permitted to access
 167   the permissions; or
 168
 169 * 'isDoesNotExistError' if the file or directory does not exist.
 170
 171 -}
 172
 173 getPermissions :: FilePath -> IO Permissions
 174 getPermissions name = do
 175 #ifdef mingw32_HOST_OS
 176   withFilePath name $ \s -> do
 177   -- stat() does a better job of guessing the permissions on Windows
 178   -- than access() does.  e.g. for execute permission, it looks at the
 179   -- filename extension :-)
 180   --
 181   -- I tried for a while to do this properly, using the Windows security API,
 182   -- and eventually gave up.  getPermissions is a flawed API anyway. -- SimonM
 183   allocaBytes sizeof_stat $ \ p_stat -> do
 184   throwErrnoIfMinus1_ "getPermissions" $ c_stat s p_stat
 185   mode <- st_mode p_stat
 186   let usr_read   = mode .&. s_IRUSR
 187   let usr_write  = mode .&. s_IWUSR
 188   let usr_exec   = mode .&. s_IXUSR
 189   let is_dir = mode .&. s_IFDIR
 190   return (
 191     Permissions {
 192       readable   = usr_read  /= 0,
 193       writable   = usr_write /= 0,
 194       executable = is_dir == 0 && usr_exec /= 0,
 195       searchable = is_dir /= 0 && usr_exec /= 0
 196     }
 197    )
 198 #else
 199   read_ok  <- Posix.fileAccess name True  False False
 200   write_ok <- Posix.fileAccess name False True  False
 201   exec_ok  <- Posix.fileAccess name False False True
 202   stat <- Posix.getFileStatus name
 203   let is_dir = Posix.fileMode stat .&. Posix.directoryMode /= 0
 204   return (
 205     Permissions {
 206       readable   = read_ok,
 207       writable   = write_ok,
 208       executable = not is_dir && exec_ok,
 209       searchable = is_dir && exec_ok
 210     }
 211    )
 212 #endif
 213
 214 {- |The 'setPermissions' operation sets the
 215 permissions for the file or directory.
 216
 217 The operation may fail with:
 218
 219 * 'isPermissionError' if the user is not permitted to set
 220   the permissions; or
 221
 222 * 'isDoesNotExistError' if the file or directory does not exist.
 223
 224 -}
 225
 226 setPermissions :: FilePath -> Permissions -> IO ()
 227 setPermissions name (Permissions r w e s) = do
 228 #ifdef mingw32_HOST_OS
 229   allocaBytes sizeof_stat $ \ p_stat -> do
 230   withFilePath name $ \p_name -> do
 231     throwErrnoIfMinus1_ "setPermissions" $ do
 232       c_stat p_name p_stat
 233       mode <- st_mode p_stat
 234       let mode1 = modifyBit r mode s_IRUSR
 235       let mode2 = modifyBit w mode1 s_IWUSR
 236       let mode3 = modifyBit (e || s) mode2 s_IXUSR
 237       c_wchmod p_name mode3
 238  where
 239    modifyBit :: Bool -> CMode -> CMode -> CMode
 240    modifyBit False m b = m .&. (complement b)
 241    modifyBit True  m b = m .|. b
 242 #else
 243       stat <- Posix.getFileStatus name
 244       let mode = Posix.fileMode stat
 245       let mode1 = modifyBit r mode  Posix.ownerReadMode
 246       let mode2 = modifyBit w mode1 Posix.ownerWriteMode
 247       let mode3 = modifyBit (e || s) mode2 Posix.ownerExecuteMode
 248       Posix.setFileMode name mode3
 249  where
 250    modifyBit :: Bool -> Posix.FileMode -> Posix.FileMode -> Posix.FileMode
 251    modifyBit False m b = m .&. (complement b)
 252    modifyBit True  m b = m .|. b
 253 #endif
 254
 255 #ifdef mingw32_HOST_OS
 256 foreign import ccall unsafe "_wchmod"
 257    c_wchmod :: CWString -> CMode -> IO CInt
 258 #endif
 259
 260 copyPermissions :: FilePath -> FilePath -> IO ()
 261 copyPermissions source dest = do
 262 #ifdef mingw32_HOST_OS
 263   allocaBytes sizeof_stat $ \ p_stat -> do
 264   withFilePath source $ \p_source -> do
 265   withFilePath dest $ \p_dest -> do
 266     throwErrnoIfMinus1_ "copyPermissions" $ c_stat p_source p_stat
 267     mode <- st_mode p_stat
 268     throwErrnoIfMinus1_ "copyPermissions" $ c_wchmod p_dest mode
 269 #else
 270   stat <- Posix.getFileStatus source
 271   let mode = Posix.fileMode stat
 272   Posix.setFileMode dest mode
 273 #endif
 274
 275 -----------------------------------------------------------------------------
 276 -- Implementation
 277
 278 {- |@'createDirectory' dir@ creates a new directory @dir@ which is
 279 initially empty, or as near to empty as the operating system
 280 allows.
 281
 282 The operation may fail with:
 283
 284 * 'isPermissionError' \/ 'PermissionDenied'
 285 The process has insufficient privileges to perform the operation.
 286 @[EROFS, EACCES]@
 287
 288 * 'isAlreadyExistsError' \/ 'AlreadyExists'
 289 The operand refers to a directory that already exists.
 290 @ [EEXIST]@
 291
 292 * 'HardwareFault'
 293 A physical I\/O error has occurred.
 294 @[EIO]@
 295
 296 * 'InvalidArgument'
 297 The operand is not a valid directory name.
 298 @[ENAMETOOLONG, ELOOP]@
 299
 300 * 'NoSuchThing'
 301 There is no path to the directory.
 302 @[ENOENT, ENOTDIR]@
 303
 304 * 'ResourceExhausted'
 305 Insufficient resources (virtual memory, process file descriptors,
 306 physical disk space, etc.) are available to perform the operation.
 307 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 308
 309 * 'InappropriateType'
 310 The path refers to an existing non-directory object.
 311 @[EEXIST]@
 312
 313 -}
 314
 315 createDirectory :: FilePath -> IO ()
 316 createDirectory path = do
 317 #ifdef mingw32_HOST_OS
 318   Win32.createDirectory path Nothing
 319 #else
 320   Posix.createDirectory path 0o777
 321 #endif
 322
 323 #else /* !__GLASGOW_HASKELL__ */
 324
 325 copyPermissions :: FilePath -> FilePath -> IO ()
 326 copyPermissions fromFPath toFPath
 327   = getPermissions fromFPath >>= setPermissions toFPath
 328
 329 #endif
 330
 331 -- | @'createDirectoryIfMissing' parents dir@ creates a new directory
 332 -- @dir@ if it doesn\'t exist. If the first argument is 'True'
 333 -- the function will also create all parent directories if they are missing.
 334 createDirectoryIfMissing :: Bool     -- ^ Create its parents too?
 335                          -> FilePath -- ^ The path to the directory you want to make
 336                          -> IO ()
 337 createDirectoryIfMissing create_parents path0
 338   | create_parents = createDirs (parents path0)
 339   | otherwise      = createDirs (take 1 (parents path0))
 340   where
 341     parents = reverse . scanl1 (</>) . splitDirectories . normalise
 342
 343     createDirs []         = return ()
 344     createDirs (dir:[])   = createDir dir throw
 345     createDirs (dir:dirs) =
 346       createDir dir $ \_ -> do
 347         createDirs dirs
 348         createDir dir throw
 349
 350     createDir :: FilePath -> (IOException -> IO ()) -> IO ()
 351     createDir dir notExistHandler = do
 352       r <- try $ createDirectory dir
 353       case (r :: Either IOException ()) of
 354         Right ()                   -> return ()
 355         Left  e
 356           | isDoesNotExistError  e -> notExistHandler e
 357           -- createDirectory (and indeed POSIX mkdir) does not distinguish
 358           -- between a dir already existing and a file already existing. So we
 359           -- check for it here. Unfortunately there is a slight race condition
 360           -- here, but we think it is benign. It could report an exeption in
 361           -- the case that the dir did exist but another process deletes the
 362           -- directory and creates a file in its place before we can check
 363           -- that the directory did indeed exist.
 364           | isAlreadyExistsError e -> (do
 365 #ifdef mingw32_HOST_OS
 366               withFileStatus "createDirectoryIfMissing" dir $ \st -> do
 367                  isDir <- isDirectory st
 368                  if isDir then return ()
 369                           else throw e
 370 #else
 371               stat <- Posix.getFileStatus dir
 372               if Posix.fileMode stat .&. Posix.directoryMode /= 0
 373                  then return ()
 374                  else throw e
 375 #endif
 376               ) `catch` ((\_ -> return ()) :: IOException -> IO ())
 377           | otherwise              -> throw e
 378
 379 #if __GLASGOW_HASKELL__
 380 {- | @'removeDirectory' dir@ removes an existing directory /dir/.  The
 381 implementation may specify additional constraints which must be
 382 satisfied before a directory can be removed (e.g. the directory has to
 383 be empty, or may not be in use by other processes).  It is not legal
 384 for an implementation to partially remove a directory unless the
 385 entire directory is removed. A conformant implementation need not
 386 support directory removal in all situations (e.g. removal of the root
 387 directory).
 388
 389 The operation may fail with:
 390
 391 * 'HardwareFault'
 392 A physical I\/O error has occurred.
 393 EIO
 394
 395 * 'InvalidArgument'
 396 The operand is not a valid directory name.
 397 [ENAMETOOLONG, ELOOP]
 398
 399 * 'isDoesNotExistError' \/ 'NoSuchThing'
 400 The directory does not exist.
 401 @[ENOENT, ENOTDIR]@
 402
 403 * 'isPermissionError' \/ 'PermissionDenied'
 404 The process has insufficient privileges to perform the operation.
 405 @[EROFS, EACCES, EPERM]@
 406
 407 * 'UnsatisfiedConstraints'
 408 Implementation-dependent constraints are not satisfied.
 409 @[EBUSY, ENOTEMPTY, EEXIST]@
 410
 411 * 'UnsupportedOperation'
 412 The implementation does not support removal in this situation.
 413 @[EINVAL]@
 414
 415 * 'InappropriateType'
 416 The operand refers to an existing non-directory object.
 417 @[ENOTDIR]@
 418
 419 -}
 420
 421 removeDirectory :: FilePath -> IO ()
 422 removeDirectory path =
 423 #ifdef mingw32_HOST_OS
 424   Win32.removeDirectory path
 425 #else
 426   Posix.removeDirectory path
 427 #endif
 428
 429 #endif
 430
 431 -- | @'removeDirectoryRecursive' dir@  removes an existing directory /dir/
 432 -- together with its content and all subdirectories. Be careful,
 433 -- if the directory contains symlinks, the function will follow them.
 434 removeDirectoryRecursive :: FilePath -> IO ()
 435 removeDirectoryRecursive startLoc = do
 436   cont <- getDirectoryContents startLoc
 437   sequence_ [rm (startLoc </> x) | x <- cont, x /= "." && x /= ".."]
 438   removeDirectory startLoc
 439   where
 440     rm :: FilePath -> IO ()
 441     rm f = do temp <- try (removeFile f)
 442               case temp of
 443                 Left e  -> do isDir <- doesDirectoryExist f
 444                               -- If f is not a directory, re-throw the error
 445                               unless isDir $ throw (e :: SomeException)
 446                               removeDirectoryRecursive f
 447                 Right _ -> return ()
 448
 449 #if __GLASGOW_HASKELL__
 450 {- |'removeFile' /file/ removes the directory entry for an existing file
 451 /file/, where /file/ is not itself a directory. The
 452 implementation may specify additional constraints which must be
 453 satisfied before a file can be removed (e.g. the file may not be in
 454 use by other processes).
 455
 456 The operation may fail with:
 457
 458 * 'HardwareFault'
 459 A physical I\/O error has occurred.
 460 @[EIO]@
 461
 462 * 'InvalidArgument'
 463 The operand is not a valid file name.
 464 @[ENAMETOOLONG, ELOOP]@
 465
 466 * 'isDoesNotExistError' \/ 'NoSuchThing'
 467 The file does not exist.
 468 @[ENOENT, ENOTDIR]@
 469
 470 * 'isPermissionError' \/ 'PermissionDenied'
 471 The process has insufficient privileges to perform the operation.
 472 @[EROFS, EACCES, EPERM]@
 473
 474 * 'UnsatisfiedConstraints'
 475 Implementation-dependent constraints are not satisfied.
 476 @[EBUSY]@
 477
 478 * 'InappropriateType'
 479 The operand refers to an existing directory.
 480 @[EPERM, EINVAL]@
 481
 482 -}
 483
 484 removeFile :: FilePath -> IO ()
 485 removeFile path =
 486 #if mingw32_HOST_OS
 487   Win32.deleteFile path
 488 #else
 489   Posix.removeLink path
 490 #endif
 491
 492 {- |@'renameDirectory' old new@ changes the name of an existing
 493 directory from /old/ to /new/.  If the /new/ directory
 494 already exists, it is atomically replaced by the /old/ directory.
 495 If the /new/ directory is neither the /old/ directory nor an
 496 alias of the /old/ directory, it is removed as if by
 497 'removeDirectory'.  A conformant implementation need not support
 498 renaming directories in all situations (e.g. renaming to an existing
 499 directory, or across different physical devices), but the constraints
 500 must be documented.
 501
 502 On Win32 platforms, @renameDirectory@ fails if the /new/ directory already
 503 exists.
 504
 505 The operation may fail with:
 506
 507 * 'HardwareFault'
 508 A physical I\/O error has occurred.
 509 @[EIO]@
 510
 511 * 'InvalidArgument'
 512 Either operand is not a valid directory name.
 513 @[ENAMETOOLONG, ELOOP]@
 514
 515 * 'isDoesNotExistError' \/ 'NoSuchThing'
 516 The original directory does not exist, or there is no path to the target.
 517 @[ENOENT, ENOTDIR]@
 518
 519 * 'isPermissionError' \/ 'PermissionDenied'
 520 The process has insufficient privileges to perform the operation.
 521 @[EROFS, EACCES, EPERM]@
 522
 523 * 'ResourceExhausted'
 524 Insufficient resources are available to perform the operation.
 525 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 526
 527 * 'UnsatisfiedConstraints'
 528 Implementation-dependent constraints are not satisfied.
 529 @[EBUSY, ENOTEMPTY, EEXIST]@
 530
 531 * 'UnsupportedOperation'
 532 The implementation does not support renaming in this situation.
 533 @[EINVAL, EXDEV]@
 534
 535 * 'InappropriateType'
 536 Either path refers to an existing non-directory object.
 537 @[ENOTDIR, EISDIR]@
 538
 539 -}
 540
 541 renameDirectory :: FilePath -> FilePath -> IO ()
 542 renameDirectory opath npath = do
 543    -- XXX this test isn't performed atomically with the following rename
 544 #ifdef mingw32_HOST_OS
 545    -- ToDo: use Win32 API
 546    withFileStatus "renameDirectory" opath $ \st -> do
 547    is_dir <- isDirectory st
 548 #else
 549    stat <- Posix.getFileStatus opath
 550    let is_dir = Posix.fileMode stat .&. Posix.directoryMode /= 0
 551 #endif
 552    if (not is_dir)
 553         then ioException (ioeSetErrorString
 554                           (mkIOError InappropriateType "renameDirectory" Nothing (Just opath))
 555                           "not a directory")
 556         else do
 557 #ifdef mingw32_HOST_OS
 558    Win32.moveFileEx opath npath Win32.mOVEFILE_REPLACE_EXISTING
 559 #else
 560    Posix.rename opath npath
 561 #endif
 562
 563 {- |@'renameFile' old new@ changes the name of an existing file system
 564 object from /old/ to /new/.  If the /new/ object already
 565 exists, it is atomically replaced by the /old/ object.  Neither
 566 path may refer to an existing directory.  A conformant implementation
 567 need not support renaming files in all situations (e.g. renaming
 568 across different physical devices), but the constraints must be
 569 documented.
 570
 571 The operation may fail with:
 572
 573 * 'HardwareFault'
 574 A physical I\/O error has occurred.
 575 @[EIO]@
 576
 577 * 'InvalidArgument'
 578 Either operand is not a valid file name.
 579 @[ENAMETOOLONG, ELOOP]@
 580
 581 * 'isDoesNotExistError' \/ 'NoSuchThing'
 582 The original file does not exist, or there is no path to the target.
 583 @[ENOENT, ENOTDIR]@
 584
 585 * 'isPermissionError' \/ 'PermissionDenied'
 586 The process has insufficient privileges to perform the operation.
 587 @[EROFS, EACCES, EPERM]@
 588
 589 * 'ResourceExhausted'
 590 Insufficient resources are available to perform the operation.
 591 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 592
 593 * 'UnsatisfiedConstraints'
 594 Implementation-dependent constraints are not satisfied.
 595 @[EBUSY]@
 596
 597 * 'UnsupportedOperation'
 598 The implementation does not support renaming in this situation.
 599 @[EXDEV]@
 600
 601 * 'InappropriateType'
 602 Either path refers to an existing directory.
 603 @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@
 604
 605 -}
 606
 607 renameFile :: FilePath -> FilePath -> IO ()
 608 renameFile opath npath = do
 609    -- XXX this test isn't performed atomically with the following rename
 610 #ifdef mingw32_HOST_OS
 611    -- ToDo: use Win32 API
 612    withFileOrSymlinkStatus "renameFile" opath $ \st -> do
 613    is_dir <- isDirectory st
 614 #else
 615    stat <- Posix.getSymbolicLinkStatus opath
 616    let is_dir = Posix.fileMode stat .&. Posix.directoryMode /= 0
 617 #endif
 618    if is_dir
 619         then ioException (ioeSetErrorString
 620                           (mkIOError InappropriateType "renameFile" Nothing (Just opath))
 621                           "is a directory")
 622         else do
 623 #ifdef mingw32_HOST_OS
 624    Win32.moveFileEx opath npath Win32.mOVEFILE_REPLACE_EXISTING
 625 #else
 626    Posix.rename opath npath
 627 #endif
 628
 629 #endif /* __GLASGOW_HASKELL__ */
 630
 631 {- |@'copyFile' old new@ copies the existing file from /old/ to /new/.
 632 If the /new/ file already exists, it is atomically replaced by the /old/ file.
 633 Neither path may refer to an existing directory.  The permissions of /old/ are
 634 copied to /new/, if possible.
 635 -}
 636
 637 copyFile :: FilePath -> FilePath -> IO ()
 638 #ifdef __NHC__
 639 copyFile fromFPath toFPath =
 640     do readFile fromFPath >>= writeFile toFPath
 641        Prelude.catch (copyPermissions fromFPath toFPath)
 642                      (\_ -> return ())
 643 #else
 644 copyFile fromFPath toFPath =
 645     copy `Prelude.catch` (\exc -> throw $ ioeSetLocation exc "copyFile")
 646     where copy = bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
 647                  bracketOnError openTmp cleanTmp $ \(tmpFPath, hTmp) ->
 648                  do allocaBytes bufferSize $ copyContents hFrom hTmp
 649                     hClose hTmp
 650                     ignoreIOExceptions $ copyPermissions fromFPath tmpFPath
 651                     renameFile tmpFPath toFPath
 652           openTmp = openBinaryTempFile (takeDirectory toFPath) ".copyFile.tmp"
 653           cleanTmp (tmpFPath, hTmp)
 654               = do ignoreIOExceptions $ hClose hTmp
 655                    ignoreIOExceptions $ removeFile tmpFPath
 656           bufferSize = 1024
 657
 658           copyContents hFrom hTo buffer = do
 659                   count <- hGetBuf hFrom buffer bufferSize
 660                   when (count > 0) $ do
 661                           hPutBuf hTo buffer count
 662                           copyContents hFrom hTo buffer
 663
 664           ignoreIOExceptions io = io `catch` ioExceptionIgnorer
 665           ioExceptionIgnorer :: IOException -> IO ()
 666           ioExceptionIgnorer _ = return ()
 667 #endif
 668
 669 -- | Given path referring to a file or directory, returns a
 670 -- canonicalized path, with the intent that two paths referring
 671 -- to the same file\/directory will map to the same canonicalized
 672 -- path. Note that it is impossible to guarantee that the
 673 -- implication (same file\/dir \<=\> same canonicalizedPath) holds
 674 -- in either direction: this function can make only a best-effort
 675 -- attempt.
 676 canonicalizePath :: FilePath -> IO FilePath
 677 canonicalizePath fpath =
 678 #if defined(mingw32_HOST_OS)
 679     do path <- Win32.getFullPathName fpath
 680 #else
 681   withCString fpath $ \pInPath ->
 682   allocaBytes long_path_size $ \pOutPath ->
 683     do c_realpath pInPath pOutPath
 684        path <- peekCString pOutPath
 685 #endif
 686        return (normalise path)
 687         -- normalise does more stuff, like upper-casing the drive letter
 688
 689 #if defined(mingw32_HOST_OS)
 690 foreign import stdcall unsafe "GetFullPathNameA"
 691             c_GetFullPathName :: CString
 692                               -> CInt
 693                               -> CString
 694                               -> Ptr CString
 695                               -> IO CInt
 696 #else
 697 foreign import ccall unsafe "realpath"
 698                    c_realpath :: CString
 699                               -> CString
 700                               -> IO CString
 701 #endif
 702
 703 -- | 'makeRelative' the current directory.
 704 makeRelativeToCurrentDirectory :: FilePath -> IO FilePath
 705 makeRelativeToCurrentDirectory x = do
 706     cur <- getCurrentDirectory
 707     return $ makeRelative cur x
 708
 709 -- | Given an executable file name, searches for such file in the
 710 -- directories listed in system PATH. The returned value is the path
 711 -- to the found executable or Nothing if an executable with the given
 712 -- name was not found. For example (findExecutable \"ghc\") gives you
 713 -- the path to GHC.
 714 --
 715 -- The path returned by 'findExecutable' corresponds to the
 716 -- program that would be executed by 'System.Process.createProcess'
 717 -- when passed the same string (as a RawCommand, not a ShellCommand).
 718 --
 719 -- On Windows, 'findExecutable' calls the Win32 function 'SearchPath',
 720 -- which may search other places before checking the directories in
 721 -- @PATH@.  Where it actually searches depends on registry settings,
 722 -- but notably includes the directory containing the current
 723 -- executable. See
 724 -- <http://msdn.microsoft.com/en-us/library/aa365527.aspx> for more
 725 -- details.
 726 --
 727 findExecutable :: String -> IO (Maybe FilePath)
 728 findExecutable binary =
 729 #if defined(mingw32_HOST_OS)
 730   withCString binary $ \c_binary ->
 731   withCString ('.':exeExtension) $ \c_ext ->
 732   allocaBytes long_path_size $ \pOutPath ->
 733   alloca $ \ppFilePart -> do
 734     res <- c_SearchPath nullPtr c_binary c_ext (fromIntegral long_path_size) pOutPath ppFilePart
 735     if res > 0 && res < fromIntegral long_path_size
 736       then do fpath <- peekCString pOutPath
 737               return (Just fpath)
 738       else return Nothing
 739
 740 foreign import stdcall unsafe "SearchPathA"
 741             c_SearchPath :: CString
 742                          -> CString
 743                          -> CString
 744                          -> CInt
 745                          -> CString
 746                          -> Ptr CString
 747                          -> IO CInt
 748 #else
 749  do
 750   path <- getEnv "PATH"
 751   search (splitSearchPath path)
 752   where
 753     fileName = binary <.> exeExtension
 754
 755     search :: [FilePath] -> IO (Maybe FilePath)
 756     search [] = return Nothing
 757     search (d:ds) = do
 758         let path = d </> fileName
 759         b <- doesFileExist path
 760         if b then return (Just path)
 761              else search ds
 762 #endif
 763
 764
 765 #ifndef __HUGS__
 766 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
 767 in /dir/.
 768
 769 The operation may fail with:
 770
 771 * 'HardwareFault'
 772 A physical I\/O error has occurred.
 773 @[EIO]@
 774
 775 * 'InvalidArgument'
 776 The operand is not a valid directory name.
 777 @[ENAMETOOLONG, ELOOP]@
 778
 779 * 'isDoesNotExistError' \/ 'NoSuchThing'
 780 The directory does not exist.
 781 @[ENOENT, ENOTDIR]@
 782
 783 * 'isPermissionError' \/ 'PermissionDenied'
 784 The process has insufficient privileges to perform the operation.
 785 @[EACCES]@
 786
 787 * 'ResourceExhausted'
 788 Insufficient resources are available to perform the operation.
 789 @[EMFILE, ENFILE]@
 790
 791 * 'InappropriateType'
 792 The path refers to an existing non-directory object.
 793 @[ENOTDIR]@
 794
 795 -}
 796
 797 getDirectoryContents :: FilePath -> IO [FilePath]
 798 getDirectoryContents path =
 799   modifyIOError ((`ioeSetFileName` path) .
 800                  (`ioeSetLocation` "getDirectoryContents")) $ do
 801 #ifndef mingw32_HOST_OS
 802   bracket
 803     (Posix.openDirStream path)
 804     Posix.closeDirStream
 805     loop
 806  where
 807   loop dirp = do
 808      e <- Posix.readDirStream dirp
 809      if null e then return [] else do
 810      es <- loop dirp
 811      return (e:es)
 812 #else
 813   bracket
 814      (Win32.findFirstFile (path </> "*"))
 815      (\(h,_) -> Win32.findClose h)
 816      (\(h,fdat) -> loop h fdat [])
 817   where
 818         -- we needn't worry about empty directories: adirectory always
 819         -- has at least "." and ".." entries
 820     loop :: Win32.HANDLE -> Win32.FindData -> [FilePath] -> IO [FilePath]
 821     loop h fdat acc = do
 822        filename <- Win32.getFindDataFileName fdat
 823        more <- Win32.findNextFile h fdat
 824        if more
 825           then loop h fdat (filename:acc)
 826           else return (filename:acc)
 827                  -- no need to reverse, ordering is undefined
 828 #endif /* mingw32 */
 829
 830 #endif /* !__HUGS__ */
 831
 832
 833 {- |If the operating system has a notion of current directories,
 834 'getCurrentDirectory' returns an absolute path to the
 835 current directory of the calling process.
 836
 837 The operation may fail with:
 838
 839 * 'HardwareFault'
 840 A physical I\/O error has occurred.
 841 @[EIO]@
 842
 843 * 'isDoesNotExistError' \/ 'NoSuchThing'
 844 There is no path referring to the current directory.
 845 @[EPERM, ENOENT, ESTALE...]@
 846
 847 * 'isPermissionError' \/ 'PermissionDenied'
 848 The process has insufficient privileges to perform the operation.
 849 @[EACCES]@
 850
 851 * 'ResourceExhausted'
 852 Insufficient resources are available to perform the operation.
 853
 854 * 'UnsupportedOperation'
 855 The operating system has no notion of current directory.
 856
 857 -}
 858 #ifdef __GLASGOW_HASKELL__
 859 getCurrentDirectory :: IO FilePath
 860 getCurrentDirectory = do
 861 #ifdef mingw32_HOST_OS
 862   Win32.getCurrentDirectory
 863 #else
 864   Posix.getWorkingDirectory
 865 #endif
 866
 867 {- |If the operating system has a notion of current directories,
 868 @'setCurrentDirectory' dir@ changes the current
 869 directory of the calling process to /dir/.
 870
 871 The operation may fail with:
 872
 873 * 'HardwareFault'
 874 A physical I\/O error has occurred.
 875 @[EIO]@
 876
 877 * 'InvalidArgument'
 878 The operand is not a valid directory name.
 879 @[ENAMETOOLONG, ELOOP]@
 880
 881 * 'isDoesNotExistError' \/ 'NoSuchThing'
 882 The directory does not exist.
 883 @[ENOENT, ENOTDIR]@
 884
 885 * 'isPermissionError' \/ 'PermissionDenied'
 886 The process has insufficient privileges to perform the operation.
 887 @[EACCES]@
 888
 889 * 'UnsupportedOperation'
 890 The operating system has no notion of current directory, or the
 891 current directory cannot be dynamically changed.
 892
 893 * 'InappropriateType'
 894 The path refers to an existing non-directory object.
 895 @[ENOTDIR]@
 896
 897 -}
 898
 899 setCurrentDirectory :: FilePath -> IO ()
 900 setCurrentDirectory path =
 901 #ifdef mingw32_HOST_OS
 902   Win32.setCurrentDirectory path
 903 #else
 904   Posix.changeWorkingDirectory path
 905 #endif
 906
 907 #endif /* __GLASGOW_HASKELL__ */
 908
 909 #ifndef __HUGS__
 910 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
 911 exists and is a directory, and 'False' otherwise.
 912 -}
 913
 914 doesDirectoryExist :: FilePath -> IO Bool
 915 doesDirectoryExist name =
 916 #ifdef mingw32_HOST_OS
 917    (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
 918 #else
 919    (do stat <- Posix.getFileStatus name
 920        return (Posix.fileMode stat .&. Posix.directoryMode /= 0))
 921 #endif
 922    `catch` ((\ _ -> return False) :: IOException -> IO Bool)
 923
 924 {- |The operation 'doesFileExist' returns 'True'
 925 if the argument file exists and is not a directory, and 'False' otherwise.
 926 -}
 927
 928 doesFileExist :: FilePath -> IO Bool
 929 doesFileExist name =
 930 #ifdef mingw32_HOST_OS
 931    (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
 932 #else
 933    (do stat <- Posix.getFileStatus name
 934        return (Posix.fileMode stat .&. Posix.directoryMode == 0))
 935 #endif
 936    `catch` ((\ _ -> return False) :: IOException -> IO Bool)
 937
 938 {- |The 'getModificationTime' operation returns the
 939 clock time at which the file or directory was last modified.
 940
 941 The operation may fail with:
 942
 943 * 'isPermissionError' if the user is not permitted to access
 944   the modification time; or
 945
 946 * 'isDoesNotExistError' if the file or directory does not exist.
 947
 948 -}
 949
 950 getModificationTime :: FilePath -> IO ClockTime
 951 getModificationTime name = do
 952 #ifdef mingw32_HOST_OS
 953  -- ToDo: use Win32 API
 954  withFileStatus "getModificationTime" name $ \ st -> do
 955  modificationTime st
 956 #else
 957   stat <- Posix.getFileStatus name
 958   let realToInteger = round . realToFrac :: Real a => a -> Integer
 959   return (TOD (realToInteger (Posix.modificationTime stat)) 0)
 960 #endif
 961
 962
 963 #endif /* !__HUGS__ */
 964
 965 #ifdef mingw32_HOST_OS
 966 withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 967 withFileStatus loc name f = do
 968   modifyIOError (`ioeSetFileName` name) $
 969     allocaBytes sizeof_stat $ \p ->
 970       withFilePath (fileNameEndClean name) $ \s -> do
 971         throwErrnoIfMinus1Retry_ loc (c_stat s p)
 972         f p
 973
 974 withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 975 withFileOrSymlinkStatus loc name f = do
 976   modifyIOError (`ioeSetFileName` name) $
 977     allocaBytes sizeof_stat $ \p ->
 978       withFilePath name $ \s -> do
 979         throwErrnoIfMinus1Retry_ loc (lstat s p)
 980         f p
 981
 982 modificationTime :: Ptr CStat -> IO ClockTime
 983 modificationTime stat = do
 984     mtime <- st_mtime stat
 985     let realToInteger = round . realToFrac :: Real a => a -> Integer
 986     return (TOD (realToInteger (mtime :: CTime)) 0)
 987
 988 isDirectory :: Ptr CStat -> IO Bool
 989 isDirectory stat = do
 990   mode <- st_mode stat
 991   return (s_isdir mode)
 992
 993 fileNameEndClean :: String -> String
 994 fileNameEndClean name = if isDrive name then addTrailingPathSeparator name
 995                                         else dropTrailingPathSeparator name
 996
 997 foreign import ccall unsafe "HsDirectory.h __hscore_R_OK" r_OK :: CInt
 998 foreign import ccall unsafe "HsDirectory.h __hscore_W_OK" w_OK :: CInt
 999 foreign import ccall unsafe "HsDirectory.h __hscore_X_OK" x_OK :: CInt
1000
1001 foreign import ccall unsafe "HsDirectory.h __hscore_S_IRUSR" s_IRUSR :: CMode
1002 foreign import ccall unsafe "HsDirectory.h __hscore_S_IWUSR" s_IWUSR :: CMode
1003 foreign import ccall unsafe "HsDirectory.h __hscore_S_IXUSR" s_IXUSR :: CMode
1004 foreign import ccall unsafe "__hscore_S_IFDIR" s_IFDIR :: CMode
1005 #endif
1006
1007
1008 #ifdef __GLASGOW_HASKELL__
1009 foreign import ccall unsafe "__hscore_long_path_size"
1010   long_path_size :: Int
1011 #else
1012 long_path_size :: Int
1013 long_path_size = 2048   --  // guess?
1014 #endif /* __GLASGOW_HASKELL__ */
1015
1016 {- | Returns the current user's home directory.
1017
1018 The directory returned is expected to be writable by the current user,
1019 but note that it isn't generally considered good practice to store
1020 application-specific data here; use 'getAppUserDataDirectory'
1021 instead.
1022
1023 On Unix, 'getHomeDirectory' returns the value of the @HOME@
1024 environment variable.  On Windows, the system is queried for a
1025 suitable path; a typical path might be
1026 @C:/Documents And Settings/user@.
1027
1028 The operation may fail with:
1029
1030 * 'UnsupportedOperation'
1031 The operating system has no notion of home directory.
1032
1033 * 'isDoesNotExistError'
1034 The home directory for the current user does not exist, or
1035 cannot be found.
1036 -}
1037 getHomeDirectory :: IO FilePath
1038 getHomeDirectory =
1039 #if defined(mingw32_HOST_OS)
1040   allocaBytes long_path_size $ \pPath -> do
1041      r0 <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
1042      if (r0 < 0)
1043        then do
1044           r1 <- c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
1045           when (r1 < 0) (raiseUnsupported "System.Directory.getHomeDirectory")
1046        else return ()
1047      peekCString pPath
1048 #else
1049   getEnv "HOME"
1050 #endif
1051
1052 {- | Returns the pathname of a directory in which application-specific
1053 data for the current user can be stored.  The result of
1054 'getAppUserDataDirectory' for a given application is specific to
1055 the current user.
1056
1057 The argument should be the name of the application, which will be used
1058 to construct the pathname (so avoid using unusual characters that
1059 might result in an invalid pathname).
1060
1061 Note: the directory may not actually exist, and may need to be created
1062 first.  It is expected that the parent directory exists and is
1063 writable.
1064
1065 On Unix, this function returns @$HOME\/.appName@.  On Windows, a
1066 typical path might be
1067
1068 > C:/Documents And Settings/user/Application Data/appName
1069
1070 The operation may fail with:
1071
1072 * 'UnsupportedOperation'
1073 The operating system has no notion of application-specific data directory.
1074
1075 * 'isDoesNotExistError'
1076 The home directory for the current user does not exist, or
1077 cannot be found.
1078 -}
1079 getAppUserDataDirectory :: String -> IO FilePath
1080 getAppUserDataDirectory appName = do
1081 #if defined(mingw32_HOST_OS)
1082   allocaBytes long_path_size $ \pPath -> do
1083      r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
1084      when (r<0) (raiseUnsupported "System.Directory.getAppUserDataDirectory")
1085      s <- peekCString pPath
1086      return (s++'\\':appName)
1087 #else
1088   path <- getEnv "HOME"
1089   return (path++'/':'.':appName)
1090 #endif
1091
1092 {- | Returns the current user's document directory.
1093
1094 The directory returned is expected to be writable by the current user,
1095 but note that it isn't generally considered good practice to store
1096 application-specific data here; use 'getAppUserDataDirectory'
1097 instead.
1098
1099 On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@
1100 environment variable.  On Windows, the system is queried for a
1101 suitable path; a typical path might be
1102 @C:\/Documents and Settings\/user\/My Documents@.
1103
1104 The operation may fail with:
1105
1106 * 'UnsupportedOperation'
1107 The operating system has no notion of document directory.
1108
1109 * 'isDoesNotExistError'
1110 The document directory for the current user does not exist, or
1111 cannot be found.
1112 -}
1113 getUserDocumentsDirectory :: IO FilePath
1114 getUserDocumentsDirectory = do
1115 #if defined(mingw32_HOST_OS)
1116   allocaBytes long_path_size $ \pPath -> do
1117      r <- c_SHGetFolderPath nullPtr csidl_PERSONAL nullPtr 0 pPath
1118      when (r<0) (raiseUnsupported "System.Directory.getUserDocumentsDirectory")
1119      peekCString pPath
1120 #else
1121   getEnv "HOME"
1122 #endif
1123
1124 {- | Returns the current directory for temporary files.
1125
1126 On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@
1127 environment variable or \"\/tmp\" if the variable isn\'t defined.
1128 On Windows, the function checks for the existence of environment variables in
1129 the following order and uses the first path found:
1130
1131 *
1132 TMP environment variable.
1133
1134 *
1135 TEMP environment variable.
1136
1137 *
1138 USERPROFILE environment variable.
1139
1140 *
1141 The Windows directory
1142
1143 The operation may fail with:
1144
1145 * 'UnsupportedOperation'
1146 The operating system has no notion of temporary directory.
1147
1148 The function doesn\'t verify whether the path exists.
1149 -}
1150 getTemporaryDirectory :: IO FilePath
1151 getTemporaryDirectory = do
1152 #if defined(mingw32_HOST_OS)
1153   Win32.getTemporaryDirectory
1154 #else
1155   getEnv "TMPDIR"
1156 #if !__NHC__
1157     `Prelude.catch` \e -> if isDoesNotExistError e then return "/tmp"
1158                           else throw e
1159 #else
1160     `Prelude.catch` (\ex -> return "/tmp")
1161 #endif
1162 #endif
1163
1164 #if defined(mingw32_HOST_OS)
1165 foreign import ccall unsafe "__hscore_getFolderPath"
1166             c_SHGetFolderPath :: Ptr ()
1167                               -> CInt
1168                               -> Ptr ()
1169                               -> CInt
1170                               -> CString
1171                               -> IO CInt
1172 foreign import ccall unsafe "__hscore_CSIDL_PROFILE"  csidl_PROFILE  :: CInt
1173 foreign import ccall unsafe "__hscore_CSIDL_APPDATA"  csidl_APPDATA  :: CInt
1174 foreign import ccall unsafe "__hscore_CSIDL_WINDOWS"  csidl_WINDOWS  :: CInt
1175 foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt
1176
1177 raiseUnsupported :: String -> IO ()
1178 raiseUnsupported loc =
1179    ioException (ioeSetErrorString (mkIOError UnsupportedOperation loc Nothing Nothing) "unsupported operation")
1180
1181 #endif
1182
1183 -- ToDo: This should be determined via autoconf (AC_EXEEXT)
1184 -- | Extension for executable files
1185 -- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
1186 exeExtension :: String
1187 #ifdef mingw32_HOST_OS
1188 exeExtension = "exe"
1189 #else
1190 exeExtension = ""
1191 #endif