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