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