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