System/Directory.hs

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