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