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 -}
 866 #ifdef __GLASGOW_HASKELL__
 867 getCurrentDirectory :: IO FilePath
 868 getCurrentDirectory = do
 869 #ifdef mingw32_HOST_OS
 870   Win32.getCurrentDirectory
 871 #else
 872   Posix.getWorkingDirectory
 873 #endif
 874
 875 {- |If the operating system has a notion of current directories,
 876 @'setCurrentDirectory' dir@ changes the current
 877 directory of the calling process to /dir/.
 878
 879 The operation may fail with:
 880
 881 * 'HardwareFault'
 882 A physical I\/O error has occurred.
 883 @[EIO]@
 884
 885 * 'InvalidArgument'
 886 The operand is not a valid directory name.
 887 @[ENAMETOOLONG, ELOOP]@
 888
 889 * 'isDoesNotExistError' \/ 'NoSuchThing'
 890 The directory does not exist.
 891 @[ENOENT, ENOTDIR]@
 892
 893 * 'isPermissionError' \/ 'PermissionDenied'
 894 The process has insufficient privileges to perform the operation.
 895 @[EACCES]@
 896
 897 * 'UnsupportedOperation'
 898 The operating system has no notion of current directory, or the
 899 current directory cannot be dynamically changed.
 900
 901 * 'InappropriateType'
 902 The path refers to an existing non-directory object.
 903 @[ENOTDIR]@
 904
 905 -}
 906
 907 setCurrentDirectory :: FilePath -> IO ()
 908 setCurrentDirectory path =
 909 #ifdef mingw32_HOST_OS
 910   Win32.setCurrentDirectory path
 911 #else
 912   Posix.changeWorkingDirectory path
 913 #endif
 914
 915 #endif /* __GLASGOW_HASKELL__ */
 916
 917 #ifdef __GLASGOW_HASKELL__
 918 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
 919 exists and is a directory, and 'False' otherwise.
 920 -}
 921
 922 doesDirectoryExist :: FilePath -> IO Bool
 923 doesDirectoryExist name =
 924 #ifdef mingw32_HOST_OS
 925    (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
 926 #else
 927    (do stat <- Posix.getFileStatus name
 928        return (Posix.isDirectory stat))
 929 #endif
 930    `catch` ((\ _ -> return False) :: IOException -> IO Bool)
 931
 932 {- |The operation 'doesFileExist' returns 'True'
 933 if the argument file exists and is not a directory, and 'False' otherwise.
 934 -}
 935
 936 doesFileExist :: FilePath -> IO Bool
 937 doesFileExist name =
 938 #ifdef mingw32_HOST_OS
 939    (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
 940 #else
 941    (do stat <- Posix.getFileStatus name
 942        return (not (Posix.isDirectory stat)))
 943 #endif
 944    `catch` ((\ _ -> return False) :: IOException -> IO Bool)
 945
 946 {- |The 'getModificationTime' operation returns the
 947 clock time at which the file or directory was last modified.
 948
 949 The operation may fail with:
 950
 951 * 'isPermissionError' if the user is not permitted to access
 952   the modification time; or
 953
 954 * 'isDoesNotExistError' if the file or directory does not exist.
 955
 956 -}
 957
 958 getModificationTime :: FilePath -> IO ClockTime
 959 getModificationTime name = do
 960 #ifdef mingw32_HOST_OS
 961  -- ToDo: use Win32 API
 962  withFileStatus "getModificationTime" name $ \ st -> do
 963  modificationTime st
 964 #else
 965   stat <- Posix.getFileStatus name
 966   let mod_time :: Posix.EpochTime
 967       mod_time = Posix.modificationTime stat
 968       dbl_time :: Double
 969       dbl_time = realToFrac mod_time
 970   return (TOD (round dbl_time) 0)
 971 #endif
 972    -- For info
 973    -- round :: (RealFrac a, Integral b => a -> b
 974    -- realToFrac :: (Real a, Fractional b) => a -> b
 975
 976 #endif /* __GLASGOW_HASKELL__ */
 977
 978 #ifdef mingw32_HOST_OS
 979 withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 980 withFileStatus loc name f = do
 981   modifyIOError (`ioeSetFileName` name) $
 982     allocaBytes sizeof_stat $ \p ->
 983       withFilePath (fileNameEndClean name) $ \s -> do
 984         throwErrnoIfMinus1Retry_ loc (c_stat s p)
 985         f p
 986
 987 withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 988 withFileOrSymlinkStatus loc name f = do
 989   modifyIOError (`ioeSetFileName` name) $
 990     allocaBytes sizeof_stat $ \p ->
 991       withFilePath name $ \s -> do
 992         throwErrnoIfMinus1Retry_ loc (lstat s p)
 993         f p
 994
 995 modificationTime :: Ptr CStat -> IO ClockTime
 996 modificationTime stat = do
 997     mtime <- st_mtime stat
 998     let dbl_time :: Double
 999         dbl_time = realToFrac (mtime :: CTime)
1000     return (TOD (round dbl_time) 0)
1001
1002 isDirectory :: Ptr CStat -> IO Bool
1003 isDirectory stat = do
1004   mode <- st_mode stat
1005   return (s_isdir mode)
1006
1007 fileNameEndClean :: String -> String
1008 fileNameEndClean name = if isDrive name then addTrailingPathSeparator name
1009                                         else dropTrailingPathSeparator name
1010
1011 foreign import ccall unsafe "HsDirectory.h __hscore_S_IRUSR" s_IRUSR :: CMode
1012 foreign import ccall unsafe "HsDirectory.h __hscore_S_IWUSR" s_IWUSR :: CMode
1013 foreign import ccall unsafe "HsDirectory.h __hscore_S_IXUSR" s_IXUSR :: CMode
1014 foreign import ccall unsafe "__hscore_S_IFDIR" s_IFDIR :: CMode
1015 #endif
1016
1017
1018 #ifdef __GLASGOW_HASKELL__
1019 foreign import ccall unsafe "__hscore_long_path_size"
1020   long_path_size :: Int
1021 #else
1022 long_path_size :: Int
1023 long_path_size = 2048   --  // guess?
1024 #endif /* __GLASGOW_HASKELL__ */
1025
1026 {- | Returns the current user's home directory.
1027
1028 The directory returned is expected to be writable by the current user,
1029 but note that it isn't generally considered good practice to store
1030 application-specific data here; use 'getAppUserDataDirectory'
1031 instead.
1032
1033 On Unix, 'getHomeDirectory' returns the value of the @HOME@
1034 environment variable.  On Windows, the system is queried for a
1035 suitable path; a typical path might be
1036 @C:/Documents And Settings/user@.
1037
1038 The operation may fail with:
1039
1040 * 'UnsupportedOperation'
1041 The operating system has no notion of home directory.
1042
1043 * 'isDoesNotExistError'
1044 The home directory for the current user does not exist, or
1045 cannot be found.
1046 -}
1047 getHomeDirectory :: IO FilePath
1048 getHomeDirectory =
1049   modifyIOError ((`ioeSetLocation` "getHomeDirectory")) $ do
1050 #if defined(mingw32_HOST_OS)
1051     r <- try $ Win32.sHGetFolderPath nullPtr Win32.cSIDL_PROFILE nullPtr 0
1052     case (r :: Either IOException String) of
1053       Right s -> return s
1054       Left  _ -> do
1055         r1 <- try $ Win32.sHGetFolderPath nullPtr Win32.cSIDL_WINDOWS nullPtr 0
1056         case r1 of
1057           Right s -> return s
1058           Left  e -> ioError (e :: IOException)
1059 #else
1060     getEnv "HOME"
1061 #endif
1062
1063 {- | Returns the pathname of a directory in which application-specific
1064 data for the current user can be stored.  The result of
1065 'getAppUserDataDirectory' for a given application is specific to
1066 the current user.
1067
1068 The argument should be the name of the application, which will be used
1069 to construct the pathname (so avoid using unusual characters that
1070 might result in an invalid pathname).
1071
1072 Note: the directory may not actually exist, and may need to be created
1073 first.  It is expected that the parent directory exists and is
1074 writable.
1075
1076 On Unix, this function returns @$HOME\/.appName@.  On Windows, a
1077 typical path might be
1078
1079 > C:/Documents And Settings/user/Application Data/appName
1080
1081 The operation may fail with:
1082
1083 * 'UnsupportedOperation'
1084 The operating system has no notion of application-specific data directory.
1085
1086 * 'isDoesNotExistError'
1087 The home directory for the current user does not exist, or
1088 cannot be found.
1089 -}
1090 getAppUserDataDirectory :: String -> IO FilePath
1091 getAppUserDataDirectory appName = do
1092   modifyIOError ((`ioeSetLocation` "getAppUserDataDirectory")) $ do
1093 #if defined(mingw32_HOST_OS)
1094     s <- Win32.sHGetFolderPath nullPtr Win32.cSIDL_APPDATA nullPtr 0
1095     return (s++'\\':appName)
1096 #else
1097     path <- getEnv "HOME"
1098     return (path++'/':'.':appName)
1099 #endif
1100
1101 {- | Returns the current user's document directory.
1102
1103 The directory returned is expected to be writable by the current user,
1104 but note that it isn't generally considered good practice to store
1105 application-specific data here; use 'getAppUserDataDirectory'
1106 instead.
1107
1108 On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@
1109 environment variable.  On Windows, the system is queried for a
1110 suitable path; a typical path might be
1111 @C:\/Documents and Settings\/user\/My Documents@.
1112
1113 The operation may fail with:
1114
1115 * 'UnsupportedOperation'
1116 The operating system has no notion of document directory.
1117
1118 * 'isDoesNotExistError'
1119 The document directory for the current user does not exist, or
1120 cannot be found.
1121 -}
1122 getUserDocumentsDirectory :: IO FilePath
1123 getUserDocumentsDirectory = do
1124   modifyIOError ((`ioeSetLocation` "getUserDocumentsDirectory")) $ do
1125 #if defined(mingw32_HOST_OS)
1126     Win32.sHGetFolderPath nullPtr Win32.cSIDL_PERSONAL nullPtr 0
1127 #else
1128     getEnv "HOME"
1129 #endif
1130
1131 {- | Returns the current directory for temporary files.
1132
1133 On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@
1134 environment variable or \"\/tmp\" if the variable isn\'t defined.
1135 On Windows, the function checks for the existence of environment variables in
1136 the following order and uses the first path found:
1137
1138 *
1139 TMP environment variable.
1140
1141 *
1142 TEMP environment variable.
1143
1144 *
1145 USERPROFILE environment variable.
1146
1147 *
1148 The Windows directory
1149
1150 The operation may fail with:
1151
1152 * 'UnsupportedOperation'
1153 The operating system has no notion of temporary directory.
1154
1155 The function doesn\'t verify whether the path exists.
1156 -}
1157 getTemporaryDirectory :: IO FilePath
1158 getTemporaryDirectory = do
1159 #if defined(mingw32_HOST_OS)
1160   Win32.getTemporaryDirectory
1161 #else
1162   getEnv "TMPDIR"
1163 #if !__NHC__
1164     `Prelude.catch` \e -> if isDoesNotExistError e then return "/tmp"
1165                           else throw e
1166 #else
1167     `Prelude.catch` (\ex -> return "/tmp")
1168 #endif
1169 #endif
1170
1171 -- ToDo: This should be determined via autoconf (AC_EXEEXT)
1172 -- | Extension for executable files
1173 -- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
1174 exeExtension :: String
1175 #ifdef mingw32_HOST_OS
1176 exeExtension = "exe"
1177 #else
1178 exeExtension = ""
1179 #endif