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