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