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
 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   withCString name $ \s -> do
 176 #ifdef mingw32_HOST_OS
 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   withCString 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_chmod_ 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 "chmod"
 257    c_chmod_ :: CString -> 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   withCString source $ \p_source -> do
 265   withCString dest $ \p_dest -> do
 266     throwErrnoIfMinus1_ "copyPermissions" $ c_stat p_source p_stat
 267     mode <- st_mode p_stat
 268     throwErrnoIfMinus1_ "copyPermissions" $ c_chmod 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   System.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   System.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   System.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    System.Win32.moveFileEx opath npath System.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    System.Win32.moveFileEx opath npath System.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 <- System.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 = do
 799 #ifndef mingw32_HOST_OS
 800   bracket
 801     (Posix.openDirStream path)
 802     Posix.closeDirStream
 803     loop
 804  where
 805   loop dirp = do
 806      e <- Posix.readDirStream dirp
 807      if null e then return [] else do
 808      es <- loop dirp
 809      return (e:es)
 810 #else
 811   -- ToDo: rewrite using System.Win32
 812   modifyIOError (`ioeSetFileName` path) $
 813    alloca $ \ ptr_dEnt ->
 814      bracket
 815         (withCString path $ \s ->
 816            throwErrnoIfNullRetry desc (c_opendir s))
 817         (\p -> throwErrnoIfMinus1_ desc (c_closedir p))
 818         (\p -> loop ptr_dEnt p)
 819   where
 820     desc = "getDirectoryContents"
 821
 822     loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
 823     loop ptr_dEnt dir = do
 824       resetErrno
 825       r <- readdir dir ptr_dEnt
 826       if (r == 0)
 827          then do
 828                  dEnt    <- peek ptr_dEnt
 829                  if (dEnt == nullPtr)
 830                    then return []
 831                    else do
 832                     entry   <- (d_name dEnt >>= peekCString)
 833                     freeDirEnt dEnt
 834                     entries <- loop ptr_dEnt dir
 835                     return (entry:entries)
 836          else do errno <- getErrno
 837                  if (errno == eINTR) then loop ptr_dEnt dir else do
 838                    let (Errno eo) = errno
 839                    if (eo == end_of_dir)
 840                       then return []
 841                       else throwErrno desc
 842 #endif /* mingw32 */
 843
 844 #endif /* !__HUGS__ */
 845
 846
 847 {- |If the operating system has a notion of current directories,
 848 'getCurrentDirectory' returns an absolute path to the
 849 current directory of the calling process.
 850
 851 The operation may fail with:
 852
 853 * 'HardwareFault'
 854 A physical I\/O error has occurred.
 855 @[EIO]@
 856
 857 * 'isDoesNotExistError' \/ 'NoSuchThing'
 858 There is no path referring to the current directory.
 859 @[EPERM, ENOENT, ESTALE...]@
 860
 861 * 'isPermissionError' \/ 'PermissionDenied'
 862 The process has insufficient privileges to perform the operation.
 863 @[EACCES]@
 864
 865 * 'ResourceExhausted'
 866 Insufficient resources are available to perform the operation.
 867
 868 * 'UnsupportedOperation'
 869 The operating system has no notion of current directory.
 870
 871 -}
 872 #ifdef __GLASGOW_HASKELL__
 873 getCurrentDirectory :: IO FilePath
 874 getCurrentDirectory = do
 875 #ifdef mingw32_HOST_OS
 876   System.Win32.getCurrentDirectory
 877 #else
 878   Posix.getWorkingDirectory
 879 #endif
 880
 881 {- |If the operating system has a notion of current directories,
 882 @'setCurrentDirectory' dir@ changes the current
 883 directory of the calling process to /dir/.
 884
 885 The operation may fail with:
 886
 887 * 'HardwareFault'
 888 A physical I\/O error has occurred.
 889 @[EIO]@
 890
 891 * 'InvalidArgument'
 892 The operand is not a valid directory name.
 893 @[ENAMETOOLONG, ELOOP]@
 894
 895 * 'isDoesNotExistError' \/ 'NoSuchThing'
 896 The directory does not exist.
 897 @[ENOENT, ENOTDIR]@
 898
 899 * 'isPermissionError' \/ 'PermissionDenied'
 900 The process has insufficient privileges to perform the operation.
 901 @[EACCES]@
 902
 903 * 'UnsupportedOperation'
 904 The operating system has no notion of current directory, or the
 905 current directory cannot be dynamically changed.
 906
 907 * 'InappropriateType'
 908 The path refers to an existing non-directory object.
 909 @[ENOTDIR]@
 910
 911 -}
 912
 913 setCurrentDirectory :: FilePath -> IO ()
 914 setCurrentDirectory path =
 915 #ifdef mingw32_HOST_OS
 916   System.Win32.setCurrentDirectory path
 917 #else
 918   Posix.changeWorkingDirectory path
 919 #endif
 920
 921 #endif /* __GLASGOW_HASKELL__ */
 922
 923 #ifndef __HUGS__
 924 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
 925 exists and is a directory, and 'False' otherwise.
 926 -}
 927
 928 doesDirectoryExist :: FilePath -> IO Bool
 929 doesDirectoryExist name =
 930 #ifdef mingw32_HOST_OS
 931    (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
 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 operation 'doesFileExist' returns 'True'
 939 if the argument file exists and is not a directory, and 'False' otherwise.
 940 -}
 941
 942 doesFileExist :: FilePath -> IO Bool
 943 doesFileExist name =
 944 #ifdef mingw32_HOST_OS
 945    (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
 946 #else
 947    (do stat <- Posix.getFileStatus name
 948        return (Posix.fileMode stat .&. Posix.directoryMode == 0))
 949 #endif
 950    `catch` ((\ _ -> return False) :: IOException -> IO Bool)
 951
 952 {- |The 'getModificationTime' operation returns the
 953 clock time at which the file or directory was last modified.
 954
 955 The operation may fail with:
 956
 957 * 'isPermissionError' if the user is not permitted to access
 958   the modification time; or
 959
 960 * 'isDoesNotExistError' if the file or directory does not exist.
 961
 962 -}
 963
 964 getModificationTime :: FilePath -> IO ClockTime
 965 getModificationTime name = do
 966 #ifdef mingw32_HOST_OS
 967  -- ToDo: use Win32 API
 968  withFileStatus "getModificationTime" name $ \ st -> do
 969  modificationTime st
 970 #else
 971   stat <- Posix.getFileStatus name
 972   let realToInteger = round . realToFrac :: Real a => a -> Integer
 973   return (TOD (realToInteger (Posix.modificationTime stat)) 0)
 974 #endif
 975
 976
 977 #endif /* !__HUGS__ */
 978
 979 #ifdef mingw32_HOST_OS
 980 withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 981 withFileStatus loc name f = do
 982   modifyIOError (`ioeSetFileName` name) $
 983     allocaBytes sizeof_stat $ \p ->
 984       withCString (fileNameEndClean name) $ \s -> do
 985         throwErrnoIfMinus1Retry_ loc (c_stat s p)
 986         f p
 987
 988 withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 989 withFileOrSymlinkStatus loc name f = do
 990   modifyIOError (`ioeSetFileName` name) $
 991     allocaBytes sizeof_stat $ \p ->
 992       withCString name $ \s -> do
 993         throwErrnoIfMinus1Retry_ loc (lstat s p)
 994         f p
 995
 996 modificationTime :: Ptr CStat -> IO ClockTime
 997 modificationTime stat = do
 998     mtime <- st_mtime stat
 999     let realToInteger = round . realToFrac :: Real a => a -> Integer
1000     return (TOD (realToInteger (mtime :: CTime)) 0)
1001
1002 isDirectory :: Ptr CStat -> IO Bool
1003 isDirectory stat = do
1004   mode <- st_mode stat
1005   return (s_isdir mode)
1006
1007 fileNameEndClean :: String -> String
1008 fileNameEndClean name = if isDrive name then addTrailingPathSeparator name
1009                                         else dropTrailingPathSeparator name
1010
1011 foreign import ccall unsafe "HsDirectory.h __hscore_R_OK" r_OK :: CInt
1012 foreign import ccall unsafe "HsDirectory.h __hscore_W_OK" w_OK :: CInt
1013 foreign import ccall unsafe "HsDirectory.h __hscore_X_OK" x_OK :: CInt
1014
1015 foreign import ccall unsafe "HsDirectory.h __hscore_S_IRUSR" s_IRUSR :: CMode
1016 foreign import ccall unsafe "HsDirectory.h __hscore_S_IWUSR" s_IWUSR :: CMode
1017 foreign import ccall unsafe "HsDirectory.h __hscore_S_IXUSR" s_IXUSR :: CMode
1018 foreign import ccall unsafe "__hscore_S_IFDIR" s_IFDIR :: CMode
1019 #endif
1020
1021
1022 #ifdef __GLASGOW_HASKELL__
1023 foreign import ccall unsafe "__hscore_long_path_size"
1024   long_path_size :: Int
1025 #else
1026 long_path_size :: Int
1027 long_path_size = 2048   --  // guess?
1028 #endif /* __GLASGOW_HASKELL__ */
1029
1030 {- | Returns the current user's home directory.
1031
1032 The directory returned is expected to be writable by the current user,
1033 but note that it isn't generally considered good practice to store
1034 application-specific data here; use 'getAppUserDataDirectory'
1035 instead.
1036
1037 On Unix, 'getHomeDirectory' returns the value of the @HOME@
1038 environment variable.  On Windows, the system is queried for a
1039 suitable path; a typical path might be
1040 @C:/Documents And Settings/user@.
1041
1042 The operation may fail with:
1043
1044 * 'UnsupportedOperation'
1045 The operating system has no notion of home directory.
1046
1047 * 'isDoesNotExistError'
1048 The home directory for the current user does not exist, or
1049 cannot be found.
1050 -}
1051 getHomeDirectory :: IO FilePath
1052 getHomeDirectory =
1053 #if defined(mingw32_HOST_OS)
1054   allocaBytes long_path_size $ \pPath -> do
1055      r0 <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
1056      if (r0 < 0)
1057        then do
1058           r1 <- c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
1059           when (r1 < 0) (raiseUnsupported "System.Directory.getHomeDirectory")
1060        else return ()
1061      peekCString pPath
1062 #else
1063   getEnv "HOME"
1064 #endif
1065
1066 {- | Returns the pathname of a directory in which application-specific
1067 data for the current user can be stored.  The result of
1068 'getAppUserDataDirectory' for a given application is specific to
1069 the current user.
1070
1071 The argument should be the name of the application, which will be used
1072 to construct the pathname (so avoid using unusual characters that
1073 might result in an invalid pathname).
1074
1075 Note: the directory may not actually exist, and may need to be created
1076 first.  It is expected that the parent directory exists and is
1077 writable.
1078
1079 On Unix, this function returns @$HOME\/.appName@.  On Windows, a
1080 typical path might be
1081
1082 > C:/Documents And Settings/user/Application Data/appName
1083
1084 The operation may fail with:
1085
1086 * 'UnsupportedOperation'
1087 The operating system has no notion of application-specific data directory.
1088
1089 * 'isDoesNotExistError'
1090 The home directory for the current user does not exist, or
1091 cannot be found.
1092 -}
1093 getAppUserDataDirectory :: String -> IO FilePath
1094 getAppUserDataDirectory appName = do
1095 #if defined(mingw32_HOST_OS)
1096   allocaBytes long_path_size $ \pPath -> do
1097      r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
1098      when (r<0) (raiseUnsupported "System.Directory.getAppUserDataDirectory")
1099      s <- peekCString pPath
1100      return (s++'\\':appName)
1101 #else
1102   path <- getEnv "HOME"
1103   return (path++'/':'.':appName)
1104 #endif
1105
1106 {- | Returns the current user's document directory.
1107
1108 The directory returned is expected to be writable by the current user,
1109 but note that it isn't generally considered good practice to store
1110 application-specific data here; use 'getAppUserDataDirectory'
1111 instead.
1112
1113 On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@
1114 environment variable.  On Windows, the system is queried for a
1115 suitable path; a typical path might be
1116 @C:\/Documents and Settings\/user\/My Documents@.
1117
1118 The operation may fail with:
1119
1120 * 'UnsupportedOperation'
1121 The operating system has no notion of document directory.
1122
1123 * 'isDoesNotExistError'
1124 The document directory for the current user does not exist, or
1125 cannot be found.
1126 -}
1127 getUserDocumentsDirectory :: IO FilePath
1128 getUserDocumentsDirectory = do
1129 #if defined(mingw32_HOST_OS)
1130   allocaBytes long_path_size $ \pPath -> do
1131      r <- c_SHGetFolderPath nullPtr csidl_PERSONAL nullPtr 0 pPath
1132      when (r<0) (raiseUnsupported "System.Directory.getUserDocumentsDirectory")
1133      peekCString pPath
1134 #else
1135   getEnv "HOME"
1136 #endif
1137
1138 {- | Returns the current directory for temporary files.
1139
1140 On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@
1141 environment variable or \"\/tmp\" if the variable isn\'t defined.
1142 On Windows, the function checks for the existence of environment variables in
1143 the following order and uses the first path found:
1144
1145 *
1146 TMP environment variable.
1147
1148 *
1149 TEMP environment variable.
1150
1151 *
1152 USERPROFILE environment variable.
1153
1154 *
1155 The Windows directory
1156
1157 The operation may fail with:
1158
1159 * 'UnsupportedOperation'
1160 The operating system has no notion of temporary directory.
1161
1162 The function doesn\'t verify whether the path exists.
1163 -}
1164 getTemporaryDirectory :: IO FilePath
1165 getTemporaryDirectory = do
1166 #if defined(mingw32_HOST_OS)
1167   System.Win32.getTemporaryDirectory
1168 #else
1169   getEnv "TMPDIR"
1170 #if !__NHC__
1171     `Prelude.catch` \e -> if isDoesNotExistError e then return "/tmp"
1172                           else throw e
1173 #else
1174     `Prelude.catch` (\ex -> return "/tmp")
1175 #endif
1176 #endif
1177
1178 #if defined(mingw32_HOST_OS)
1179 foreign import ccall unsafe "__hscore_getFolderPath"
1180             c_SHGetFolderPath :: Ptr ()
1181                               -> CInt
1182                               -> Ptr ()
1183                               -> CInt
1184                               -> CString
1185                               -> IO CInt
1186 foreign import ccall unsafe "__hscore_CSIDL_PROFILE"  csidl_PROFILE  :: CInt
1187 foreign import ccall unsafe "__hscore_CSIDL_APPDATA"  csidl_APPDATA  :: CInt
1188 foreign import ccall unsafe "__hscore_CSIDL_WINDOWS"  csidl_WINDOWS  :: CInt
1189 foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt
1190
1191 raiseUnsupported :: String -> IO ()
1192 raiseUnsupported loc =
1193    ioException (ioeSetErrorString (mkIOError UnsupportedOperation loc Nothing Nothing) "unsupported operation")
1194
1195 #endif
1196
1197 -- ToDo: This should be determined via autoconf (AC_EXEEXT)
1198 -- | Extension for executable files
1199 -- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
1200 exeExtension :: String
1201 #ifdef mingw32_HOST_OS
1202 exeExtension = "exe"
1203 #else
1204 exeExtension = ""
1205 #endif