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