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