System/Directory.hs

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