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     fileName = binary `joinFileExt` drop 1 exeExt
 527
 528     search :: [FilePath] -> IO (Maybe FilePath)
 529     search [] = return Nothing
 530     search (d:ds) = do
 531         let path = d `joinFileName` fileName
 532         b <- doesFileExist path
 533         if b then return (Just path)
 534              else search ds
 535
 536 -- ToDo: This should be determined via autoconf (AC_EXEEXT)
 537 exeExt :: String
 538 #ifdef mingw32_TARGET_OS
 539 exeExt = ".exe"
 540 #else
 541 exeExt = ""
 542 #endif
 543
 544 #ifdef __GLASGOW_HASKELL__
 545 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
 546 in /dir/.
 547
 548 The operation may fail with:
 549
 550 * 'HardwareFault'
 551 A physical I\/O error has occurred.
 552 @[EIO]@
 553
 554 * 'InvalidArgument'
 555 The operand is not a valid directory name.
 556 @[ENAMETOOLONG, ELOOP]@
 557
 558 * 'isDoesNotExistError' \/ 'NoSuchThing'
 559 The directory does not exist.
 560 @[ENOENT, ENOTDIR]@
 561
 562 * 'isPermissionError' \/ 'PermissionDenied'
 563 The process has insufficient privileges to perform the operation.
 564 @[EACCES]@
 565
 566 * 'ResourceExhausted'
 567 Insufficient resources are available to perform the operation.
 568 @[EMFILE, ENFILE]@
 569
 570 * 'InappropriateType'
 571 The path refers to an existing non-directory object.
 572 @[ENOTDIR]@
 573
 574 -}
 575
 576 getDirectoryContents :: FilePath -> IO [FilePath]
 577 getDirectoryContents path = do
 578   modifyIOError (`ioeSetFileName` path) $
 579    alloca $ \ ptr_dEnt ->
 580      bracket
 581         (withCString path $ \s ->
 582            throwErrnoIfNullRetry desc (c_opendir s))
 583         (\p -> throwErrnoIfMinus1_ desc (c_closedir p))
 584         (\p -> loop ptr_dEnt p)
 585   where
 586     desc = "getDirectoryContents"
 587
 588     loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
 589     loop ptr_dEnt dir = do
 590       resetErrno
 591       r <- readdir dir ptr_dEnt
 592       if (r == 0)
 593          then do
 594                  dEnt    <- peek ptr_dEnt
 595                  if (dEnt == nullPtr)
 596                    then return []
 597                    else do
 598                     entry   <- (d_name dEnt >>= peekCString)
 599                     freeDirEnt dEnt
 600                     entries <- loop ptr_dEnt dir
 601                     return (entry:entries)
 602          else do errno <- getErrno
 603                  if (errno == eINTR) then loop ptr_dEnt dir else do
 604                  let (Errno eo) = errno
 605                  if (eo == end_of_dir)
 606                     then return []
 607                     else throwErrno desc
 608
 609
 610
 611 {- |If the operating system has a notion of current directories,
 612 'getCurrentDirectory' returns an absolute path to the
 613 current directory of the calling process.
 614
 615 The operation may fail with:
 616
 617 * 'HardwareFault'
 618 A physical I\/O error has occurred.
 619 @[EIO]@
 620
 621 * 'isDoesNotExistError' \/ 'NoSuchThing'
 622 There is no path referring to the current directory.
 623 @[EPERM, ENOENT, ESTALE...]@
 624
 625 * 'isPermissionError' \/ 'PermissionDenied'
 626 The process has insufficient privileges to perform the operation.
 627 @[EACCES]@
 628
 629 * 'ResourceExhausted'
 630 Insufficient resources are available to perform the operation.
 631
 632 * 'UnsupportedOperation'
 633 The operating system has no notion of current directory.
 634
 635 -}
 636
 637 getCurrentDirectory :: IO FilePath
 638 getCurrentDirectory = do
 639   p <- mallocBytes long_path_size
 640   go p long_path_size
 641   where go p bytes = do
 642           p' <- c_getcwd p (fromIntegral bytes)
 643           if p' /= nullPtr
 644              then do s <- peekCString p'
 645                      free p'
 646                      return s
 647              else do errno <- getErrno
 648                      if errno == eRANGE
 649                         then do let bytes' = bytes * 2
 650                                 p' <- reallocBytes p bytes'
 651                                 go p' bytes'
 652                         else throwErrno "getCurrentDirectory"
 653
 654 {- |If the operating system has a notion of current directories,
 655 @'setCurrentDirectory' dir@ changes the current
 656 directory of the calling process to /dir/.
 657
 658 The operation may fail with:
 659
 660 * 'HardwareFault'
 661 A physical I\/O error has occurred.
 662 @[EIO]@
 663
 664 * 'InvalidArgument'
 665 The operand is not a valid directory name.
 666 @[ENAMETOOLONG, ELOOP]@
 667
 668 * 'isDoesNotExistError' \/ 'NoSuchThing'
 669 The directory does not exist.
 670 @[ENOENT, ENOTDIR]@
 671
 672 * 'isPermissionError' \/ 'PermissionDenied'
 673 The process has insufficient privileges to perform the operation.
 674 @[EACCES]@
 675
 676 * 'UnsupportedOperation'
 677 The operating system has no notion of current directory, or the
 678 current directory cannot be dynamically changed.
 679
 680 * 'InappropriateType'
 681 The path refers to an existing non-directory object.
 682 @[ENOTDIR]@
 683
 684 -}
 685
 686 setCurrentDirectory :: FilePath -> IO ()
 687 setCurrentDirectory path = do
 688   modifyIOError (`ioeSetFileName` path) $
 689     withCString path $ \s ->
 690        throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
 691         -- ToDo: add path to error
 692
 693 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
 694 exists and is a directory, and 'False' otherwise.
 695 -}
 696
 697 doesDirectoryExist :: FilePath -> IO Bool
 698 doesDirectoryExist name =
 699  catch
 700    (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
 701    (\ _ -> return False)
 702
 703 {- |The operation 'doesFileExist' returns 'True'
 704 if the argument file exists and is not a directory, and 'False' otherwise.
 705 -}
 706
 707 doesFileExist :: FilePath -> IO Bool
 708 doesFileExist name = do
 709  catch
 710    (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
 711    (\ _ -> return False)
 712
 713 {- |The 'getModificationTime' operation returns the
 714 clock time at which the file or directory was last modified.
 715
 716 The operation may fail with:
 717
 718 * 'isPermissionError' if the user is not permitted to access
 719   the modification time; or
 720
 721 * 'isDoesNotExistError' if the file or directory does not exist.
 722
 723 -}
 724
 725 getModificationTime :: FilePath -> IO ClockTime
 726 getModificationTime name =
 727  withFileStatus "getModificationTime" name $ \ st ->
 728  modificationTime st
 729
 730 withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 731 withFileStatus loc name f = do
 732   modifyIOError (`ioeSetFileName` name) $
 733     allocaBytes sizeof_stat $ \p ->
 734       withCString (fileNameEndClean name) $ \s -> do
 735         throwErrnoIfMinus1Retry_ loc (c_stat s p)
 736         f p
 737
 738 withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 739 withFileOrSymlinkStatus loc name f = do
 740   modifyIOError (`ioeSetFileName` name) $
 741     allocaBytes sizeof_stat $ \p ->
 742       withCString name $ \s -> do
 743         throwErrnoIfMinus1Retry_ loc (lstat s p)
 744         f p
 745
 746 modificationTime :: Ptr CStat -> IO ClockTime
 747 modificationTime stat = do
 748     mtime <- st_mtime stat
 749     let realToInteger = round . realToFrac :: Real a => a -> Integer
 750     return (TOD (realToInteger (mtime :: CTime)) 0)
 751
 752 isDirectory :: Ptr CStat -> IO Bool
 753 isDirectory stat = do
 754   mode <- st_mode stat
 755   return (s_isdir mode)
 756
 757 fileNameEndClean :: String -> String
 758 fileNameEndClean name =
 759   if i > 0 && (ec == '\\' || ec == '/') then
 760      fileNameEndClean (take i name)
 761    else
 762      name
 763   where
 764       i  = (length name) - 1
 765       ec = name !! i
 766
 767 foreign import ccall unsafe "__hscore_long_path_size"
 768   long_path_size :: Int
 769
 770 foreign import ccall unsafe "__hscore_R_OK" r_OK :: CMode
 771 foreign import ccall unsafe "__hscore_W_OK" w_OK :: CMode
 772 foreign import ccall unsafe "__hscore_X_OK" x_OK :: CMode
 773
 774 foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
 775 foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
 776 foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode
 777
 778 #endif /* __GLASGOW_HASKELL__ */
 779
 780 {- | Returns the current user's home directory.
 781
 782 The directory returned is expected to be writable by the current user,
 783 but note that it isn't generally considered good practice to store
 784 application-specific data here; use 'getAppUserDataDirectory'
 785 instead.
 786
 787 On Unix, 'getHomeDirectory' returns the value of the @HOME@
 788 environment variable.  On Windows, the system is queried for a
 789 suitable path; a typical path might be
 790 @C:/Documents And Settings/user@.
 791
 792 The operation may fail with:
 793
 794 * 'UnsupportedOperation'
 795 The operating system has no notion of home directory.
 796
 797 * 'isDoesNotExistError'
 798 The home directory for the current user does not exist, or
 799 cannot be found.
 800 -}
 801 getHomeDirectory :: IO FilePath
 802 getHomeDirectory =
 803 #if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS)
 804   allocaBytes long_path_size $ \pPath -> do
 805      r <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
 806      if (r < 0)
 807        then c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
 808        else return 0
 809      peekCString pPath
 810 #else
 811   getEnv "HOME"
 812 #endif
 813
 814 {- | Returns the pathname of a directory in which application-specific
 815 data for the current user can be stored.  The result of
 816 'getAppUserDataDirectory' for a given application is specific to
 817 the current user.
 818
 819 The argument should be the name of the application, which will be used
 820 to construct the pathname (so avoid using unusual characters that
 821 might result in an invalid pathname).
 822
 823 Note: the directory may not actually exist, and may need to be created
 824 first.  It is expected that the parent directory exists and is
 825 writable.
 826
 827 On Unix, this function returns @$HOME\/.appName@.  On Windows, a
 828 typical path might be
 829
 830 > C:/Documents And Settings/user/Application Data/appName
 831
 832 The operation may fail with:
 833
 834 * 'UnsupportedOperation'
 835 The operating system has no notion of application-specific data directory.
 836
 837 * 'isDoesNotExistError'
 838 The home directory for the current user does not exist, or
 839 cannot be found.
 840 -}
 841 getAppUserDataDirectory :: String -> IO FilePath
 842 getAppUserDataDirectory appName = do
 843 #if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS)
 844   allocaBytes long_path_size $ \pPath -> do
 845      r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
 846      s <- peekCString pPath
 847      return (s++'\\':appName)
 848 #else
 849   path <- getEnv "HOME"
 850   return (path++'/':'.':appName)
 851 #endif
 852
 853 {- | Returns the current user's document directory.
 854
 855 The directory returned is expected to be writable by the current user,
 856 but note that it isn't generally considered good practice to store
 857 application-specific data here; use 'getAppUserDataDirectory'
 858 instead.
 859
 860 On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@
 861 environment variable.  On Windows, the system is queried for a
 862 suitable path; a typical path might be
 863 @C:\/Documents and Settings\/user\/My Documents@.
 864
 865 The operation may fail with:
 866
 867 * 'UnsupportedOperation'
 868 The operating system has no notion of document directory.
 869
 870 * 'isDoesNotExistError'
 871 The document directory for the current user does not exist, or
 872 cannot be found.
 873 -}
 874 getUserDocumentsDirectory :: IO FilePath
 875 getUserDocumentsDirectory = do
 876 #if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS)
 877   allocaBytes long_path_size $ \pPath -> do
 878      r <- c_SHGetFolderPath nullPtr csidl_PERSONAL nullPtr 0 pPath
 879      peekCString pPath
 880 #else
 881   getEnv "HOME"
 882 #endif
 883
 884 #if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS)
 885 foreign import stdcall unsafe "SHGetFolderPath"
 886             c_SHGetFolderPath :: Ptr ()
 887                               -> CInt
 888                               -> Ptr ()
 889                               -> CInt
 890                               -> CString
 891                               -> IO CInt
 892 foreign import ccall unsafe "__hscore_CSIDL_PROFILE"  csidl_PROFILE  :: CInt
 893 foreign import ccall unsafe "__hscore_CSIDL_APPDATA"  csidl_APPDATA  :: CInt
 894 foreign import ccall unsafe "__hscore_CSIDL_WINDOWS"  csidl_WINDOWS  :: CInt
 895 foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt
 896 #endif