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 ccall unsafe "realpath"
 691                    c_realpath :: CString
 692                               -> CString
 693                               -> IO CString
 694 #endif
 695
 696 -- | 'makeRelative' the current directory.
 697 makeRelativeToCurrentDirectory :: FilePath -> IO FilePath
 698 makeRelativeToCurrentDirectory x = do
 699     cur <- getCurrentDirectory
 700     return $ makeRelative cur x
 701
 702 -- | Given an executable file name, searches for such file in the
 703 -- directories listed in system PATH. The returned value is the path
 704 -- to the found executable or Nothing if an executable with the given
 705 -- name was not found. For example (findExecutable \"ghc\") gives you
 706 -- the path to GHC.
 707 --
 708 -- The path returned by 'findExecutable' corresponds to the
 709 -- program that would be executed by 'System.Process.createProcess'
 710 -- when passed the same string (as a RawCommand, not a ShellCommand).
 711 --
 712 -- On Windows, 'findExecutable' calls the Win32 function 'SearchPath',
 713 -- which may search other places before checking the directories in
 714 -- @PATH@.  Where it actually searches depends on registry settings,
 715 -- but notably includes the directory containing the current
 716 -- executable. See
 717 -- <http://msdn.microsoft.com/en-us/library/aa365527.aspx> for more
 718 -- details.
 719 --
 720 findExecutable :: String -> IO (Maybe FilePath)
 721 findExecutable binary =
 722 #if defined(mingw32_HOST_OS)
 723   Win32.searchPath Nothing binary ('.':exeExtension)
 724 #else
 725  do
 726   path <- getEnv "PATH"
 727   search (splitSearchPath path)
 728   where
 729     fileName = binary <.> exeExtension
 730
 731     search :: [FilePath] -> IO (Maybe FilePath)
 732     search [] = return Nothing
 733     search (d:ds) = do
 734         let path = d </> fileName
 735         b <- doesFileExist path
 736         if b then return (Just path)
 737              else search ds
 738 #endif
 739
 740
 741 #ifndef __HUGS__
 742 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
 743 in /dir/.
 744
 745 The operation may fail with:
 746
 747 * 'HardwareFault'
 748 A physical I\/O error has occurred.
 749 @[EIO]@
 750
 751 * 'InvalidArgument'
 752 The operand is not a valid directory name.
 753 @[ENAMETOOLONG, ELOOP]@
 754
 755 * 'isDoesNotExistError' \/ 'NoSuchThing'
 756 The directory does not exist.
 757 @[ENOENT, ENOTDIR]@
 758
 759 * 'isPermissionError' \/ 'PermissionDenied'
 760 The process has insufficient privileges to perform the operation.
 761 @[EACCES]@
 762
 763 * 'ResourceExhausted'
 764 Insufficient resources are available to perform the operation.
 765 @[EMFILE, ENFILE]@
 766
 767 * 'InappropriateType'
 768 The path refers to an existing non-directory object.
 769 @[ENOTDIR]@
 770
 771 -}
 772
 773 getDirectoryContents :: FilePath -> IO [FilePath]
 774 getDirectoryContents path =
 775   modifyIOError ((`ioeSetFileName` path) .
 776                  (`ioeSetLocation` "getDirectoryContents")) $ do
 777 #ifndef mingw32_HOST_OS
 778   bracket
 779     (Posix.openDirStream path)
 780     Posix.closeDirStream
 781     loop
 782  where
 783   loop dirp = do
 784      e <- Posix.readDirStream dirp
 785      if null e then return [] else do
 786      es <- loop dirp
 787      return (e:es)
 788 #else
 789   bracket
 790      (Win32.findFirstFile (path </> "*"))
 791      (\(h,_) -> Win32.findClose h)
 792      (\(h,fdat) -> loop h fdat [])
 793   where
 794         -- we needn't worry about empty directories: adirectory always
 795         -- has at least "." and ".." entries
 796     loop :: Win32.HANDLE -> Win32.FindData -> [FilePath] -> IO [FilePath]
 797     loop h fdat acc = do
 798        filename <- Win32.getFindDataFileName fdat
 799        more <- Win32.findNextFile h fdat
 800        if more
 801           then loop h fdat (filename:acc)
 802           else return (filename:acc)
 803                  -- no need to reverse, ordering is undefined
 804 #endif /* mingw32 */
 805
 806 #endif /* !__HUGS__ */
 807
 808
 809 {- |If the operating system has a notion of current directories,
 810 'getCurrentDirectory' returns an absolute path to the
 811 current directory of the calling process.
 812
 813 The operation may fail with:
 814
 815 * 'HardwareFault'
 816 A physical I\/O error has occurred.
 817 @[EIO]@
 818
 819 * 'isDoesNotExistError' \/ 'NoSuchThing'
 820 There is no path referring to the current directory.
 821 @[EPERM, ENOENT, ESTALE...]@
 822
 823 * 'isPermissionError' \/ 'PermissionDenied'
 824 The process has insufficient privileges to perform the operation.
 825 @[EACCES]@
 826
 827 * 'ResourceExhausted'
 828 Insufficient resources are available to perform the operation.
 829
 830 * 'UnsupportedOperation'
 831 The operating system has no notion of current directory.
 832
 833 -}
 834 #ifdef __GLASGOW_HASKELL__
 835 getCurrentDirectory :: IO FilePath
 836 getCurrentDirectory = do
 837 #ifdef mingw32_HOST_OS
 838   Win32.getCurrentDirectory
 839 #else
 840   Posix.getWorkingDirectory
 841 #endif
 842
 843 {- |If the operating system has a notion of current directories,
 844 @'setCurrentDirectory' dir@ changes the current
 845 directory of the calling process to /dir/.
 846
 847 The operation may fail with:
 848
 849 * 'HardwareFault'
 850 A physical I\/O error has occurred.
 851 @[EIO]@
 852
 853 * 'InvalidArgument'
 854 The operand is not a valid directory name.
 855 @[ENAMETOOLONG, ELOOP]@
 856
 857 * 'isDoesNotExistError' \/ 'NoSuchThing'
 858 The directory does not exist.
 859 @[ENOENT, ENOTDIR]@
 860
 861 * 'isPermissionError' \/ 'PermissionDenied'
 862 The process has insufficient privileges to perform the operation.
 863 @[EACCES]@
 864
 865 * 'UnsupportedOperation'
 866 The operating system has no notion of current directory, or the
 867 current directory cannot be dynamically changed.
 868
 869 * 'InappropriateType'
 870 The path refers to an existing non-directory object.
 871 @[ENOTDIR]@
 872
 873 -}
 874
 875 setCurrentDirectory :: FilePath -> IO ()
 876 setCurrentDirectory path =
 877 #ifdef mingw32_HOST_OS
 878   Win32.setCurrentDirectory path
 879 #else
 880   Posix.changeWorkingDirectory path
 881 #endif
 882
 883 #endif /* __GLASGOW_HASKELL__ */
 884
 885 #ifndef __HUGS__
 886 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
 887 exists and is a directory, and 'False' otherwise.
 888 -}
 889
 890 doesDirectoryExist :: FilePath -> IO Bool
 891 doesDirectoryExist name =
 892 #ifdef mingw32_HOST_OS
 893    (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
 894 #else
 895    (do stat <- Posix.getFileStatus name
 896        return (Posix.fileMode stat .&. Posix.directoryMode /= 0))
 897 #endif
 898    `catch` ((\ _ -> return False) :: IOException -> IO Bool)
 899
 900 {- |The operation 'doesFileExist' returns 'True'
 901 if the argument file exists and is not a directory, and 'False' otherwise.
 902 -}
 903
 904 doesFileExist :: FilePath -> IO Bool
 905 doesFileExist name =
 906 #ifdef mingw32_HOST_OS
 907    (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
 908 #else
 909    (do stat <- Posix.getFileStatus name
 910        return (Posix.fileMode stat .&. Posix.directoryMode == 0))
 911 #endif
 912    `catch` ((\ _ -> return False) :: IOException -> IO Bool)
 913
 914 {- |The 'getModificationTime' operation returns the
 915 clock time at which the file or directory was last modified.
 916
 917 The operation may fail with:
 918
 919 * 'isPermissionError' if the user is not permitted to access
 920   the modification time; or
 921
 922 * 'isDoesNotExistError' if the file or directory does not exist.
 923
 924 -}
 925
 926 getModificationTime :: FilePath -> IO ClockTime
 927 getModificationTime name = do
 928 #ifdef mingw32_HOST_OS
 929  -- ToDo: use Win32 API
 930  withFileStatus "getModificationTime" name $ \ st -> do
 931  modificationTime st
 932 #else
 933   stat <- Posix.getFileStatus name
 934   let realToInteger = round . realToFrac :: Real a => a -> Integer
 935   return (TOD (realToInteger (Posix.modificationTime stat)) 0)
 936 #endif
 937
 938
 939 #endif /* !__HUGS__ */
 940
 941 #ifdef mingw32_HOST_OS
 942 withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 943 withFileStatus loc name f = do
 944   modifyIOError (`ioeSetFileName` name) $
 945     allocaBytes sizeof_stat $ \p ->
 946       withFilePath (fileNameEndClean name) $ \s -> do
 947         throwErrnoIfMinus1Retry_ loc (c_stat s p)
 948         f p
 949
 950 withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 951 withFileOrSymlinkStatus loc name f = do
 952   modifyIOError (`ioeSetFileName` name) $
 953     allocaBytes sizeof_stat $ \p ->
 954       withFilePath name $ \s -> do
 955         throwErrnoIfMinus1Retry_ loc (lstat s p)
 956         f p
 957
 958 modificationTime :: Ptr CStat -> IO ClockTime
 959 modificationTime stat = do
 960     mtime <- st_mtime stat
 961     let realToInteger = round . realToFrac :: Real a => a -> Integer
 962     return (TOD (realToInteger (mtime :: CTime)) 0)
 963
 964 isDirectory :: Ptr CStat -> IO Bool
 965 isDirectory stat = do
 966   mode <- st_mode stat
 967   return (s_isdir mode)
 968
 969 fileNameEndClean :: String -> String
 970 fileNameEndClean name = if isDrive name then addTrailingPathSeparator name
 971                                         else dropTrailingPathSeparator name
 972
 973 foreign import ccall unsafe "HsDirectory.h __hscore_S_IRUSR" s_IRUSR :: CMode
 974 foreign import ccall unsafe "HsDirectory.h __hscore_S_IWUSR" s_IWUSR :: CMode
 975 foreign import ccall unsafe "HsDirectory.h __hscore_S_IXUSR" s_IXUSR :: CMode
 976 foreign import ccall unsafe "__hscore_S_IFDIR" s_IFDIR :: CMode
 977 #endif
 978
 979
 980 #ifdef __GLASGOW_HASKELL__
 981 foreign import ccall unsafe "__hscore_long_path_size"
 982   long_path_size :: Int
 983 #else
 984 long_path_size :: Int
 985 long_path_size = 2048   --  // guess?
 986 #endif /* __GLASGOW_HASKELL__ */
 987
 988 {- | Returns the current user's home directory.
 989
 990 The directory returned is expected to be writable by the current user,
 991 but note that it isn't generally considered good practice to store
 992 application-specific data here; use 'getAppUserDataDirectory'
 993 instead.
 994
 995 On Unix, 'getHomeDirectory' returns the value of the @HOME@
 996 environment variable.  On Windows, the system is queried for a
 997 suitable path; a typical path might be
 998 @C:/Documents And Settings/user@.
 999
1000 The operation may fail with:
1001
1002 * 'UnsupportedOperation'
1003 The operating system has no notion of home directory.
1004
1005 * 'isDoesNotExistError'
1006 The home directory for the current user does not exist, or
1007 cannot be found.
1008 -}
1009 getHomeDirectory :: IO FilePath
1010 getHomeDirectory =
1011   modifyIOError ((`ioeSetLocation` "getHomeDirectory")) $ do
1012 #if defined(mingw32_HOST_OS)
1013   r <- try $ Win32.sHGetFolderPath nullPtr Win32.cSIDL_PROFILE nullPtr 0
1014   case (r :: Either IOException String) of
1015     Right s -> return s
1016     Left  _ -> do
1017       r1 <- try $ Win32.sHGetFolderPath nullPtr Win32.cSIDL_WINDOWS nullPtr 0
1018       case r1 of
1019         Right s -> return s
1020         Left  e -> ioError (e :: IOException)
1021 #else
1022   getEnv "HOME"
1023 #endif
1024
1025 {- | Returns the pathname of a directory in which application-specific
1026 data for the current user can be stored.  The result of
1027 'getAppUserDataDirectory' for a given application is specific to
1028 the current user.
1029
1030 The argument should be the name of the application, which will be used
1031 to construct the pathname (so avoid using unusual characters that
1032 might result in an invalid pathname).
1033
1034 Note: the directory may not actually exist, and may need to be created
1035 first.  It is expected that the parent directory exists and is
1036 writable.
1037
1038 On Unix, this function returns @$HOME\/.appName@.  On Windows, a
1039 typical path might be
1040
1041 > C:/Documents And Settings/user/Application Data/appName
1042
1043 The operation may fail with:
1044
1045 * 'UnsupportedOperation'
1046 The operating system has no notion of application-specific data directory.
1047
1048 * 'isDoesNotExistError'
1049 The home directory for the current user does not exist, or
1050 cannot be found.
1051 -}
1052 getAppUserDataDirectory :: String -> IO FilePath
1053 getAppUserDataDirectory appName = do
1054   modifyIOError ((`ioeSetLocation` "getAppUserDataDirectory")) $ do
1055 #if defined(mingw32_HOST_OS)
1056   s <- Win32.sHGetFolderPath nullPtr Win32.cSIDL_APPDATA nullPtr 0
1057   return (s++'\\':appName)
1058 #else
1059   path <- getEnv "HOME"
1060   return (path++'/':'.':appName)
1061 #endif
1062
1063 {- | Returns the current user's document directory.
1064
1065 The directory returned is expected to be writable by the current user,
1066 but note that it isn't generally considered good practice to store
1067 application-specific data here; use 'getAppUserDataDirectory'
1068 instead.
1069
1070 On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@
1071 environment variable.  On Windows, the system is queried for a
1072 suitable path; a typical path might be
1073 @C:\/Documents and Settings\/user\/My Documents@.
1074
1075 The operation may fail with:
1076
1077 * 'UnsupportedOperation'
1078 The operating system has no notion of document directory.
1079
1080 * 'isDoesNotExistError'
1081 The document directory for the current user does not exist, or
1082 cannot be found.
1083 -}
1084 getUserDocumentsDirectory :: IO FilePath
1085 getUserDocumentsDirectory = do
1086   modifyIOError ((`ioeSetLocation` "getUserDocumentsDirectory")) $ do
1087 #if defined(mingw32_HOST_OS)
1088   Win32.sHGetFolderPath nullPtr Win32.cSIDL_PERSONAL nullPtr 0
1089 #else
1090   getEnv "HOME"
1091 #endif
1092
1093 {- | Returns the current directory for temporary files.
1094
1095 On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@
1096 environment variable or \"\/tmp\" if the variable isn\'t defined.
1097 On Windows, the function checks for the existence of environment variables in
1098 the following order and uses the first path found:
1099
1100 *
1101 TMP environment variable.
1102
1103 *
1104 TEMP environment variable.
1105
1106 *
1107 USERPROFILE environment variable.
1108
1109 *
1110 The Windows directory
1111
1112 The operation may fail with:
1113
1114 * 'UnsupportedOperation'
1115 The operating system has no notion of temporary directory.
1116
1117 The function doesn\'t verify whether the path exists.
1118 -}
1119 getTemporaryDirectory :: IO FilePath
1120 getTemporaryDirectory = do
1121 #if defined(mingw32_HOST_OS)
1122   Win32.getTemporaryDirectory
1123 #else
1124   getEnv "TMPDIR"
1125 #if !__NHC__
1126     `Prelude.catch` \e -> if isDoesNotExistError e then return "/tmp"
1127                           else throw e
1128 #else
1129     `Prelude.catch` (\ex -> return "/tmp")
1130 #endif
1131 #endif
1132
1133 -- ToDo: This should be determined via autoconf (AC_EXEEXT)
1134 -- | Extension for executable files
1135 -- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
1136 exeExtension :: String
1137 #ifdef mingw32_HOST_OS
1138 exeExtension = "exe"
1139 #else
1140 exeExtension = ""
1141 #endif