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