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