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