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 path0
 309   | create_parents = createDirs (parents path0)
 310   | otherwise      = createDirs (take 1 (parents path0))
 311   where
 312     parents = reverse . scanl1 (</>) . splitDirectories . normalise
 313
 314     createDirs []         = return ()
 315     createDirs (dir:[])   = createDir dir throw
 316     createDirs (dir:dirs) =
 317       createDir dir $ \_ -> do
 318         createDirs dirs
 319         createDir dir throw
 320
 321     createDir :: FilePath -> (IOException -> IO ()) -> IO ()
 322     createDir dir notExistHandler = do
 323       r <- try $ createDirectory dir
 324       case (r :: Either IOException ()) of
 325         Right ()                   -> return ()
 326         Left  e
 327           | isDoesNotExistError  e -> notExistHandler e
 328           -- createDirectory (and indeed POSIX mkdir) does not distinguish
 329           -- between a dir already existing and a file already existing. So we
 330           -- check for it here. Unfortunately there is a slight race condition
 331           -- here, but we think it is benign. It could report an exeption in
 332           -- the case that the dir did exist but another process deletes it
 333           -- before we can check that it did indeed exist.
 334           | isAlreadyExistsError e -> do exists <- doesDirectoryExist dir
 335                                          if exists then return ()
 336                                                    else throw e
 337           | otherwise              -> throw e
 338
 339 #if __GLASGOW_HASKELL__
 340 {- | @'removeDirectory' dir@ removes an existing directory /dir/.  The
 341 implementation may specify additional constraints which must be
 342 satisfied before a directory can be removed (e.g. the directory has to
 343 be empty, or may not be in use by other processes).  It is not legal
 344 for an implementation to partially remove a directory unless the
 345 entire directory is removed. A conformant implementation need not
 346 support directory removal in all situations (e.g. removal of the root
 347 directory).
 348
 349 The operation may fail with:
 350
 351 * 'HardwareFault'
 352 A physical I\/O error has occurred.
 353 EIO
 354
 355 * 'InvalidArgument'
 356 The operand is not a valid directory name.
 357 [ENAMETOOLONG, ELOOP]
 358
 359 * 'isDoesNotExistError' \/ 'NoSuchThing'
 360 The directory does not exist.
 361 @[ENOENT, ENOTDIR]@
 362
 363 * 'isPermissionError' \/ 'PermissionDenied'
 364 The process has insufficient privileges to perform the operation.
 365 @[EROFS, EACCES, EPERM]@
 366
 367 * 'UnsatisfiedConstraints'
 368 Implementation-dependent constraints are not satisfied.
 369 @[EBUSY, ENOTEMPTY, EEXIST]@
 370
 371 * 'UnsupportedOperation'
 372 The implementation does not support removal in this situation.
 373 @[EINVAL]@
 374
 375 * 'InappropriateType'
 376 The operand refers to an existing non-directory object.
 377 @[ENOTDIR]@
 378
 379 -}
 380
 381 removeDirectory :: FilePath -> IO ()
 382 removeDirectory path =
 383 #ifdef mingw32_HOST_OS
 384   System.Win32.removeDirectory path
 385 #else
 386   System.Posix.removeDirectory path
 387 #endif
 388
 389 #endif
 390
 391 -- | @'removeDirectoryRecursive' dir@  removes an existing directory /dir/
 392 -- together with its content and all subdirectories. Be careful,
 393 -- if the directory contains symlinks, the function will follow them.
 394 removeDirectoryRecursive :: FilePath -> IO ()
 395 removeDirectoryRecursive startLoc = do
 396   cont <- getDirectoryContents startLoc
 397   sequence_ [rm (startLoc </> x) | x <- cont, x /= "." && x /= ".."]
 398   removeDirectory startLoc
 399   where
 400     rm :: FilePath -> IO ()
 401     rm f = do temp <- try (removeFile f)
 402               case temp of
 403                 Left e  -> do isDir <- doesDirectoryExist f
 404                               -- If f is not a directory, re-throw the error
 405                               unless isDir $ throw (e :: SomeException)
 406                               removeDirectoryRecursive f
 407                 Right _ -> return ()
 408
 409 #if __GLASGOW_HASKELL__
 410 {- |'removeFile' /file/ removes the directory entry for an existing file
 411 /file/, where /file/ is not itself a directory. The
 412 implementation may specify additional constraints which must be
 413 satisfied before a file can be removed (e.g. the file may not be in
 414 use by other processes).
 415
 416 The operation may fail with:
 417
 418 * 'HardwareFault'
 419 A physical I\/O error has occurred.
 420 @[EIO]@
 421
 422 * 'InvalidArgument'
 423 The operand is not a valid file name.
 424 @[ENAMETOOLONG, ELOOP]@
 425
 426 * 'isDoesNotExistError' \/ 'NoSuchThing'
 427 The file does not exist.
 428 @[ENOENT, ENOTDIR]@
 429
 430 * 'isPermissionError' \/ 'PermissionDenied'
 431 The process has insufficient privileges to perform the operation.
 432 @[EROFS, EACCES, EPERM]@
 433
 434 * 'UnsatisfiedConstraints'
 435 Implementation-dependent constraints are not satisfied.
 436 @[EBUSY]@
 437
 438 * 'InappropriateType'
 439 The operand refers to an existing directory.
 440 @[EPERM, EINVAL]@
 441
 442 -}
 443
 444 removeFile :: FilePath -> IO ()
 445 removeFile path =
 446 #if mingw32_HOST_OS
 447   System.Win32.deleteFile path
 448 #else
 449   System.Posix.removeLink path
 450 #endif
 451
 452 {- |@'renameDirectory' old new@ changes the name of an existing
 453 directory from /old/ to /new/.  If the /new/ directory
 454 already exists, it is atomically replaced by the /old/ directory.
 455 If the /new/ directory is neither the /old/ directory nor an
 456 alias of the /old/ directory, it is removed as if by
 457 'removeDirectory'.  A conformant implementation need not support
 458 renaming directories in all situations (e.g. renaming to an existing
 459 directory, or across different physical devices), but the constraints
 460 must be documented.
 461
 462 On Win32 platforms, @renameDirectory@ fails if the /new/ directory already
 463 exists.
 464
 465 The operation may fail with:
 466
 467 * 'HardwareFault'
 468 A physical I\/O error has occurred.
 469 @[EIO]@
 470
 471 * 'InvalidArgument'
 472 Either operand is not a valid directory name.
 473 @[ENAMETOOLONG, ELOOP]@
 474
 475 * 'isDoesNotExistError' \/ 'NoSuchThing'
 476 The original directory does not exist, or there is no path to the target.
 477 @[ENOENT, ENOTDIR]@
 478
 479 * 'isPermissionError' \/ 'PermissionDenied'
 480 The process has insufficient privileges to perform the operation.
 481 @[EROFS, EACCES, EPERM]@
 482
 483 * 'ResourceExhausted'
 484 Insufficient resources are available to perform the operation.
 485 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 486
 487 * 'UnsatisfiedConstraints'
 488 Implementation-dependent constraints are not satisfied.
 489 @[EBUSY, ENOTEMPTY, EEXIST]@
 490
 491 * 'UnsupportedOperation'
 492 The implementation does not support renaming in this situation.
 493 @[EINVAL, EXDEV]@
 494
 495 * 'InappropriateType'
 496 Either path refers to an existing non-directory object.
 497 @[ENOTDIR, EISDIR]@
 498
 499 -}
 500
 501 renameDirectory :: FilePath -> FilePath -> IO ()
 502 renameDirectory opath npath =
 503    -- XXX this test isn't performed atomically with the following rename
 504    withFileStatus "renameDirectory" opath $ \st -> do
 505    is_dir <- isDirectory st
 506    if (not is_dir)
 507         then ioException (ioeSetErrorString
 508                           (mkIOError InappropriateType "renameDirectory" Nothing (Just opath))
 509                           "not a directory")
 510         else do
 511 #ifdef mingw32_HOST_OS
 512    System.Win32.moveFileEx opath npath System.Win32.mOVEFILE_REPLACE_EXISTING
 513 #else
 514    System.Posix.rename opath npath
 515 #endif
 516
 517 {- |@'renameFile' old new@ changes the name of an existing file system
 518 object from /old/ to /new/.  If the /new/ object already
 519 exists, it is atomically replaced by the /old/ object.  Neither
 520 path may refer to an existing directory.  A conformant implementation
 521 need not support renaming files in all situations (e.g. renaming
 522 across different physical devices), but the constraints must be
 523 documented.
 524
 525 The operation may fail with:
 526
 527 * 'HardwareFault'
 528 A physical I\/O error has occurred.
 529 @[EIO]@
 530
 531 * 'InvalidArgument'
 532 Either operand is not a valid file name.
 533 @[ENAMETOOLONG, ELOOP]@
 534
 535 * 'isDoesNotExistError' \/ 'NoSuchThing'
 536 The original file does not exist, or there is no path to the target.
 537 @[ENOENT, ENOTDIR]@
 538
 539 * 'isPermissionError' \/ 'PermissionDenied'
 540 The process has insufficient privileges to perform the operation.
 541 @[EROFS, EACCES, EPERM]@
 542
 543 * 'ResourceExhausted'
 544 Insufficient resources are available to perform the operation.
 545 @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@
 546
 547 * 'UnsatisfiedConstraints'
 548 Implementation-dependent constraints are not satisfied.
 549 @[EBUSY]@
 550
 551 * 'UnsupportedOperation'
 552 The implementation does not support renaming in this situation.
 553 @[EXDEV]@
 554
 555 * 'InappropriateType'
 556 Either path refers to an existing directory.
 557 @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@
 558
 559 -}
 560
 561 renameFile :: FilePath -> FilePath -> IO ()
 562 renameFile opath npath =
 563    -- XXX this test isn't performed atomically with the following rename
 564    withFileOrSymlinkStatus "renameFile" opath $ \st -> do
 565    is_dir <- isDirectory st
 566    if is_dir
 567         then ioException (ioeSetErrorString
 568                           (mkIOError InappropriateType "renameFile" Nothing (Just opath))
 569                           "is a directory")
 570         else do
 571 #ifdef mingw32_HOST_OS
 572    System.Win32.moveFileEx opath npath System.Win32.mOVEFILE_REPLACE_EXISTING
 573 #else
 574    System.Posix.rename opath npath
 575 #endif
 576
 577 #endif /* __GLASGOW_HASKELL__ */
 578
 579 {- |@'copyFile' old new@ copies the existing file from /old/ to /new/.
 580 If the /new/ file already exists, it is atomically replaced by the /old/ file.
 581 Neither path may refer to an existing directory.  The permissions of /old/ are
 582 copied to /new/, if possible.
 583 -}
 584
 585 copyFile :: FilePath -> FilePath -> IO ()
 586 #ifdef __NHC__
 587 copyFile fromFPath toFPath =
 588     do readFile fromFPath >>= writeFile toFPath
 589        Prelude.catch (copyPermissions fromFPath toFPath)
 590                      (\_ -> return ())
 591 #else
 592 copyFile fromFPath toFPath =
 593     copy `Prelude.catch` (\exc -> throw $ ioeSetLocation exc "copyFile")
 594     where copy = bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
 595                  bracketOnError openTmp cleanTmp $ \(tmpFPath, hTmp) ->
 596                  do allocaBytes bufferSize $ copyContents hFrom hTmp
 597                     hClose hTmp
 598                     ignoreIOExceptions $ copyPermissions fromFPath tmpFPath
 599                     renameFile tmpFPath toFPath
 600           openTmp = openBinaryTempFile (takeDirectory toFPath) ".copyFile.tmp"
 601           cleanTmp (tmpFPath, hTmp)
 602               = do ignoreIOExceptions $ hClose hTmp
 603                    ignoreIOExceptions $ removeFile tmpFPath
 604           bufferSize = 1024
 605
 606           copyContents hFrom hTo buffer = do
 607                   count <- hGetBuf hFrom buffer bufferSize
 608                   when (count > 0) $ do
 609                           hPutBuf hTo buffer count
 610                           copyContents hFrom hTo buffer
 611
 612           ignoreIOExceptions io = io `catch` ioExceptionIgnorer
 613           ioExceptionIgnorer :: IOException -> IO ()
 614           ioExceptionIgnorer _ = return ()
 615 #endif
 616
 617 -- | Given path referring to a file or directory, returns a
 618 -- canonicalized path, with the intent that two paths referring
 619 -- to the same file\/directory will map to the same canonicalized
 620 -- path. Note that it is impossible to guarantee that the
 621 -- implication (same file\/dir \<=\> same canonicalizedPath) holds
 622 -- in either direction: this function can make only a best-effort
 623 -- attempt.
 624 canonicalizePath :: FilePath -> IO FilePath
 625 canonicalizePath fpath =
 626   withCString fpath $ \pInPath ->
 627   allocaBytes long_path_size $ \pOutPath ->
 628 #if defined(mingw32_HOST_OS)
 629   alloca $ \ppFilePart ->
 630     do c_GetFullPathName pInPath (fromIntegral long_path_size) pOutPath ppFilePart
 631 #else
 632     do c_realpath pInPath pOutPath
 633 #endif
 634        path <- peekCString pOutPath
 635        return (normalise path)
 636         -- normalise does more stuff, like upper-casing the drive letter
 637
 638 #if defined(mingw32_HOST_OS)
 639 foreign import stdcall unsafe "GetFullPathNameA"
 640             c_GetFullPathName :: CString
 641                               -> CInt
 642                               -> CString
 643                               -> Ptr CString
 644                               -> IO CInt
 645 #else
 646 foreign import ccall unsafe "realpath"
 647                    c_realpath :: CString
 648                               -> CString
 649                               -> IO CString
 650 #endif
 651
 652 -- | 'makeRelative' the current directory.
 653 makeRelativeToCurrentDirectory :: FilePath -> IO FilePath
 654 makeRelativeToCurrentDirectory x = do
 655     cur <- getCurrentDirectory
 656     return $ makeRelative cur x
 657
 658 -- | Given an executable file name, searches for such file
 659 -- in the directories listed in system PATH. The returned value
 660 -- is the path to the found executable or Nothing if there isn't
 661 -- such executable. For example (findExecutable \"ghc\")
 662 -- gives you the path to GHC.
 663 findExecutable :: String -> IO (Maybe FilePath)
 664 findExecutable binary =
 665 #if defined(mingw32_HOST_OS)
 666   withCString binary $ \c_binary ->
 667   withCString ('.':exeExtension) $ \c_ext ->
 668   allocaBytes long_path_size $ \pOutPath ->
 669   alloca $ \ppFilePart -> do
 670     res <- c_SearchPath nullPtr c_binary c_ext (fromIntegral long_path_size) pOutPath ppFilePart
 671     if res > 0 && res < fromIntegral long_path_size
 672       then do fpath <- peekCString pOutPath
 673               return (Just fpath)
 674       else return Nothing
 675
 676 foreign import stdcall unsafe "SearchPathA"
 677             c_SearchPath :: CString
 678                          -> CString
 679                          -> CString
 680                          -> CInt
 681                          -> CString
 682                          -> Ptr CString
 683                          -> IO CInt
 684 #else
 685  do
 686   path <- getEnv "PATH"
 687   search (splitSearchPath path)
 688   where
 689     fileName = binary <.> exeExtension
 690
 691     search :: [FilePath] -> IO (Maybe FilePath)
 692     search [] = return Nothing
 693     search (d:ds) = do
 694         let path = d </> fileName
 695         b <- doesFileExist path
 696         if b then return (Just path)
 697              else search ds
 698 #endif
 699
 700
 701 #ifdef __GLASGOW_HASKELL__
 702 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
 703 in /dir/.
 704
 705 The operation may fail with:
 706
 707 * 'HardwareFault'
 708 A physical I\/O error has occurred.
 709 @[EIO]@
 710
 711 * 'InvalidArgument'
 712 The operand is not a valid directory name.
 713 @[ENAMETOOLONG, ELOOP]@
 714
 715 * 'isDoesNotExistError' \/ 'NoSuchThing'
 716 The directory does not exist.
 717 @[ENOENT, ENOTDIR]@
 718
 719 * 'isPermissionError' \/ 'PermissionDenied'
 720 The process has insufficient privileges to perform the operation.
 721 @[EACCES]@
 722
 723 * 'ResourceExhausted'
 724 Insufficient resources are available to perform the operation.
 725 @[EMFILE, ENFILE]@
 726
 727 * 'InappropriateType'
 728 The path refers to an existing non-directory object.
 729 @[ENOTDIR]@
 730
 731 -}
 732
 733 getDirectoryContents :: FilePath -> IO [FilePath]
 734 getDirectoryContents path = do
 735   modifyIOError (`ioeSetFileName` path) $
 736    alloca $ \ ptr_dEnt ->
 737      bracket
 738         (withCString path $ \s ->
 739            throwErrnoIfNullRetry desc (c_opendir s))
 740         (\p -> throwErrnoIfMinus1_ desc (c_closedir p))
 741         (\p -> loop ptr_dEnt p)
 742   where
 743     desc = "getDirectoryContents"
 744
 745     loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
 746     loop ptr_dEnt dir = do
 747       resetErrno
 748       r <- readdir dir ptr_dEnt
 749       if (r == 0)
 750          then do
 751                  dEnt    <- peek ptr_dEnt
 752                  if (dEnt == nullPtr)
 753                    then return []
 754                    else do
 755                     entry   <- (d_name dEnt >>= peekCString)
 756                     freeDirEnt dEnt
 757                     entries <- loop ptr_dEnt dir
 758                     return (entry:entries)
 759          else do errno <- getErrno
 760                  if (errno == eINTR) then loop ptr_dEnt dir else do
 761                  let (Errno eo) = errno
 762                  if (eo == end_of_dir)
 763                     then return []
 764                     else throwErrno desc
 765
 766
 767
 768 {- |If the operating system has a notion of current directories,
 769 'getCurrentDirectory' returns an absolute path to the
 770 current directory of the calling process.
 771
 772 The operation may fail with:
 773
 774 * 'HardwareFault'
 775 A physical I\/O error has occurred.
 776 @[EIO]@
 777
 778 * 'isDoesNotExistError' \/ 'NoSuchThing'
 779 There is no path referring to the current directory.
 780 @[EPERM, ENOENT, ESTALE...]@
 781
 782 * 'isPermissionError' \/ 'PermissionDenied'
 783 The process has insufficient privileges to perform the operation.
 784 @[EACCES]@
 785
 786 * 'ResourceExhausted'
 787 Insufficient resources are available to perform the operation.
 788
 789 * 'UnsupportedOperation'
 790 The operating system has no notion of current directory.
 791
 792 -}
 793
 794 getCurrentDirectory :: IO FilePath
 795 getCurrentDirectory = do
 796 #ifdef mingw32_HOST_OS
 797   -- XXX: should use something from Win32
 798   p <- mallocBytes long_path_size
 799   go p long_path_size
 800   where go p bytes = do
 801           p' <- c_getcwd p (fromIntegral bytes)
 802           if p' /= nullPtr
 803              then do s <- peekCString p'
 804                      free p'
 805                      return s
 806              else do errno <- getErrno
 807                      if errno == eRANGE
 808                         then do let bytes' = bytes * 2
 809                                 p'' <- reallocBytes p bytes'
 810                                 go p'' bytes'
 811                         else throwErrno "getCurrentDirectory"
 812 #else
 813   System.Posix.getWorkingDirectory
 814 #endif
 815
 816 #ifdef mingw32_HOST_OS
 817 foreign import ccall unsafe "getcwd"
 818    c_getcwd   :: Ptr CChar -> CSize -> IO (Ptr CChar)
 819 #endif
 820
 821 {- |If the operating system has a notion of current directories,
 822 @'setCurrentDirectory' dir@ changes the current
 823 directory of the calling process to /dir/.
 824
 825 The operation may fail with:
 826
 827 * 'HardwareFault'
 828 A physical I\/O error has occurred.
 829 @[EIO]@
 830
 831 * 'InvalidArgument'
 832 The operand is not a valid directory name.
 833 @[ENAMETOOLONG, ELOOP]@
 834
 835 * 'isDoesNotExistError' \/ 'NoSuchThing'
 836 The directory does not exist.
 837 @[ENOENT, ENOTDIR]@
 838
 839 * 'isPermissionError' \/ 'PermissionDenied'
 840 The process has insufficient privileges to perform the operation.
 841 @[EACCES]@
 842
 843 * 'UnsupportedOperation'
 844 The operating system has no notion of current directory, or the
 845 current directory cannot be dynamically changed.
 846
 847 * 'InappropriateType'
 848 The path refers to an existing non-directory object.
 849 @[ENOTDIR]@
 850
 851 -}
 852
 853 setCurrentDirectory :: FilePath -> IO ()
 854 setCurrentDirectory path =
 855 #ifdef mingw32_HOST_OS
 856   System.Win32.setCurrentDirectory path
 857 #else
 858   System.Posix.changeWorkingDirectory path
 859 #endif
 860
 861 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
 862 exists and is a directory, and 'False' otherwise.
 863 -}
 864
 865 doesDirectoryExist :: FilePath -> IO Bool
 866 doesDirectoryExist name =
 867    (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
 868    `catch` ((\ _ -> return False) :: IOException -> IO Bool)
 869
 870 {- |The operation 'doesFileExist' returns 'True'
 871 if the argument file exists and is not a directory, and 'False' otherwise.
 872 -}
 873
 874 doesFileExist :: FilePath -> IO Bool
 875 doesFileExist name =
 876    (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
 877    `catch` ((\ _ -> return False) :: IOException -> IO Bool)
 878
 879 {- |The 'getModificationTime' operation returns the
 880 clock time at which the file or directory was last modified.
 881
 882 The operation may fail with:
 883
 884 * 'isPermissionError' if the user is not permitted to access
 885   the modification time; or
 886
 887 * 'isDoesNotExistError' if the file or directory does not exist.
 888
 889 -}
 890
 891 getModificationTime :: FilePath -> IO ClockTime
 892 getModificationTime name =
 893  withFileStatus "getModificationTime" name $ \ st ->
 894  modificationTime st
 895
 896 withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 897 withFileStatus loc name f = do
 898   modifyIOError (`ioeSetFileName` name) $
 899     allocaBytes sizeof_stat $ \p ->
 900       withCString (fileNameEndClean name) $ \s -> do
 901         throwErrnoIfMinus1Retry_ loc (c_stat s p)
 902         f p
 903
 904 withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 905 withFileOrSymlinkStatus loc name f = do
 906   modifyIOError (`ioeSetFileName` name) $
 907     allocaBytes sizeof_stat $ \p ->
 908       withCString name $ \s -> do
 909         throwErrnoIfMinus1Retry_ loc (lstat s p)
 910         f p
 911
 912 modificationTime :: Ptr CStat -> IO ClockTime
 913 modificationTime stat = do
 914     mtime <- st_mtime stat
 915     let realToInteger = round . realToFrac :: Real a => a -> Integer
 916     return (TOD (realToInteger (mtime :: CTime)) 0)
 917
 918 isDirectory :: Ptr CStat -> IO Bool
 919 isDirectory stat = do
 920   mode <- st_mode stat
 921   return (s_isdir mode)
 922
 923 fileNameEndClean :: String -> String
 924 fileNameEndClean name = if isDrive name then addTrailingPathSeparator name
 925                                         else dropTrailingPathSeparator name
 926
 927 foreign import ccall unsafe "__hscore_R_OK" r_OK :: CInt
 928 foreign import ccall unsafe "__hscore_W_OK" w_OK :: CInt
 929 foreign import ccall unsafe "__hscore_X_OK" x_OK :: CInt
 930
 931 foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
 932 foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
 933 foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode
 934 #ifdef mingw32_HOST_OS
 935 foreign import ccall unsafe "__hscore_S_IFDIR" s_IFDIR :: CMode
 936 #endif
 937
 938 foreign import ccall unsafe "__hscore_long_path_size"
 939   long_path_size :: Int
 940
 941 #else
 942 long_path_size :: Int
 943 long_path_size = 2048   --  // guess?
 944
 945 #endif /* __GLASGOW_HASKELL__ */
 946
 947 {- | Returns the current user's home directory.
 948
 949 The directory returned is expected to be writable by the current user,
 950 but note that it isn't generally considered good practice to store
 951 application-specific data here; use 'getAppUserDataDirectory'
 952 instead.
 953
 954 On Unix, 'getHomeDirectory' returns the value of the @HOME@
 955 environment variable.  On Windows, the system is queried for a
 956 suitable path; a typical path might be
 957 @C:/Documents And Settings/user@.
 958
 959 The operation may fail with:
 960
 961 * 'UnsupportedOperation'
 962 The operating system has no notion of home directory.
 963
 964 * 'isDoesNotExistError'
 965 The home directory for the current user does not exist, or
 966 cannot be found.
 967 -}
 968 getHomeDirectory :: IO FilePath
 969 getHomeDirectory =
 970 #if defined(mingw32_HOST_OS)
 971   allocaBytes long_path_size $ \pPath -> do
 972      r0 <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
 973      if (r0 < 0)
 974        then do
 975           r1 <- c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
 976           when (r1 < 0) (raiseUnsupported "System.Directory.getHomeDirectory")
 977        else return ()
 978      peekCString pPath
 979 #else
 980   getEnv "HOME"
 981 #endif
 982
 983 {- | Returns the pathname of a directory in which application-specific
 984 data for the current user can be stored.  The result of
 985 'getAppUserDataDirectory' for a given application is specific to
 986 the current user.
 987
 988 The argument should be the name of the application, which will be used
 989 to construct the pathname (so avoid using unusual characters that
 990 might result in an invalid pathname).
 991
 992 Note: the directory may not actually exist, and may need to be created
 993 first.  It is expected that the parent directory exists and is
 994 writable.
 995
 996 On Unix, this function returns @$HOME\/.appName@.  On Windows, a
 997 typical path might be
 998
 999 > C:/Documents And Settings/user/Application Data/appName
1000
1001 The operation may fail with:
1002
1003 * 'UnsupportedOperation'
1004 The operating system has no notion of application-specific data directory.
1005
1006 * 'isDoesNotExistError'
1007 The home directory for the current user does not exist, or
1008 cannot be found.
1009 -}
1010 getAppUserDataDirectory :: String -> IO FilePath
1011 getAppUserDataDirectory appName = do
1012 #if defined(mingw32_HOST_OS)
1013   allocaBytes long_path_size $ \pPath -> do
1014      r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
1015      when (r<0) (raiseUnsupported "System.Directory.getAppUserDataDirectory")
1016      s <- peekCString pPath
1017      return (s++'\\':appName)
1018 #else
1019   path <- getEnv "HOME"
1020   return (path++'/':'.':appName)
1021 #endif
1022
1023 {- | Returns the current user's document directory.
1024
1025 The directory returned is expected to be writable by the current user,
1026 but note that it isn't generally considered good practice to store
1027 application-specific data here; use 'getAppUserDataDirectory'
1028 instead.
1029
1030 On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@
1031 environment variable.  On Windows, the system is queried for a
1032 suitable path; a typical path might be
1033 @C:\/Documents and Settings\/user\/My Documents@.
1034
1035 The operation may fail with:
1036
1037 * 'UnsupportedOperation'
1038 The operating system has no notion of document directory.
1039
1040 * 'isDoesNotExistError'
1041 The document directory for the current user does not exist, or
1042 cannot be found.
1043 -}
1044 getUserDocumentsDirectory :: IO FilePath
1045 getUserDocumentsDirectory = do
1046 #if defined(mingw32_HOST_OS)
1047   allocaBytes long_path_size $ \pPath -> do
1048      r <- c_SHGetFolderPath nullPtr csidl_PERSONAL nullPtr 0 pPath
1049      when (r<0) (raiseUnsupported "System.Directory.getUserDocumentsDirectory")
1050      peekCString pPath
1051 #else
1052   getEnv "HOME"
1053 #endif
1054
1055 {- | Returns the current directory for temporary files.
1056
1057 On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@
1058 environment variable or \"\/tmp\" if the variable isn\'t defined.
1059 On Windows, the function checks for the existence of environment variables in
1060 the following order and uses the first path found:
1061
1062 *
1063 TMP environment variable.
1064
1065 *
1066 TEMP environment variable.
1067
1068 *
1069 USERPROFILE environment variable.
1070
1071 *
1072 The Windows directory
1073
1074 The operation may fail with:
1075
1076 * 'UnsupportedOperation'
1077 The operating system has no notion of temporary directory.
1078
1079 The function doesn\'t verify whether the path exists.
1080 -}
1081 getTemporaryDirectory :: IO FilePath
1082 getTemporaryDirectory = do
1083 #if defined(mingw32_HOST_OS)
1084   allocaBytes long_path_size $ \pPath -> do
1085      _r <- c_GetTempPath (fromIntegral long_path_size) pPath
1086      peekCString pPath
1087 #else
1088   getEnv "TMPDIR"
1089 #if !__NHC__
1090     `Prelude.catch` \e -> if isDoesNotExistError e then return "/tmp"
1091                           else throw e
1092 #else
1093     `Prelude.catch` (\ex -> return "/tmp")
1094 #endif
1095 #endif
1096
1097 #if defined(mingw32_HOST_OS)
1098 foreign import ccall unsafe "__hscore_getFolderPath"
1099             c_SHGetFolderPath :: Ptr ()
1100                               -> CInt
1101                               -> Ptr ()
1102                               -> CInt
1103                               -> CString
1104                               -> IO CInt
1105 foreign import ccall unsafe "__hscore_CSIDL_PROFILE"  csidl_PROFILE  :: CInt
1106 foreign import ccall unsafe "__hscore_CSIDL_APPDATA"  csidl_APPDATA  :: CInt
1107 foreign import ccall unsafe "__hscore_CSIDL_WINDOWS"  csidl_WINDOWS  :: CInt
1108 foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt
1109
1110 foreign import stdcall unsafe "GetTempPathA" c_GetTempPath :: CInt -> CString -> IO CInt
1111
1112 raiseUnsupported :: String -> IO ()
1113 raiseUnsupported loc =
1114    ioException (ioeSetErrorString (mkIOError UnsupportedOperation loc Nothing Nothing) "unsupported operation")
1115
1116 #endif
1117
1118 -- ToDo: This should be determined via autoconf (AC_EXEEXT)
1119 -- | Extension for executable files
1120 -- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
1121 exeExtension :: String
1122 #ifdef mingw32_HOST_OS
1123 exeExtension = "exe"
1124 #else
1125 exeExtension = ""
1126 #endif
1127