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