System/Directory.hs

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