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