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