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