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 read   = mode .&. s_IRUSR
 169   let write  = mode .&. s_IWUSR
 170   let exec   = mode .&. s_IXUSR
 171   let is_dir = mode .&. s_IFDIR
 172   return (
 173     Permissions {
 174       readable   = read  /= 0,
 175       writable   = write /= 0,
 176       executable = is_dir == 0 && exec /= 0,
 177       searchable = is_dir /= 0 && exec /= 0
 178     }
 179    )
 180 #else
 181   read  <- c_access s r_OK
 182   write <- c_access s w_OK
 183   exec  <- c_access s x_OK
 184   withFileStatus "getPermissions" name $ \st -> do
 185   is_dir <- isDirectory st
 186   return (
 187     Permissions {
 188       readable   = read  == 0,
 189       writable   = write == 0,
 190       executable = not is_dir && exec == 0,
 191       searchable = is_dir && exec == 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 e ->
 550                             throw $ IOException $ ioeSetLocation e "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        peekCString pOutPath
 588
 589 #if defined(mingw32_HOST_OS)
 590 foreign import stdcall unsafe "GetFullPathNameA"
 591             c_GetFullPathName :: CString
 592                               -> CInt
 593                               -> CString
 594                               -> Ptr CString
 595                               -> IO CInt
 596 #else
 597 foreign import ccall unsafe "realpath"
 598                    c_realpath :: CString
 599                               -> CString
 600                               -> IO CString
 601 #endif
 602
 603 -- | 'makeRelative' the current directory.
 604 makeRelativeToCurrentDirectory :: FilePath -> IO FilePath
 605 makeRelativeToCurrentDirectory x = do
 606     cur <- getCurrentDirectory
 607     return $ makeRelative cur x
 608
 609 -- | Given an executable file name, searches for such file
 610 -- in the directories listed in system PATH. The returned value
 611 -- is the path to the found executable or Nothing if there isn't
 612 -- such executable. For example (findExecutable \"ghc\")
 613 -- gives you the path to GHC.
 614 findExecutable :: String -> IO (Maybe FilePath)
 615 findExecutable binary =
 616 #if defined(mingw32_HOST_OS)
 617   withCString binary $ \c_binary ->
 618   withCString ('.':exeExtension) $ \c_ext ->
 619   allocaBytes long_path_size $ \pOutPath ->
 620   alloca $ \ppFilePart -> do
 621     res <- c_SearchPath nullPtr c_binary c_ext (fromIntegral long_path_size) pOutPath ppFilePart
 622     if res > 0 && res < fromIntegral long_path_size
 623       then do fpath <- peekCString pOutPath
 624               return (Just fpath)
 625       else return Nothing
 626
 627 foreign import stdcall unsafe "SearchPathA"
 628             c_SearchPath :: CString
 629                          -> CString
 630                          -> CString
 631                          -> CInt
 632                          -> CString
 633                          -> Ptr CString
 634                          -> IO CInt
 635 #else
 636  do
 637   path <- getEnv "PATH"
 638   search (splitSearchPath path)
 639   where
 640     fileName = binary <.> exeExtension
 641
 642     search :: [FilePath] -> IO (Maybe FilePath)
 643     search [] = return Nothing
 644     search (d:ds) = do
 645         let path = d </> fileName
 646         b <- doesFileExist path
 647         if b then return (Just path)
 648              else search ds
 649 #endif
 650
 651
 652 #ifdef __GLASGOW_HASKELL__
 653 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
 654 in /dir/.
 655
 656 The operation may fail with:
 657
 658 * 'HardwareFault'
 659 A physical I\/O error has occurred.
 660 @[EIO]@
 661
 662 * 'InvalidArgument'
 663 The operand is not a valid directory name.
 664 @[ENAMETOOLONG, ELOOP]@
 665
 666 * 'isDoesNotExistError' \/ 'NoSuchThing'
 667 The directory does not exist.
 668 @[ENOENT, ENOTDIR]@
 669
 670 * 'isPermissionError' \/ 'PermissionDenied'
 671 The process has insufficient privileges to perform the operation.
 672 @[EACCES]@
 673
 674 * 'ResourceExhausted'
 675 Insufficient resources are available to perform the operation.
 676 @[EMFILE, ENFILE]@
 677
 678 * 'InappropriateType'
 679 The path refers to an existing non-directory object.
 680 @[ENOTDIR]@
 681
 682 -}
 683
 684 getDirectoryContents :: FilePath -> IO [FilePath]
 685 getDirectoryContents path = do
 686   modifyIOError (`ioeSetFileName` path) $
 687    alloca $ \ ptr_dEnt ->
 688      bracket
 689         (withCString path $ \s ->
 690            throwErrnoIfNullRetry desc (c_opendir s))
 691         (\p -> throwErrnoIfMinus1_ desc (c_closedir p))
 692         (\p -> loop ptr_dEnt p)
 693   where
 694     desc = "getDirectoryContents"
 695
 696     loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
 697     loop ptr_dEnt dir = do
 698       resetErrno
 699       r <- readdir dir ptr_dEnt
 700       if (r == 0)
 701          then do
 702                  dEnt    <- peek ptr_dEnt
 703                  if (dEnt == nullPtr)
 704                    then return []
 705                    else do
 706                     entry   <- (d_name dEnt >>= peekCString)
 707                     freeDirEnt dEnt
 708                     entries <- loop ptr_dEnt dir
 709                     return (entry:entries)
 710          else do errno <- getErrno
 711                  if (errno == eINTR) then loop ptr_dEnt dir else do
 712                  let (Errno eo) = errno
 713                  if (eo == end_of_dir)
 714                     then return []
 715                     else throwErrno desc
 716
 717
 718
 719 {- |If the operating system has a notion of current directories,
 720 'getCurrentDirectory' returns an absolute path to the
 721 current directory of the calling process.
 722
 723 The operation may fail with:
 724
 725 * 'HardwareFault'
 726 A physical I\/O error has occurred.
 727 @[EIO]@
 728
 729 * 'isDoesNotExistError' \/ 'NoSuchThing'
 730 There is no path referring to the current directory.
 731 @[EPERM, ENOENT, ESTALE...]@
 732
 733 * 'isPermissionError' \/ 'PermissionDenied'
 734 The process has insufficient privileges to perform the operation.
 735 @[EACCES]@
 736
 737 * 'ResourceExhausted'
 738 Insufficient resources are available to perform the operation.
 739
 740 * 'UnsupportedOperation'
 741 The operating system has no notion of current directory.
 742
 743 -}
 744
 745 getCurrentDirectory :: IO FilePath
 746 getCurrentDirectory = do
 747   p <- mallocBytes long_path_size
 748   go p long_path_size
 749   where go p bytes = do
 750           p' <- c_getcwd p (fromIntegral bytes)
 751           if p' /= nullPtr
 752              then do s <- peekCString p'
 753                      free p'
 754                      return s
 755              else do errno <- getErrno
 756                      if errno == eRANGE
 757                         then do let bytes' = bytes * 2
 758                                 p' <- reallocBytes p bytes'
 759                                 go p' bytes'
 760                         else throwErrno "getCurrentDirectory"
 761
 762 {- |If the operating system has a notion of current directories,
 763 @'setCurrentDirectory' dir@ changes the current
 764 directory of the calling process to /dir/.
 765
 766 The operation may fail with:
 767
 768 * 'HardwareFault'
 769 A physical I\/O error has occurred.
 770 @[EIO]@
 771
 772 * 'InvalidArgument'
 773 The operand is not a valid directory name.
 774 @[ENAMETOOLONG, ELOOP]@
 775
 776 * 'isDoesNotExistError' \/ 'NoSuchThing'
 777 The directory does not exist.
 778 @[ENOENT, ENOTDIR]@
 779
 780 * 'isPermissionError' \/ 'PermissionDenied'
 781 The process has insufficient privileges to perform the operation.
 782 @[EACCES]@
 783
 784 * 'UnsupportedOperation'
 785 The operating system has no notion of current directory, or the
 786 current directory cannot be dynamically changed.
 787
 788 * 'InappropriateType'
 789 The path refers to an existing non-directory object.
 790 @[ENOTDIR]@
 791
 792 -}
 793
 794 setCurrentDirectory :: FilePath -> IO ()
 795 setCurrentDirectory path = do
 796   modifyIOError (`ioeSetFileName` path) $
 797     withCString path $ \s ->
 798        throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
 799         -- ToDo: add path to error
 800
 801 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
 802 exists and is a directory, and 'False' otherwise.
 803 -}
 804
 805 doesDirectoryExist :: FilePath -> IO Bool
 806 doesDirectoryExist name =
 807  catch
 808    (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
 809    (\ _ -> return False)
 810
 811 {- |The operation 'doesFileExist' returns 'True'
 812 if the argument file exists and is not a directory, and 'False' otherwise.
 813 -}
 814
 815 doesFileExist :: FilePath -> IO Bool
 816 doesFileExist name = do
 817  catch
 818    (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
 819    (\ _ -> return False)
 820
 821 {- |The 'getModificationTime' operation returns the
 822 clock time at which the file or directory was last modified.
 823
 824 The operation may fail with:
 825
 826 * 'isPermissionError' if the user is not permitted to access
 827   the modification time; or
 828
 829 * 'isDoesNotExistError' if the file or directory does not exist.
 830
 831 -}
 832
 833 getModificationTime :: FilePath -> IO ClockTime
 834 getModificationTime name =
 835  withFileStatus "getModificationTime" name $ \ st ->
 836  modificationTime st
 837
 838 withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 839 withFileStatus loc name f = do
 840   modifyIOError (`ioeSetFileName` name) $
 841     allocaBytes sizeof_stat $ \p ->
 842       withCString (fileNameEndClean name) $ \s -> do
 843         throwErrnoIfMinus1Retry_ loc (c_stat s p)
 844         f p
 845
 846 withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
 847 withFileOrSymlinkStatus loc name f = do
 848   modifyIOError (`ioeSetFileName` name) $
 849     allocaBytes sizeof_stat $ \p ->
 850       withCString name $ \s -> do
 851         throwErrnoIfMinus1Retry_ loc (lstat s p)
 852         f p
 853
 854 modificationTime :: Ptr CStat -> IO ClockTime
 855 modificationTime stat = do
 856     mtime <- st_mtime stat
 857     let realToInteger = round . realToFrac :: Real a => a -> Integer
 858     return (TOD (realToInteger (mtime :: CTime)) 0)
 859
 860 isDirectory :: Ptr CStat -> IO Bool
 861 isDirectory stat = do
 862   mode <- st_mode stat
 863   return (s_isdir mode)
 864
 865 fileNameEndClean :: String -> String
 866 fileNameEndClean name = if isDrive name then addTrailingPathSeparator name
 867                                         else dropTrailingPathSeparator name
 868
 869 foreign import ccall unsafe "__hscore_R_OK" r_OK :: CInt
 870 foreign import ccall unsafe "__hscore_W_OK" w_OK :: CInt
 871 foreign import ccall unsafe "__hscore_X_OK" x_OK :: CInt
 872
 873 foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
 874 foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
 875 foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode
 876 foreign import ccall unsafe "__hscore_S_IFDIR" s_IFDIR :: CMode
 877
 878 foreign import ccall unsafe "__hscore_long_path_size"
 879   long_path_size :: Int
 880
 881 #else
 882 long_path_size :: Int
 883 long_path_size = 2048   --  // guess?
 884
 885 #endif /* __GLASGOW_HASKELL__ */
 886
 887 {- | Returns the current user's home directory.
 888
 889 The directory returned is expected to be writable by the current user,
 890 but note that it isn't generally considered good practice to store
 891 application-specific data here; use 'getAppUserDataDirectory'
 892 instead.
 893
 894 On Unix, 'getHomeDirectory' returns the value of the @HOME@
 895 environment variable.  On Windows, the system is queried for a
 896 suitable path; a typical path might be
 897 @C:/Documents And Settings/user@.
 898
 899 The operation may fail with:
 900
 901 * 'UnsupportedOperation'
 902 The operating system has no notion of home directory.
 903
 904 * 'isDoesNotExistError'
 905 The home directory for the current user does not exist, or
 906 cannot be found.
 907 -}
 908 getHomeDirectory :: IO FilePath
 909 getHomeDirectory =
 910 #if defined(mingw32_HOST_OS)
 911   allocaBytes long_path_size $ \pPath -> do
 912      r <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
 913      if (r < 0)
 914        then do
 915           r <- c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
 916           when (r < 0) (raiseUnsupported "System.Directory.getHomeDirectory")
 917        else return ()
 918      peekCString pPath
 919 #else
 920   getEnv "HOME"
 921 #endif
 922
 923 {- | Returns the pathname of a directory in which application-specific
 924 data for the current user can be stored.  The result of
 925 'getAppUserDataDirectory' for a given application is specific to
 926 the current user.
 927
 928 The argument should be the name of the application, which will be used
 929 to construct the pathname (so avoid using unusual characters that
 930 might result in an invalid pathname).
 931
 932 Note: the directory may not actually exist, and may need to be created
 933 first.  It is expected that the parent directory exists and is
 934 writable.
 935
 936 On Unix, this function returns @$HOME\/.appName@.  On Windows, a
 937 typical path might be
 938
 939 > C:/Documents And Settings/user/Application Data/appName
 940
 941 The operation may fail with:
 942
 943 * 'UnsupportedOperation'
 944 The operating system has no notion of application-specific data directory.
 945
 946 * 'isDoesNotExistError'
 947 The home directory for the current user does not exist, or
 948 cannot be found.
 949 -}
 950 getAppUserDataDirectory :: String -> IO FilePath
 951 getAppUserDataDirectory appName = do
 952 #if defined(mingw32_HOST_OS)
 953   allocaBytes long_path_size $ \pPath -> do
 954      r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
 955      when (r<0) (raiseUnsupported "System.Directory.getAppUserDataDirectory")
 956      s <- peekCString pPath
 957      return (s++'\\':appName)
 958 #else
 959   path <- getEnv "HOME"
 960   return (path++'/':'.':appName)
 961 #endif
 962
 963 {- | Returns the current user's document directory.
 964
 965 The directory returned is expected to be writable by the current user,
 966 but note that it isn't generally considered good practice to store
 967 application-specific data here; use 'getAppUserDataDirectory'
 968 instead.
 969
 970 On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@
 971 environment variable.  On Windows, the system is queried for a
 972 suitable path; a typical path might be
 973 @C:\/Documents and Settings\/user\/My Documents@.
 974
 975 The operation may fail with:
 976
 977 * 'UnsupportedOperation'
 978 The operating system has no notion of document directory.
 979
 980 * 'isDoesNotExistError'
 981 The document directory for the current user does not exist, or
 982 cannot be found.
 983 -}
 984 getUserDocumentsDirectory :: IO FilePath
 985 getUserDocumentsDirectory = do
 986 #if defined(mingw32_HOST_OS)
 987   allocaBytes long_path_size $ \pPath -> do
 988      r <- c_SHGetFolderPath nullPtr csidl_PERSONAL nullPtr 0 pPath
 989      when (r<0) (raiseUnsupported "System.Directory.getUserDocumentsDirectory")
 990      peekCString pPath
 991 #else
 992   getEnv "HOME"
 993 #endif
 994
 995 {- | Returns the current directory for temporary files.
 996
 997 On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@
 998 environment variable or \"\/tmp\" if the variable isn\'t defined.
 999 On Windows, the function checks for the existence of environment variables in
1000 the following order and uses the first path found:
1001
1002 *
1003 TMP environment variable.
1004
1005 *
1006 TEMP environment variable.
1007
1008 *
1009 USERPROFILE environment variable.
1010
1011 *
1012 The Windows directory
1013
1014 The operation may fail with:
1015
1016 * 'UnsupportedOperation'
1017 The operating system has no notion of temporary directory.
1018
1019 The function doesn\'t verify whether the path exists.
1020 -}
1021 getTemporaryDirectory :: IO FilePath
1022 getTemporaryDirectory = do
1023 #if defined(mingw32_HOST_OS)
1024   allocaBytes long_path_size $ \pPath -> do
1025      r <- c_GetTempPath (fromIntegral long_path_size) pPath
1026      peekCString pPath
1027 #else
1028   catch (getEnv "TMPDIR") (\ex -> return "/tmp")
1029 #endif
1030
1031 #if defined(mingw32_HOST_OS)
1032 foreign import ccall unsafe "__hscore_getFolderPath"
1033             c_SHGetFolderPath :: Ptr ()
1034                               -> CInt
1035                               -> Ptr ()
1036                               -> CInt
1037                               -> CString
1038                               -> IO CInt
1039 foreign import ccall unsafe "__hscore_CSIDL_PROFILE"  csidl_PROFILE  :: CInt
1040 foreign import ccall unsafe "__hscore_CSIDL_APPDATA"  csidl_APPDATA  :: CInt
1041 foreign import ccall unsafe "__hscore_CSIDL_WINDOWS"  csidl_WINDOWS  :: CInt
1042 foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt
1043
1044 foreign import stdcall unsafe "GetTempPathA" c_GetTempPath :: CInt -> CString -> IO CInt
1045
1046 raiseUnsupported loc =
1047    ioException (IOError Nothing UnsupportedOperation loc "unsupported operation" Nothing)
1048
1049 #endif
1050
1051 -- ToDo: This should be determined via autoconf (AC_EXEEXT)
1052 -- | Extension for executable files
1053 -- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
1054 exeExtension :: String
1055 #ifdef mingw32_HOST_OS
1056 exeExtension = "exe"
1057 #else
1058 exeExtension = ""
1059 #endif
1060