System/Directory.hs

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