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