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