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