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