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