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