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