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