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