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