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