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