ghc/lib/required/IO.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4
   5 \section[IO]{Module @IO@}
   6
   7 \begin{code}
   8 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
   9
  10 module IO (
  11     Handle, HandlePosn,
  12
  13     IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),
  14     BufferMode(NoBuffering,LineBuffering,BlockBuffering),
  15     SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
  16
  17     stdin, stdout, stderr,
  18
  19     openFile, hClose,
  20     hFileSize, hIsEOF, isEOF,
  21     hSetBuffering, hGetBuffering, hFlush,
  22     hGetPosn, hSetPosn, hSeek,
  23     hWaitForInput, hReady, hGetChar, hGetLine, hLookAhead, hGetContents,
  24     hPutChar, hPutStr, hPutStrLn, hPrint,
  25     hIsOpen, hIsClosed, hIsReadable, hIsWritable, hIsSeekable,
  26
  27     isAlreadyExistsError, isDoesNotExistError, isAlreadyInUseError,
  28     isFullError, isEOFError,
  29     isIllegalOperation, isPermissionError, isUserError,
  30     ioeGetErrorString,
  31     ioeGetHandle, ioeGetFileName,
  32     try, bracket, bracket_
  33   ) where
  34
  35 import Ix
  36 import STBase
  37 import Unsafe           ( unsafePerformIO, unsafeInterleaveIO )
  38 import IOBase
  39 import ArrBase          ( MutableByteArray(..), newCharArray )
  40 import IOHandle         -- much of the real stuff is in here
  41 import PackBase         ( unpackNBytesST )
  42 import PrelBase
  43 import GHC
  44 import Addr
  45
  46 #ifndef __PARALLEL_HASKELL__
  47 import Foreign  ( ForeignObj, makeForeignObj, writeForeignObj )
  48 #endif
  49
  50 import Char             ( ord, chr )
  51 \end{code}
  52
  53 %*********************************************************
  54 %*                                                      *
  55 \subsection{Signatures}
  56 %*                                                      *
  57 %*********************************************************
  58
  59 \begin{code}
  60 --IOHandle:hClose                :: Handle -> IO ()
  61 --IOHandle:hFileSize             :: Handle -> IO Integer
  62 --IOHandle:hFlush                :: Handle -> IO ()
  63 --IOHandle:hGetBuffering         :: Handle -> IO BufferMode
  64 hGetChar              :: Handle -> IO Char
  65 hGetContents          :: Handle -> IO String
  66 --IOHandle:hGetPosn              :: Handle -> IO HandlePosn
  67 --IOHandle:hIsClosed             :: Handle -> IO Bool
  68 --IOHandle:hIsEOF                :: Handle -> IO Bool
  69 --IOHandle:hIsOpen               :: Handle -> IO Bool
  70 --IOHandle:hIsReadable           :: Handle -> IO Bool
  71 --IOHandle:hIsSeekable           :: Handle -> IO Bool
  72 --IOHandle:hIsWritable           :: Handle -> IO Bool
  73 hLookAhead            :: Handle -> IO Char
  74 hPrint                :: Show a => Handle -> a -> IO ()
  75 hPutChar              :: Handle -> Char -> IO ()
  76 hPutStr               :: Handle -> String -> IO ()
  77 hPutStrLn             :: Handle -> String -> IO ()
  78 hReady                :: Handle -> IO Bool
  79 hWaitForInput         :: Handle -> Int -> IO Bool
  80
  81 --IOHandle:hSeek                 :: Handle -> SeekMode -> Integer -> IO ()
  82 --IOHandle:hSetBuffering         :: Handle -> BufferMode -> IO ()
  83 --IOHandle:hSetPosn              :: HandlePosn -> IO ()
  84 -- ioeGetFileName        :: IOError -> Maybe FilePath
  85 -- ioeGetErrorString     :: IOError -> Maybe String
  86 -- ioeGetHandle          :: IOError -> Maybe Handle
  87 -- isAlreadyExistsError  :: IOError -> Bool
  88 -- isAlreadyInUseError   :: IOError -> Bool
  89 --IOHandle:isEOF                 :: IO Bool
  90 -- isEOFError            :: IOError -> Bool
  91 -- isFullError           :: IOError -> Bool
  92 -- isIllegalOperation    :: IOError -> Bool
  93 -- isPermissionError     :: IOError -> Bool
  94 -- isUserError           :: IOError -> Maybe String
  95 --IOHandle:openFile              :: FilePath -> IOMode -> IO Handle
  96 --IOHandle:stdin, stdout, stderr :: Handle
  97 \end{code}
  98
  99 Standard instances for @Handle@:
 100
 101 \begin{code}
 102 instance Eq IOError where
 103   (IOError h1 e1 str1) == (IOError h2 e2 str2) =
 104     e1==e2 && str1==str2 && h1==h2
 105
 106 instance Eq Handle where
 107  h1 == h2 =
 108   unsafePerformIO (do
 109     h1_ <- readHandle h1
 110     writeHandle h1 h1_
 111     h2_<- readHandle h2
 112     writeHandle h2 h2_
 113     return (
 114      case (h1_,h2_) of
 115       (ErrorHandle (IOError h1 _ _), ErrorHandle (IOError h2 _ _)) -> h1 == h2
 116       (ClosedHandle, ClosedHandle) -> True
 117       (SemiClosedHandle v1 _, SemiClosedHandle v2 _) -> v1 == v2
 118       (ReadHandle v1 _ _ ,      ReadHandle v2 _ _)   -> v1 == v2
 119       (WriteHandle v1 _ _ ,     WriteHandle v2 _ _)  -> v1 == v2
 120       (AppendHandle v1 _ _ ,    AppendHandle v2 _ _) -> v1 == v2
 121       (ReadWriteHandle v1 _ _ , ReadWriteHandle v2 _ _) -> v1 == v2
 122       _ -> False))
 123
 124 instance Show Handle where {showsPrec p h = showString "<<Handle>>"}
 125
 126 --Type declared in IOHandle, instance here because it depends on Eq.Handle
 127 instance Eq HandlePosn where
 128     (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
 129
 130 \end{code}
 131
 132 %*********************************************************
 133 %*                                                      *
 134 \subsection{Simple input operations}
 135 %*                                                      *
 136 %*********************************************************
 137
 138 Computation @hReady hdl@ indicates whether at least
 139 one item is available for input from handle {\em hdl}.
 140
 141 @hWaitForInput@ is the generalisation, wait for \tr{n} seconds
 142 before deciding whether the Handle has run dry or not.
 143
 144 \begin{code}
 145 --hReady :: Handle -> IO Bool
 146 hReady h = hWaitForInput h 0
 147
 148 --hWaitForInput :: Handle -> Int -> IO Bool
 149 hWaitForInput handle nsecs = do
 150     htype <- readHandle handle
 151     case htype of
 152       ErrorHandle ioError -> do
 153           writeHandle handle htype
 154           fail ioError
 155       ClosedHandle -> do
 156           writeHandle handle htype
 157           ioe_closedHandle handle
 158       SemiClosedHandle _ _ -> do
 159           writeHandle handle htype
 160           ioe_closedHandle handle
 161       AppendHandle _ _ _ -> do
 162           writeHandle handle htype
 163           fail (IOError (Just handle) IllegalOperation
 164                 "handle is not open for reading")
 165       WriteHandle _ _ _ -> do
 166           writeHandle handle htype
 167           fail (IOError (Just handle) IllegalOperation
 168                 "handle is not open for reading")
 169       other -> do
 170           rc <- _ccall_ inputReady (filePtr other) nsecs
 171           writeHandle handle (markHandle htype)
 172           case rc of
 173             0 -> return False
 174             1 -> return True
 175             _ -> constructErrorAndFail "hWaitForInput"
 176 \end{code}
 177
 178 Computation $hGetChar hdl$ reads the next character from handle
 179 {\em hdl}, blocking until a character is available.
 180
 181 \begin{code}
 182 --hGetChar :: Handle -> IO Char
 183
 184 hGetChar handle = do
 185     htype <- readHandle handle
 186     case htype of
 187       ErrorHandle ioError ->
 188           writeHandle handle htype                  >>
 189           fail ioError
 190       ClosedHandle ->
 191           writeHandle handle htype                  >>
 192           ioe_closedHandle handle
 193       SemiClosedHandle _ _ ->
 194           writeHandle handle htype                  >>
 195           ioe_closedHandle handle
 196       AppendHandle _ _ _ ->
 197           writeHandle handle htype                  >>
 198           fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
 199       WriteHandle _ _ _ ->
 200           writeHandle handle htype                  >>
 201           fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
 202       other -> do
 203           intc <- _ccall_ fileGetc (filePtr other)
 204           writeHandle handle (markHandle htype)
 205           if intc /= ``EOF'' then
 206               return (chr intc)
 207            else
 208               constructErrorAndFail "hGetChar"
 209
 210 hGetLine :: Handle -> IO String
 211 hGetLine h =
 212  hGetChar h >>= \ c ->
 213  if c == '\n' then
 214     return ""
 215  else
 216     hGetLine h >>= \ s -> return (c:s)
 217 \end{code}
 218
 219 Computation $hLookahead hdl$ returns the next character from handle
 220 {\em hdl} without removing it from the input buffer, blocking until a
 221 character is available.
 222
 223 \begin{code}
 224 --hLookAhead :: Handle -> IO Char
 225
 226 hLookAhead handle =
 227     readHandle handle                               >>= \ htype ->
 228     case htype of
 229       ErrorHandle ioError ->
 230           writeHandle handle htype                  >>
 231           fail ioError
 232       ClosedHandle ->
 233           writeHandle handle htype                  >>
 234           ioe_closedHandle handle
 235       SemiClosedHandle _ _ ->
 236           writeHandle handle htype                  >>
 237           ioe_closedHandle handle
 238       AppendHandle _ _ _ ->
 239           writeHandle handle htype                  >>
 240           fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
 241       WriteHandle _ _ _ ->
 242           writeHandle handle htype                  >>
 243           fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
 244       other -> do
 245           intc <- _ccall_ fileLookAhead (filePtr other)
 246           writeHandle handle (markHandle htype)
 247           if intc /= ``EOF'' then
 248               return (chr intc)
 249            else
 250               constructErrorAndFail "hLookAhead"
 251 \end{code}
 252
 253
 254 %*********************************************************
 255 %*                                                      *
 256 \subsection{Getting the entire contents of a handle}
 257 %*                                                      *
 258 %*********************************************************
 259
 260 Computation $hGetContents hdl$ returns the list of characters
 261 corresponding to the unread portion of the channel or file managed by
 262 {\em hdl}, which is made semi-closed.
 263
 264 \begin{code}
 265 --hGetContents :: Handle -> IO String
 266
 267 hGetContents handle =
 268     readHandle handle                               >>= \ htype ->
 269     case htype of
 270       ErrorHandle ioError ->
 271           writeHandle handle htype                  >>
 272           fail ioError
 273       ClosedHandle ->
 274           writeHandle handle htype                  >>
 275           ioe_closedHandle handle
 276       SemiClosedHandle _ _ ->
 277           writeHandle handle htype                  >>
 278           ioe_closedHandle handle
 279       AppendHandle _ _ _ ->
 280           writeHandle handle htype                  >>
 281           fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
 282       WriteHandle _ _ _ ->
 283           writeHandle handle htype                  >>
 284           fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
 285       other ->
 286           {-
 287              To avoid introducing an extra layer of buffering here,
 288              we provide three lazy read methods, based on character,
 289              line, and block buffering.
 290           -}
 291           getBufferMode other   >>= \ other ->
 292           case (bufferMode other) of
 293             Just LineBuffering ->
 294                 allocBuf Nothing                    >>= \ buf_info ->
 295                 writeHandle handle (SemiClosedHandle (filePtr other) buf_info)
 296                                                     >>
 297                 unsafeInterleaveIO (lazyReadLine handle)
 298                                                     >>= \ contents ->
 299                 return contents
 300
 301             Just (BlockBuffering size) ->
 302                 allocBuf size                       >>= \ buf_info ->
 303                 writeHandle handle (SemiClosedHandle (filePtr other) buf_info)
 304                                                     >>
 305                 unsafeInterleaveIO (lazyReadBlock handle)
 306                                                     >>= \ contents ->
 307                 return contents
 308             _ -> -- Nothing is treated pessimistically as NoBuffering
 309                 writeHandle handle (SemiClosedHandle (filePtr other) (``NULL'', 0))
 310                                                     >>
 311                 unsafeInterleaveIO (lazyReadChar handle) >>= \ contents ->
 312                 return contents
 313   where
 314     allocBuf :: Maybe Int -> IO (Addr, Int)
 315     allocBuf msize =
 316         _ccall_ malloc size                         >>= \ buf ->
 317         if buf /= ``NULL'' then
 318             return (buf, size)
 319         else
 320             fail (IOError Nothing ResourceExhausted "not enough virtual memory")
 321       where
 322         size =
 323             case msize of
 324               Just x -> x
 325               Nothing -> ``BUFSIZ''
 326 \end{code}
 327
 328 Note that someone may yank our handle out from under us, and then re-use
 329 the same FILE * for something else.  Therefore, we have to re-examine the
 330 handle every time through.
 331
 332 \begin{code}
 333 lazyReadBlock :: Handle -> IO String
 334 lazyReadLine  :: Handle -> IO String
 335 lazyReadChar  :: Handle -> IO String
 336
 337 lazyReadBlock handle =
 338     readHandle handle                             >>= \ htype ->
 339     case htype of
 340       -- There cannae be an ErrorHandle here
 341       ClosedHandle ->
 342           writeHandle handle htype                  >>
 343           return ""
 344       SemiClosedHandle fp (buf, size) ->
 345           _ccall_ readBlock buf fp size             >>= \ bytes ->
 346           (if bytes <= 0
 347           then return ""
 348           else stToIO (unpackNBytesST buf bytes))   >>= \ some ->
 349           if bytes < 0 then
 350               _ccall_ free buf                      >>= \ () ->
 351               _ccall_ closeFile fp                  >>
 352 #ifndef __PARALLEL_HASKELL__
 353               writeForeignObj fp ``NULL''           >>
 354               writeHandle handle (SemiClosedHandle fp (``NULL'', 0)) >>
 355 #else
 356               writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0)) >>
 357 #endif
 358               return some
 359           else
 360               writeHandle handle htype      >>
 361               unsafeInterleaveIO (lazyReadBlock handle)  >>= \ more ->
 362               return (some ++ more)
 363
 364 lazyReadLine handle =
 365     readHandle handle                               >>= \ htype ->
 366     case htype of
 367       -- There cannae be an ErrorHandle here
 368       ClosedHandle ->
 369           writeHandle handle htype >>
 370           return ""
 371       SemiClosedHandle fp (buf, size) ->
 372           _ccall_ readLine buf fp size              >>= \ bytes ->
 373           (if bytes <= 0
 374           then return ""
 375           else stToIO (unpackNBytesST buf bytes))   >>= \ some ->
 376           if bytes < 0 then
 377               _ccall_ free buf                      >>= \ () ->
 378               _ccall_ closeFile fp                  >>
 379 #ifndef __PARALLEL_HASKELL__
 380               writeForeignObj fp ``NULL''           >>
 381               writeHandle handle (SemiClosedHandle fp (``NULL'', 0)) >>
 382 #else
 383               writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0)) >>
 384 #endif
 385               return some
 386           else
 387               writeHandle handle htype      >>
 388               unsafeInterleaveIO (lazyReadLine handle)
 389                                                     >>= \ more ->
 390               return (some ++ more)
 391
 392 lazyReadChar handle =
 393     readHandle handle                               >>= \ htype ->
 394     case htype of
 395       -- There cannae be an ErrorHandle here
 396       ClosedHandle ->
 397           writeHandle handle htype                  >>
 398           return ""
 399       SemiClosedHandle fp buf_info ->
 400           _ccall_ readChar fp                       >>= \ char ->
 401           if char == ``EOF'' then
 402               _ccall_ closeFile fp                  >>
 403 #ifndef __PARALLEL_HASKELL__
 404               writeForeignObj fp ``NULL''           >>
 405               writeHandle handle (SemiClosedHandle fp (``NULL'', 0)) >>
 406 #else
 407               writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0)) >>
 408 #endif
 409               return ""
 410           else
 411               writeHandle handle htype              >>
 412               unsafeInterleaveIO (lazyReadChar handle) >>= \ more ->
 413               return (chr char : more)
 414
 415 \end{code}
 416
 417
 418 %*********************************************************
 419 %*                                                      *
 420 \subsection{Simple output functions}
 421 %*                                                      *
 422 %*********************************************************
 423
 424 Computation $hPutChar hdl c$ writes the character {\em c} to the file
 425 or channel managed by {\em hdl}.  Characters may be buffered if
 426 buffering is enabled for {\em hdl}.
 427
 428 \begin{code}
 429 --hPutChar :: Handle -> Char -> IO ()
 430
 431 hPutChar handle c =
 432     readHandle handle                               >>= \ htype ->
 433     case htype of
 434       ErrorHandle ioError ->
 435           writeHandle handle htype                  >>
 436           fail ioError
 437       ClosedHandle ->
 438           writeHandle handle htype                  >>
 439           ioe_closedHandle handle
 440       SemiClosedHandle _ _ ->
 441           writeHandle handle htype                  >>
 442           ioe_closedHandle handle
 443       ReadHandle _ _ _ ->
 444           writeHandle handle htype                  >>
 445           fail (IOError (Just handle) IllegalOperation "handle is not open for writing")
 446       other ->
 447           _ccall_ filePutc (filePtr other) (ord c) >>= \ rc ->
 448           writeHandle handle (markHandle htype)   >>
 449           if rc == 0 then
 450               return ()
 451           else
 452               constructErrorAndFail "hPutChar"
 453 \end{code}
 454
 455 Computation $hPutStr hdl s$ writes the string {\em s} to the file or
 456 channel managed by {\em hdl}.
 457
 458 \begin{code}
 459 --hPutStr :: Handle -> String -> IO ()
 460
 461 hPutStr handle str =
 462     readHandle handle                               >>= \ htype ->
 463     case htype of
 464       ErrorHandle ioError ->
 465           writeHandle handle htype                  >>
 466           fail ioError
 467       ClosedHandle ->
 468           writeHandle handle htype                  >>
 469           ioe_closedHandle handle
 470       SemiClosedHandle _ _ ->
 471           writeHandle handle htype                  >>
 472           ioe_closedHandle handle
 473       ReadHandle _ _ _ ->
 474           writeHandle handle htype                  >>
 475           fail (IOError (Just handle) IllegalOperation "handle is not open for writing")
 476       other ->
 477           {-
 478            The code below is not correct for line-buffered terminal streams,
 479            as the output stream is not flushed when terminal input is requested
 480            again, just upon seeing a newline character. A temporary fix for the
 481            most common line-buffered output stream, stdout, is to assume the
 482            buffering it was given when created (no buffering). This is not
 483            as bad as it looks, since stdio buffering sits underneath this.
 484
 485            ToDo: fix me
 486           -}
 487           getBufferMode other                       >>= \ other ->
 488           (case bufferMode other of
 489             Just LineBuffering ->
 490                 writeChars (filePtr other) str
 491                 --writeLines (filePtr other) str
 492             Just (BlockBuffering (Just size)) ->
 493                 writeBlocks (filePtr other) size str
 494             Just (BlockBuffering Nothing) ->
 495                 writeBlocks (filePtr other) ``BUFSIZ'' str
 496             _ -> -- Nothing is treated pessimistically as NoBuffering
 497                 writeChars (filePtr other) str
 498           )                                         >>= \ success ->
 499           writeHandle handle (markHandle other) >>
 500           if success then
 501               return ()
 502           else
 503               constructErrorAndFail "hPutStr"
 504   where
 505 #ifndef __PARALLEL_HASKELL__
 506     writeLines :: ForeignObj -> String -> IO Bool
 507 #else
 508     writeLines :: Addr -> String -> IO Bool
 509 #endif
 510     writeLines = writeChunks ``BUFSIZ'' True
 511
 512 #ifndef __PARALLEL_HASKELL__
 513     writeBlocks :: ForeignObj -> Int -> String -> IO Bool
 514 #else
 515     writeBlocks :: Addr -> Int -> String -> IO Bool
 516 #endif
 517     writeBlocks fp size s = writeChunks size False fp s
 518
 519     {-
 520       The breaking up of output into lines along \n boundaries
 521       works fine as long as there are newlines to split by.
 522       Avoid the splitting up into lines alltogether (doesn't work
 523       for overly long lines like the stuff that showsPrec instances
 524       normally return). Instead, we split them up into fixed size
 525       chunks before blasting them off to the Real World.
 526
 527       Hacked to avoid multiple passes over the strings - unsightly, but
 528       a whole lot quicker. -- SOF 3/96
 529     -}
 530
 531 #ifndef __PARALLEL_HASKELL__
 532     writeChunks :: Int -> Bool -> ForeignObj -> String -> IO Bool
 533 #else
 534     writeChunks :: Int -> Bool -> Addr -> String -> IO Bool
 535 #endif
 536     writeChunks (I# bufLen) chopOnNewLine fp s =
 537      stToIO (newCharArray (0,I# bufLen)) >>= \ arr@(MutableByteArray _ arr#) ->
 538      let
 539       write_char :: MutableByteArray# RealWorld -> Int# -> Char# -> IO ()
 540       write_char arr# n x = IO $ \ s# ->
 541           case (writeCharArray# arr# n x s#) of { s1# ->
 542           IOok s1# () }
 543
 544       shoveString :: Int# -> [Char] -> IO Bool
 545       shoveString n ls =
 546        case ls of
 547          [] ->
 548            if n ==# 0# then
 549               return True
 550            else
 551              _ccall_ writeFile arr fp (I# n) >>= \rc ->
 552              return (rc==0)
 553
 554          ((C# x):xs) ->
 555            write_char arr# n x  >>
 556
 557            {- Flushing lines - should we bother? Yes, for line-buffered output. -}
 558            if n ==# bufLen || (chopOnNewLine && (x `eqChar#` '\n'#)) then
 559               _ccall_ writeFile arr fp (I# (n +# 1#)) >>= \ rc ->
 560               if rc == 0 then
 561                  shoveString 0# xs
 562                else
 563                  return False
 564             else
 565                shoveString (n +# 1#) xs
 566      in
 567      shoveString 0# s
 568
 569 #ifndef __PARALLEL_HASKELL__
 570     writeChars :: ForeignObj -> String -> IO Bool
 571 #else
 572     writeChars :: Addr -> String -> IO Bool
 573 #endif
 574     writeChars fp "" = return True
 575     writeChars fp (c:cs) =
 576         _ccall_ filePutc fp (ord c) >>= \ rc ->
 577         if rc == 0 then
 578             writeChars fp cs
 579         else
 580             return False
 581 \end{code}
 582
 583 Computation $hPrint hdl t$ writes the string representation of {\em t}
 584 given by the $shows$ function to the file or channel managed by {\em
 585 hdl}.
 586
 587 SOF 2/97: Seem to have disappeared in 1.4 libs.
 588
 589 \begin{code}
 590 --hPrint :: Show a => Handle -> a -> IO ()
 591 hPrint hdl = hPutStr hdl . show
 592 \end{code}
 593
 594 Derived action @hPutStrLn hdl str@ writes the string \tr{str} to
 595 the handle \tr{hdl}, adding a newline at the end.
 596
 597 \begin{code}
 598 --hPutStrLn :: Handle -> String -> IO ()
 599 hPutStrLn hndl str = do
 600  hPutStr  hndl str
 601  hPutChar hndl '\n'
 602
 603 \end{code}
 604
 605
 606 %*********************************************************
 607 %*                                                      *
 608 \subsection{Try and bracket}
 609 %*                                                      *
 610 %*********************************************************
 611
 612 The construct $try comp$ exposes errors which occur within a
 613 computation, and which are not fully handled.  It always succeeds.
 614
 615 \begin{code}
 616 try            :: IO a -> IO (Either IOError a)
 617 try f          =  catch (do r <- f
 618                             return (Right r))
 619                         (return . Left)
 620
 621 bracket        :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
 622 bracket before after m = do
 623         x  <- before
 624         rs <- try (m x)
 625         after x
 626         case rs of
 627            Right r -> return r
 628            Left  e -> fail e
 629
 630 -- variant of the above where middle computation doesn't want x
 631 bracket_        :: IO a -> (a -> IO b) -> IO c -> IO c
 632 bracket_ before after m = do
 633          x  <- before
 634          rs <- try m
 635          after x
 636          case rs of
 637             Right r -> return r
 638             Left  e -> fail e
 639 \end{code}
 640