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