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