System/Directory.hs

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