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 in the
 664 -- directories listed in system PATH. The returned value is the path
 665 -- to the found executable or Nothing if an executable with the given
 666 -- name was not found. For example (findExecutable \"ghc\") gives you
 667 -- the path to GHC.
 668 --
 669 -- The path returned by 'findExecutable' corresponds to the
 670 -- program that would be executed by 'System.Process.createProcess'
 671 -- when passed the same string (as a RawCommand, not a ShellCommand).
 672 --
 673 -- On Windows, 'findExecutable' calls the Win32 function 'SearchPath',
 674 -- which may search other places before checking the directories in
 675 -- @PATH@.  Where it actually searches depends on registry settings,
 676 -- but notably includes the directory containing the current
 677 -- executable. See
 678 -- <http://msdn.microsoft.com/en-us/library/aa365527.aspx> for more
 679 -- details.
 680 --
 681 findExecutable :: String -> IO (Maybe FilePath)
 682 findExecutable binary =
 683 #if defined(mingw32_HOST_OS)
 684   withCString binary $ \c_binary ->
 685   withCString ('.':exeExtension) $ \c_ext ->
 686   allocaBytes long_path_size $ \pOutPath ->
 687   alloca $ \ppFilePart -> do
 688     res <- c_SearchPath nullPtr c_binary c_ext (fromIntegral long_path_size) pOutPath ppFilePart
 689     if res > 0 && res < fromIntegral long_path_size
 690       then do fpath <- peekCString pOutPath
 691               return (Just fpath)
 692       else return Nothing
 693
 694 foreign import stdcall unsafe "SearchPathA"
 695             c_SearchPath :: CString
 696                          -> CString
 697                          -> CString
 698                          -> CInt
 699                          -> CString
 700                          -> Ptr CString
 701                          -> IO CInt
 702 #else
 703  do
 704   path <- getEnv "PATH"
 705   search (splitSearchPath path)
 706   where
 707     fileName = binary <.> exeExtension
 708
 709     search :: [FilePath] -> IO (Maybe FilePath)
 710     search [] = return Nothing
 711     search (d:ds) = do
 712         let path = d </> fileName
 713         b <- doesFileExist path
 714         if b then return (Just path)
 715              else search ds
 716 #endif
 717
 718
 719 #ifndef __HUGS__
 720 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
 721 in /dir/.
 722
 723 The operation may fail with:
 724
 725 * 'HardwareFault'
 726 A physical I\/O error has occurred.
 727 @[EIO]@
 728
 729 * 'InvalidArgument'
 730 The operand is not a valid directory name.
 731 @[ENAMETOOLONG, ELOOP]@
 732
 733 * 'isDoesNotExistError' \/ 'NoSuchThing'
 734 The directory does not exist.
 735 @[ENOENT, ENOTDIR]@
 736
 737 * 'isPermissionError' \/ 'PermissionDenied'
 738 The process has insufficient privileges to perform the operation.
 739 @[EACCES]@
 740
 741 * 'ResourceExhausted'
 742 Insufficient resources are available to perform the operation.
 743 @[EMFILE, ENFILE]@
 744
 745 * 'InappropriateType'
 746 The path refers to an existing non-directory object.
 747 @[ENOTDIR]@
 748
 749 -}
 750
 751 getDirectoryContents :: FilePath -> IO [FilePath]
 752 getDirectoryContents path = do
 753   modifyIOError (`ioeSetFileName` path) $
 754    alloca $ \ ptr_dEnt ->
 755      bracket
 756         (withCString path $ \s ->
 757            throwErrnoIfNullRetry desc (c_opendir s))
 758         (\p -> throwErrnoIfMinus1_ desc (c_closedir p))
 759         (\p -> loop ptr_dEnt p)
 760   where
 761     desc = "getDirectoryContents"
 762
 763     loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
 764     loop ptr_dEnt dir = do
 765       resetErrno
 766       r <- readdir dir ptr_dEnt
 767       if (r == 0)
 768          then do
 769                  dEnt    <- peek ptr_dEnt
 770                  if (dEnt == nullPtr)
 771                    then return []
 772                    else do
 773                     entry   <- (d_name dEnt >>= peekCString)
 774                     freeDirEnt dEnt
 775                     entries <- loop ptr_dEnt dir
 776                     return (entry:entries)
 777          else do errno <- getErrno
 778                  if (errno == eINTR) then loop ptr_dEnt dir else do
 779                    let (Errno eo) = errno
 780                    if (eo == end_of_dir)
 781                       then return []
 782                       else throwErrno desc
 783 #endif /* !__HUGS__ */
 784
 785
 786 {- |If the operating system has a notion of current directories,
 787 'getCurrentDirectory' returns an absolute path to the
 788 current directory of the calling process.
 789
 790 The operation may fail with:
 791
 792 * 'HardwareFault'
 793 A physical I\/O error has occurred.
 794 @[EIO]@
 795
 796 * 'isDoesNotExistError' \/ 'NoSuchThing'
 797 There is no path referring to the current directory.
 798 @[EPERM, ENOENT, ESTALE...]@
 799
 800 * 'isPermissionError' \/ 'PermissionDenied'
 801 The process has insufficient privileges to perform the operation.
 802 @[EACCES]@
 803
 804 * 'ResourceExhausted'
 805 Insufficient resources are available to perform the operation.
 806
 807 * 'UnsupportedOperation'
 808 The operating system has no notion of current directory.
 809
 810 -}
 811 #ifdef __GLASGOW_HASKELL__
 812 getCurrentDirectory :: IO FilePath
 813 getCurrentDirectory = do
 814 #ifdef mingw32_HOST_OS
 815   System.Win32.getCurrentDirectory
 816 #else
 817   System.Posix.getWorkingDirectory
 818 #endif
 819
 820 {- |If the operating system has a notion of current directories,
 821 @'setCurrentDirectory' dir@ changes the current
 822 directory of the calling process to /dir/.
 823
 824 The operation may fail with:
 825
 826 * 'HardwareFault'
 827 A physical I\/O error has occurred.
 828 @[EIO]@
 829
 830 * 'InvalidArgument'
 831 The operand is not a valid directory name.
 832 @[ENAMETOOLONG, ELOOP]@
 833
 834 * 'isDoesNotExistError' \/ 'NoSuchThing'
 835 The directory does not exist.
 836 @[ENOENT, ENOTDIR]@
 837
 838 * 'isPermissionError' \/ 'PermissionDenied'
 839 The process has insufficient privileges to perform the operation.
 840 @[EACCES]@
 841
 842 * 'UnsupportedOperation'
 843 The operating system has no notion of current directory, or the
 844 current directory cannot be dynamically changed.
 845
 846 * 'InappropriateType'
 847 The path refers to an existing non-directory object.
 848 @[ENOTDIR]@
 849
 850 -}
 851
 852 setCurrentDirectory :: FilePath -> IO ()
 853 setCurrentDirectory path =
 854 #ifdef mingw32_HOST_OS
 855   System.Win32.setCurrentDirectory path
 856 #else
 857   System.Posix.changeWorkingDirectory path
 858 #endif
 859
 860 #endif /* __GLASGOW_HASKELL__ */
 861
 862 #ifndef __HUGS__
 863 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
 864 exists and is a directory, and 'False' otherwise.
 865 -}
 866
 867 doesDirectoryExist :: FilePath -> IO Bool
 868 doesDirectoryExist name =
 869    (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
 870    `catch` ((\ _ -> return False) :: IOException -> IO Bool)
 871
 872 {- |The operation 'doesFileExist' returns 'True'
 873 if the argument file exists and is not a directory, and 'False' otherwise.
 874 -}
 875
 876 doesFileExist :: FilePath -> IO Bool
 877 doesFileExist name =
 878    (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
 879    `catch` ((\ _ -> return False) :: IOException -> IO Bool)
 880
 881 {- |The 'getModificationTime' operation returns the
 882 clock time at which the file or directory was last modified.
 883
 884 The operation may fail with:
 885
 886 * 'isPermissionError' if the user is not permitted to access
 887   the modification time; or
 888
 889 * 'isDoesNotExistError' if the file or directory does not exist.
 890
 891 -}
 892
 893 getModificationTime :: FilePath -> IO ClockTime
 894 getModificationTime name =
 895  withFileStatus "getModificationTime" name $ \ st ->
 896  modificationTime st
 897
 898 #endif /* !__HUGS__ */
 899
 900 withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 901 withFileStatus loc name f = do
 902   modifyIOError (`ioeSetFileName` name) $
 903     allocaBytes sizeof_stat $ \p ->
 904       withCString (fileNameEndClean name) $ \s -> do
 905         throwErrnoIfMinus1Retry_ loc (c_stat s p)
 906         f p
 907
 908 withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 909 withFileOrSymlinkStatus loc name f = do
 910   modifyIOError (`ioeSetFileName` name) $
 911     allocaBytes sizeof_stat $ \p ->
 912       withCString name $ \s -> do
 913         throwErrnoIfMinus1Retry_ loc (lstat s p)
 914         f p
 915
 916 modificationTime :: Ptr CStat -> IO ClockTime
 917 modificationTime stat = do
 918     mtime <- st_mtime stat
 919     let realToInteger = round . realToFrac :: Real a => a -> Integer
 920     return (TOD (realToInteger (mtime :: CTime)) 0)
 921
 922 isDirectory :: Ptr CStat -> IO Bool
 923 isDirectory stat = do
 924   mode <- st_mode stat
 925   return (s_isdir mode)
 926
 927 fileNameEndClean :: String -> String
 928 fileNameEndClean name = if isDrive name then addTrailingPathSeparator name
 929                                         else dropTrailingPathSeparator name
 930
 931 foreign import ccall unsafe "HsDirectory.h __hscore_R_OK" r_OK :: CInt
 932 foreign import ccall unsafe "HsDirectory.h __hscore_W_OK" w_OK :: CInt
 933 foreign import ccall unsafe "HsDirectory.h __hscore_X_OK" x_OK :: CInt
 934
 935 foreign import ccall unsafe "HsDirectory.h __hscore_S_IRUSR" s_IRUSR :: CMode
 936 foreign import ccall unsafe "HsDirectory.h __hscore_S_IWUSR" s_IWUSR :: CMode
 937 foreign import ccall unsafe "HsDirectory.h __hscore_S_IXUSR" s_IXUSR :: CMode
 938 #ifdef mingw32_HOST_OS
 939 foreign import ccall unsafe "__hscore_S_IFDIR" s_IFDIR :: CMode
 940 #endif
 941
 942
 943 #ifdef __GLASGOW_HASKELL__
 944 foreign import ccall unsafe "__hscore_long_path_size"
 945   long_path_size :: Int
 946 #else
 947 long_path_size :: Int
 948 long_path_size = 2048   --  // guess?
 949 #endif /* __GLASGOW_HASKELL__ */
 950
 951 {- | Returns the current user's home directory.
 952
 953 The directory returned is expected to be writable by the current user,
 954 but note that it isn't generally considered good practice to store
 955 application-specific data here; use 'getAppUserDataDirectory'
 956 instead.
 957
 958 On Unix, 'getHomeDirectory' returns the value of the @HOME@
 959 environment variable.  On Windows, the system is queried for a
 960 suitable path; a typical path might be
 961 @C:/Documents And Settings/user@.
 962
 963 The operation may fail with:
 964
 965 * 'UnsupportedOperation'
 966 The operating system has no notion of home directory.
 967
 968 * 'isDoesNotExistError'
 969 The home directory for the current user does not exist, or
 970 cannot be found.
 971 -}
 972 getHomeDirectory :: IO FilePath
 973 getHomeDirectory =
 974 #if defined(mingw32_HOST_OS)
 975   allocaBytes long_path_size $ \pPath -> do
 976      r0 <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
 977      if (r0 < 0)
 978        then do
 979           r1 <- c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
 980           when (r1 < 0) (raiseUnsupported "System.Directory.getHomeDirectory")
 981        else return ()
 982      peekCString pPath
 983 #else
 984   getEnv "HOME"
 985 #endif
 986
 987 {- | Returns the pathname of a directory in which application-specific
 988 data for the current user can be stored.  The result of
 989 'getAppUserDataDirectory' for a given application is specific to
 990 the current user.
 991
 992 The argument should be the name of the application, which will be used
 993 to construct the pathname (so avoid using unusual characters that
 994 might result in an invalid pathname).
 995
 996 Note: the directory may not actually exist, and may need to be created
 997 first.  It is expected that the parent directory exists and is
 998 writable.
 999
1000 On Unix, this function returns @$HOME\/.appName@.  On Windows, a
1001 typical path might be
1002
1003 > C:/Documents And Settings/user/Application Data/appName
1004
1005 The operation may fail with:
1006
1007 * 'UnsupportedOperation'
1008 The operating system has no notion of application-specific data directory.
1009
1010 * 'isDoesNotExistError'
1011 The home directory for the current user does not exist, or
1012 cannot be found.
1013 -}
1014 getAppUserDataDirectory :: String -> IO FilePath
1015 getAppUserDataDirectory appName = do
1016 #if defined(mingw32_HOST_OS)
1017   allocaBytes long_path_size $ \pPath -> do
1018      r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
1019      when (r<0) (raiseUnsupported "System.Directory.getAppUserDataDirectory")
1020      s <- peekCString pPath
1021      return (s++'\\':appName)
1022 #else
1023   path <- getEnv "HOME"
1024   return (path++'/':'.':appName)
1025 #endif
1026
1027 {- | Returns the current user's document directory.
1028
1029 The directory returned is expected to be writable by the current user,
1030 but note that it isn't generally considered good practice to store
1031 application-specific data here; use 'getAppUserDataDirectory'
1032 instead.
1033
1034 On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@
1035 environment variable.  On Windows, the system is queried for a
1036 suitable path; a typical path might be
1037 @C:\/Documents and Settings\/user\/My Documents@.
1038
1039 The operation may fail with:
1040
1041 * 'UnsupportedOperation'
1042 The operating system has no notion of document directory.
1043
1044 * 'isDoesNotExistError'
1045 The document directory for the current user does not exist, or
1046 cannot be found.
1047 -}
1048 getUserDocumentsDirectory :: IO FilePath
1049 getUserDocumentsDirectory = do
1050 #if defined(mingw32_HOST_OS)
1051   allocaBytes long_path_size $ \pPath -> do
1052      r <- c_SHGetFolderPath nullPtr csidl_PERSONAL nullPtr 0 pPath
1053      when (r<0) (raiseUnsupported "System.Directory.getUserDocumentsDirectory")
1054      peekCString pPath
1055 #else
1056   getEnv "HOME"
1057 #endif
1058
1059 {- | Returns the current directory for temporary files.
1060
1061 On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@
1062 environment variable or \"\/tmp\" if the variable isn\'t defined.
1063 On Windows, the function checks for the existence of environment variables in
1064 the following order and uses the first path found:
1065
1066 *
1067 TMP environment variable.
1068
1069 *
1070 TEMP environment variable.
1071
1072 *
1073 USERPROFILE environment variable.
1074
1075 *
1076 The Windows directory
1077
1078 The operation may fail with:
1079
1080 * 'UnsupportedOperation'
1081 The operating system has no notion of temporary directory.
1082
1083 The function doesn\'t verify whether the path exists.
1084 -}
1085 getTemporaryDirectory :: IO FilePath
1086 getTemporaryDirectory = do
1087 #if defined(mingw32_HOST_OS)
1088   System.Win32.getTemporaryDirectory
1089 #else
1090   getEnv "TMPDIR"
1091 #if !__NHC__
1092     `Prelude.catch` \e -> if isDoesNotExistError e then return "/tmp"
1093                           else throw e
1094 #else
1095     `Prelude.catch` (\ex -> return "/tmp")
1096 #endif
1097 #endif
1098
1099 #if defined(mingw32_HOST_OS)
1100 foreign import ccall unsafe "__hscore_getFolderPath"
1101             c_SHGetFolderPath :: Ptr ()
1102                               -> CInt
1103                               -> Ptr ()
1104                               -> CInt
1105                               -> CString
1106                               -> IO CInt
1107 foreign import ccall unsafe "__hscore_CSIDL_PROFILE"  csidl_PROFILE  :: CInt
1108 foreign import ccall unsafe "__hscore_CSIDL_APPDATA"  csidl_APPDATA  :: CInt
1109 foreign import ccall unsafe "__hscore_CSIDL_WINDOWS"  csidl_WINDOWS  :: CInt
1110 foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: 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