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