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