ghc/lib/std/IO.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1998
   3 %
   4 \section[IO]{Module @IO@}
   5
   6 Implementation of the standard Haskell IO interface, see
   7 @http://haskell.org/onlinelibrary/io.html@ for the official
   8 definition.
   9
  10 \begin{code}
  11 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
  12
  13 #ifndef BODY /* Hugs just includes this in PreludeBuiltin so no header needed */
  14 module IO (
  15     Handle,             -- abstract, instance of: Eq, Show.
  16     HandlePosn(..),     -- abstract, instance of: Eq, Show.
  17
  18     IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),
  19     BufferMode(NoBuffering,LineBuffering,BlockBuffering),
  20     SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
  21
  22     stdin, stdout, stderr,   -- :: Handle
  23
  24     openFile,                  -- :: FilePath -> IOMode -> IO Handle
  25     hClose,                    -- :: Handle -> IO ()
  26     hFileSize,                 -- :: Handle -> IO Integer
  27     hIsEOF,                    -- :: Handle -> IO Bool
  28     isEOF,                     -- :: IO Bool
  29
  30     hSetBuffering,             -- :: Handle -> BufferMode -> IO ()
  31     hGetBuffering,             -- :: Handle -> IO BufferMode
  32     hFlush,                    -- :: Handle -> IO ()
  33     hGetPosn,                  -- :: Handle -> IO HandlePosn
  34     hSetPosn,                  -- :: Handle -> HandlePosn -> IO ()
  35     hSeek,                     -- :: Handle -> SeekMode -> Integer -> IO ()
  36     hWaitForInput,             -- :: Handle -> Int -> IO Bool
  37     hReady,                    -- :: Handle -> IO Bool
  38     hGetChar,                  -- :: Handle -> IO Char
  39     hGetLine,                  -- :: Handle -> IO [Char]
  40     hLookAhead,                -- :: Handle -> IO Char
  41     hGetContents,              -- :: Handle -> IO [Char]
  42     hPutChar,                  -- :: Handle -> Char -> IO ()
  43     hPutStr,                   -- :: Handle -> [Char] -> IO ()
  44     hPutStrLn,                 -- :: Handle -> [Char] -> IO ()
  45     hPrint,                    -- :: Show a => Handle -> a -> IO ()
  46     hIsOpen, hIsClosed,        -- :: Handle -> IO Bool
  47     hIsReadable, hIsWritable,  -- :: Handle -> IO Bool
  48     hIsSeekable,               -- :: Handle -> IO Bool
  49
  50     isAlreadyExistsError, isDoesNotExistError,  -- :: IOError -> Bool
  51     isAlreadyInUseError, isFullError,
  52     isEOFError, isIllegalOperation,
  53     isPermissionError, isUserError,
  54
  55     ioeGetErrorString,         -- :: IOError -> String
  56     ioeGetHandle,              -- :: IOError -> Maybe Handle
  57     ioeGetFileName,            -- :: IOError -> Maybe FilePath
  58
  59     try,                       -- :: IO a -> IO (Either IOError a)
  60     bracket,                   -- :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
  61     bracket_,                  -- :: IO a -> (a -> IO b) -> IO c -> IO c
  62
  63     -- Non-standard extension (but will hopefully become standard with 1.5) is
  64     -- to export the Prelude io functions via IO (in addition to exporting them
  65     -- from the prelude...for now.)
  66     IO,
  67     FilePath,                  -- :: String
  68     IOError,
  69     ioError,                   -- :: IOError -> IO a
  70     userError,                 -- :: String  -> IOError
  71     catch,                     -- :: IO a    -> (IOError -> IO a) -> IO a
  72     interact,                  -- :: (String -> String) -> IO ()
  73
  74     putChar,                   -- :: Char   -> IO ()
  75     putStr,                    -- :: String -> IO ()
  76     putStrLn,                  -- :: String -> IO ()
  77     print,                     -- :: Show a => a -> IO ()
  78     getChar,                   -- :: IO Char
  79     getLine,                   -- :: IO String
  80     getContents,               -- :: IO String
  81     readFile,                  -- :: FilePath -> IO String
  82     writeFile,                 -- :: FilePath -> String -> IO ()
  83     appendFile,                -- :: FilePath -> String -> IO ()
  84     readIO,                    -- :: Read a => String -> IO a
  85     readLn,                    -- :: Read a => IO a
  86
  87     -- extensions
  88     hPutBuf,
  89 #ifndef __HUGS__
  90     hPutBufBA,
  91 #endif
  92     slurpFile
  93
  94   ) where
  95
  96 #ifdef __HUGS__
  97
  98 import PreludeBuiltin
  99
 100 #else
 101
 102 --import PrelST
 103 import PrelBase
 104
 105 import PrelIOBase
 106 import PrelHandle               -- much of the real stuff is in here
 107
 108 import PrelRead         ( readParen, Read(..), reads, lex,
 109                           readIO
 110                         )
 111 --import PrelNum                ( toInteger )
 112 import PrelBounded      ()  -- Bounded Int instance.
 113 import PrelEither       ( Either(..) )
 114 import PrelAddr         ( Addr(..), nullAddr )
 115 import PrelArr          ( ByteArray )
 116 import PrelPack         ( unpackNBytesAccST )
 117 import PrelException    ( ioError, catch )
 118
 119 #ifndef __PARALLEL_HASKELL__
 120 import PrelForeign  ( ForeignObj )
 121 #endif
 122
 123 import Char             ( ord, chr )
 124
 125 #endif /* ndef __HUGS__ */
 126 #endif /* ndef BODY */
 127
 128 #ifndef HEAD
 129
 130 #ifdef __HUGS__
 131 #define cat2(x,y)  x/**/y
 132 #define CCALL(fun) cat2(prim_,fun)
 133 #define __CONCURRENT_HASKELL__
 134 #define stToIO id
 135 #define unpackNBytesAccST primUnpackCStringAcc
 136 #else
 137 #define CCALL(fun) _ccall_ fun
 138 #define ref_freeStdFileObject (``&freeStdFileObject''::Addr)
 139 #define ref_freeFileObject    (``&freeFileObject''::Addr)
 140 #define const_BUFSIZ ``BUFSIZ''
 141 #endif
 142
 143 \end{code}
 144
 145 Standard instances for @Handle@:
 146
 147 \begin{code}
 148 instance Eq IOError where
 149   (IOError h1 e1 loc1 str1) == (IOError h2 e2 loc2 str2) =
 150     e1==e2 && str1==str2 && h1==h2 && loc1 == loc2
 151
 152 instance Eq Handle where
 153  (Handle h1) == (Handle h2) = h1 == h2
 154
 155 --Type declared in IOHandle, instance here because it depends on Eq.Handle
 156 instance Eq HandlePosn where
 157     (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
 158
 159 -- Type declared in IOBase, instance here because it
 160 -- depends on PrelRead.(Read Maybe) instance.
 161 instance Read BufferMode where
 162     readsPrec _ =
 163       readParen False
 164         (\r ->  let lr = lex r
 165                 in
 166                 [(NoBuffering, rest)       | ("NoBuffering", rest) <- lr] ++
 167                 [(LineBuffering,rest)      | ("LineBuffering",rest) <- lr] ++
 168                 [(BlockBuffering mb,rest2) | ("BlockBuffering",rest1) <- lr,
 169                                              (mb, rest2) <- reads rest1])
 170
 171 \end{code}
 172
 173 %*********************************************************
 174 %*                                                      *
 175 \subsection{Simple input operations}
 176 %*                                                      *
 177 %*********************************************************
 178
 179 Computation @hReady hdl@ indicates whether at least
 180 one item is available for input from handle {\em hdl}.
 181
 182 @hWaitForInput@ is the generalisation, wait for \tr{n} milliseconds
 183 before deciding whether the Handle has run dry or not.
 184
 185 If @hWaitForInput@ finds anything in the Handle's buffer, it immediately returns.
 186 If not, it tries to read from the underlying OS handle. Notice that
 187 for buffered Handles connected to terminals this means waiting until a complete
 188 line is available.
 189
 190 \begin{code}
 191 hReady :: Handle -> IO Bool
 192 hReady h = hWaitForInput h 0
 193
 194 hWaitForInput :: Handle -> Int -> IO Bool
 195 hWaitForInput handle msecs =
 196     wantReadableHandle "hWaitForInput" handle $ \ handle_ -> do
 197     rc       <- CCALL(inputReady) (haFO__ handle_) (msecs::Int)     -- ConcHask: SAFE, won't block
 198     writeHandle handle handle_
 199     case (rc::Int) of
 200       0 -> return False
 201       1 -> return True
 202       _ -> constructErrorAndFail "hWaitForInput"
 203 \end{code}
 204
 205 @hGetChar hdl@ reads the next character from handle @hdl@,
 206 blocking until a character is available.
 207
 208 \begin{code}
 209 hGetChar :: Handle -> IO Char
 210 hGetChar handle =
 211     wantReadableHandle "hGetChar" handle $ \ handle_ -> do
 212     let fo = haFO__ handle_
 213     intc     <- mayBlock fo (CCALL(fileGetc) fo)  -- ConcHask: UNSAFE, may block
 214     writeHandle handle handle_
 215     if intc /= ((-1)::Int)
 216      then return (chr intc)
 217      else constructErrorAndFail "hGetChar"
 218
 219 hGetLine :: Handle -> IO String
 220 hGetLine h = do
 221   c <- hGetChar h
 222   if c == '\n'
 223    then return ""
 224    else do
 225      s <- hGetLine h
 226      return (c:s)
 227
 228 \end{code}
 229
 230 @hLookahead hdl@ returns the next character from handle @hdl@
 231 without removing it from the input buffer, blocking until a
 232 character is available.
 233
 234 \begin{code}
 235 hLookAhead :: Handle -> IO Char
 236 hLookAhead handle = do
 237     wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
 238     let fo = haFO__ handle_
 239     intc    <- mayBlock fo (CCALL(fileLookAhead) fo)  -- ConcHask: UNSAFE, may block
 240     writeHandle handle handle_
 241     if intc /= (-1)
 242      then return (chr intc)
 243      else constructErrorAndFail "hLookAhead"
 244
 245 \end{code}
 246
 247
 248 %*********************************************************
 249 %*                                                      *
 250 \subsection{Getting the entire contents of a handle}
 251 %*                                                      *
 252 %*********************************************************
 253
 254 @hGetContents hdl@ returns the list of characters corresponding
 255 to the unread portion of the channel or file managed by @hdl@,
 256 which is made semi-closed.
 257
 258 \begin{code}
 259 hGetContents :: Handle -> IO String
 260 hGetContents handle =
 261     wantReadableHandle "hGetContents" handle $ \ handle_ -> do
 262       {-
 263         To avoid introducing an extra layer of buffering here,
 264         we provide three lazy read methods, based on character,
 265         line, and block buffering.
 266       -}
 267     writeHandle handle (handle_{ haType__ = SemiClosedHandle })
 268     case (haBufferMode__ handle_) of
 269      LineBuffering    -> unsafeInterleaveIO (lazyReadLine handle (haFO__ handle_))
 270      BlockBuffering _ -> unsafeInterleaveIO (lazyReadBlock handle (haFO__ handle_))
 271      NoBuffering      -> unsafeInterleaveIO (lazyReadChar handle (haFO__ handle_))
 272
 273 \end{code}
 274
 275 Note that someone may close the semi-closed handle (or change its buffering),
 276 so each these lazy read functions are pulled on, they have to check whether
 277 the handle has indeed been closed.
 278
 279 \begin{code}
 280 #ifndef __PARALLEL_HASKELL__
 281 lazyReadBlock :: Handle -> ForeignObj -> IO String
 282 lazyReadLine  :: Handle -> ForeignObj -> IO String
 283 lazyReadChar  :: Handle -> ForeignObj -> IO String
 284 #else
 285 lazyReadBlock :: Handle -> Addr -> IO String
 286 lazyReadLine  :: Handle -> Addr -> IO String
 287 lazyReadChar  :: Handle -> Addr -> IO String
 288 #endif
 289
 290 lazyReadBlock handle fo = do
 291    buf   <- CCALL(getBufStart) fo (0::Int)
 292    bytes <- mayBlock fo (CCALL(readBlock) fo) -- ConcHask: UNSAFE, may block.
 293    case (bytes::Int) of
 294      -3 -> -- buffering has been turned off, use lazyReadChar instead
 295            lazyReadChar handle fo
 296      -2 -> return ""
 297      -1 -> -- an error occurred, close the handle
 298           withHandle handle $ \ handle_ -> do
 299           CCALL(closeFile) (haFO__ handle_) (0::Int){-don't bother flushing-}  -- ConcHask: SAFE, won't block.
 300           writeHandle handle (handle_ { haType__    = ClosedHandle,
 301                                         haFO__      = nullFile__ })
 302           return ""
 303      _ -> do
 304       more <- unsafeInterleaveIO (lazyReadBlock handle fo)
 305       stToIO (unpackNBytesAccST buf bytes more)
 306
 307 lazyReadLine handle fo = do
 308      bytes <- mayBlock fo (CCALL(readLine) fo)   -- ConcHask: UNSAFE, may block.
 309      case (bytes::Int) of
 310        -3 -> -- buffering has been turned off, use lazyReadChar instead
 311              lazyReadChar handle fo
 312        -2 -> return "" -- handle closed by someone else, stop reading.
 313        -1 -> -- an error occurred, close the handle
 314              withHandle handle $ \ handle_ -> do
 315              CCALL(closeFile) (haFO__ handle_) (0::Int){- don't bother flushing-}  -- ConcHask: SAFE, won't block
 316              writeHandle handle (handle_ { haType__    = ClosedHandle,
 317                                            haFO__      = nullFile__ })
 318              return ""
 319        _ -> do
 320           more <- unsafeInterleaveIO (lazyReadLine handle fo)
 321           buf  <- CCALL(getBufStart) fo bytes  -- ConcHask: won't block
 322           stToIO (unpackNBytesAccST buf bytes more)
 323
 324 lazyReadChar handle fo = do
 325     char <- mayBlock fo (CCALL(readChar) fo)   -- ConcHask: UNSAFE, may block.
 326     case (char::Int) of
 327       -4 -> -- buffering is now block-buffered, use lazyReadBlock instead
 328             lazyReadBlock handle fo
 329
 330       -3 -> -- buffering is now line-buffered, use lazyReadLine instead
 331             lazyReadLine handle fo
 332       -2 -> return ""
 333       -1 -> -- error, silently close handle.
 334          withHandle handle $ \ handle_ -> do
 335          CCALL(closeFile) (haFO__ handle_) (0::Int){-don't bother flusing-}  -- ConcHask: SAFE, won't block
 336          writeHandle handle (handle_{ haType__  = ClosedHandle,
 337                                       haFO__    = nullFile__ })
 338          return ""
 339       _ -> do
 340          more <- unsafeInterleaveIO (lazyReadChar handle fo)
 341          return (chr char : more)
 342
 343 \end{code}
 344
 345
 346 %*********************************************************
 347 %*                                                      *
 348 \subsection{Simple output functions}
 349 %*                                                      *
 350 %*********************************************************
 351
 352 @hPutChar hdl ch@ writes the character @ch@ to the file
 353 or channel managed by @hdl@.  Characters may be buffered if
 354 buffering is enabled for @hdl@
 355
 356 \begin{code}
 357 hPutChar :: Handle -> Char -> IO ()
 358 hPutChar handle c =
 359     wantWriteableHandle "hPutChar" handle $ \ handle_  -> do
 360     let fo = haFO__ handle_
 361     flushConnectedBuf fo
 362     rc       <- mayBlock fo (CCALL(filePutc) fo c)   -- ConcHask: UNSAFE, may block.
 363     writeHandle handle handle_
 364     if rc == 0
 365      then return ()
 366      else constructErrorAndFail "hPutChar"
 367
 368 \end{code}
 369
 370 @hPutStr hdl s@ writes the string @s@ to the file or
 371 channel managed by @hdl@, buffering the output if needs be.
 372
 373 \begin{code}
 374 hPutStr :: Handle -> String -> IO ()
 375 hPutStr handle str =
 376     wantWriteableHandle "hPutStr" handle $ \ handle_ -> do
 377     let fo = haFO__ handle_
 378     flushConnectedBuf fo
 379     case haBufferMode__ handle_ of
 380        LineBuffering -> do
 381             buf <- CCALL(getWriteableBuf) fo
 382             pos <- CCALL(getBufWPtr) fo
 383             bsz <- CCALL(getBufSize) fo
 384             writeLines fo buf bsz pos str
 385        BlockBuffering _ -> do
 386             buf <- CCALL(getWriteableBuf) fo
 387             pos <- CCALL(getBufWPtr) fo
 388             bsz <- CCALL(getBufSize) fo
 389             writeBlocks fo buf bsz pos str
 390        NoBuffering -> do
 391             writeChars fo str
 392     writeHandle handle handle_
 393
 394 \end{code}
 395
 396 Going across the border between Haskell and C is relatively costly,
 397 so for block writes we pack the character strings on the Haskell-side
 398 before passing the external write routine a pointer to the buffer.
 399
 400 \begin{code}
 401 #ifdef __HUGS__
 402
 403 #ifdef __CONCURRENT_HASKELL__
 404 /* See comment in shoveString below for explanation */
 405 #warning delayed update of buffer disnae work with killThread
 406 #endif
 407
 408 #ifndef __PARALLEL_HASKELL__
 409 writeLines :: ForeignObj -> Addr -> Int -> Int -> String -> IO ()
 410 #else
 411 writeLines :: Addr -> Addr -> Int -> Int -> String -> IO ()
 412 #endif
 413 writeLines obj buf bufLen initPos s =
 414   let
 415    shoveString :: Int -> [Char] -> IO ()
 416    shoveString n ls =
 417      case ls of
 418       [] ->
 419         if n == 0 then
 420           CCALL(setBufWPtr) obj (0::Int)
 421         else do
 422           {-
 423             At the end of a buffer write, update the buffer position
 424             in the underlying file object, so that if the handle
 425             is subsequently dropped by the program, the whole
 426             buffer will be properly flushed.
 427
 428             There's one case where this delayed up-date of the buffer
 429             position can go wrong: if a thread is killed, it might be
 430             in the middle of filling up a buffer, with the result that
 431             the partial buffer update is lost upon finalisation. Not
 432             that killing of threads is supported at the moment.
 433
 434           -}
 435           CCALL(setBufWPtr) obj n
 436
 437       (x:xs) -> do
 438         primWriteCharOffAddr buf n x
 439           {- Flushing on buffer exhaustion or newlines (even if it isn't the last one) -}
 440         if n == bufLen || x == '\n'
 441          then do
 442            rc <-  mayBlock obj (CCALL(writeFileObject) obj (n + 1))  -- ConcHask: UNSAFE, may block.
 443            if rc == 0
 444             then shoveString 0 xs
 445             else constructErrorAndFail "writeLines"
 446          else
 447            shoveString (n + 1) xs
 448   in
 449   shoveString initPos s
 450 #else /* ndef __HUGS__ */
 451 #ifndef __PARALLEL_HASKELL__
 452 writeLines :: ForeignObj -> Addr -> Int -> Int -> String -> IO ()
 453 #else
 454 writeLines :: Addr -> Addr -> Int -> Int -> String -> IO ()
 455 #endif
 456 writeLines obj buf (I# bufLen) (I# initPos#) s =
 457   let
 458    write_char :: Addr -> Int# -> Char# -> IO ()
 459    write_char (A# buf#) n# c# =
 460       IO $ \ s# ->
 461       case (writeCharOffAddr# buf# n# c# s#) of s2# -> (# s2#, () #)
 462
 463    shoveString :: Int# -> [Char] -> IO ()
 464    shoveString n ls =
 465      case ls of
 466       [] ->
 467         if n ==# 0# then
 468           CCALL(setBufWPtr) obj (0::Int)
 469         else do
 470           {-
 471             At the end of a buffer write, update the buffer position
 472             in the underlying file object, so that if the handle
 473             is subsequently dropped by the program, the whole
 474             buffer will be properly flushed.
 475
 476             There's one case where this delayed up-date of the buffer
 477             position can go wrong: if a thread is killed, it might be
 478             in the middle of filling up a buffer, with the result that
 479             the partial buffer update is lost upon finalisation. Not
 480             that killing of threads is supported at the moment.
 481
 482           -}
 483           CCALL(setBufWPtr) obj (I# n)
 484
 485       ((C# x):xs) -> do
 486         write_char buf n x
 487           {- Flushing on buffer exhaustion or newlines (even if it isn't the last one) -}
 488         if n ==# bufLen || x `eqChar#` '\n'#
 489          then do
 490            rc <-  mayBlock obj (CCALL(writeFileObject) obj (I# (n +# 1#)))  -- ConcHask: UNSAFE, may block.
 491            if rc == 0
 492             then shoveString 0# xs
 493             else constructErrorAndFail "writeLines"
 494          else
 495            shoveString (n +# 1#) xs
 496   in
 497   shoveString initPos# s
 498 #endif /* ndef __HUGS__ */
 499
 500 #ifdef __HUGS__
 501 #ifndef __PARALLEL_HASKELL__
 502 writeBlocks :: ForeignObj -> Addr -> Int -> Int -> String -> IO ()
 503 #else
 504 writeBlocks :: Addr -> Addr -> Int -> Int -> String -> IO ()
 505 #endif
 506 writeBlocks obj buf bufLen initPos s =
 507   let
 508    shoveString :: Int -> [Char] -> IO ()
 509    shoveString n ls =
 510      case ls of
 511       [] ->
 512         if n == 0 then
 513           CCALL(setBufWPtr) obj (0::Int)
 514         else do
 515           {-
 516             At the end of a buffer write, update the buffer position
 517             in the underlying file object, so that if the handle
 518             is subsequently dropped by the program, the whole
 519             buffer will be properly flushed.
 520
 521             There's one case where this delayed up-date of the buffer
 522             position can go wrong: if a thread is killed, it might be
 523             in the middle of filling up a buffer, with the result that
 524             the partial buffer update is lost upon finalisation. However,
 525             by the time killThread is supported, Haskell finalisers are also
 526             likely to be in, which means the 'IOFileObject' hack can go
 527             alltogether.
 528
 529           -}
 530           CCALL(setBufWPtr) obj n
 531
 532       (x:xs) -> do
 533         primWriteCharOffAddr buf n x
 534         if n == bufLen
 535          then do
 536            rc <-  mayBlock obj (CCALL(writeFileObject) obj (n + 1))   -- ConcHask: UNSAFE, may block.
 537            if rc == 0
 538             then shoveString 0 xs
 539             else constructErrorAndFail "writeChunks"
 540          else
 541            shoveString (n + 1) xs
 542   in
 543   shoveString initPos s
 544 #else /* ndef __HUGS__ */
 545 #ifndef __PARALLEL_HASKELL__
 546 writeBlocks :: ForeignObj -> Addr -> Int -> Int -> String -> IO ()
 547 #else
 548 writeBlocks :: Addr -> Addr -> Int -> Int -> String -> IO ()
 549 #endif
 550 writeBlocks obj buf (I# bufLen) (I# initPos#) s =
 551   let
 552    write_char :: Addr -> Int# -> Char# -> IO ()
 553    write_char (A# buf#) n# c# =
 554       IO $ \ s# ->
 555       case (writeCharOffAddr# buf# n# c# s#) of s2# -> (# s2#, () #)
 556
 557    shoveString :: Int# -> [Char] -> IO ()
 558    shoveString n ls =
 559      case ls of
 560       [] ->
 561         if n ==# 0# then
 562           CCALL(setBufWPtr) obj (0::Int)
 563         else do
 564           {-
 565             At the end of a buffer write, update the buffer position
 566             in the underlying file object, so that if the handle
 567             is subsequently dropped by the program, the whole
 568             buffer will be properly flushed.
 569
 570             There's one case where this delayed up-date of the buffer
 571             position can go wrong: if a thread is killed, it might be
 572             in the middle of filling up a buffer, with the result that
 573             the partial buffer update is lost upon finalisation. However,
 574             by the time killThread is supported, Haskell finalisers are also
 575             likely to be in, which means the 'IOFileObject' hack can go
 576             alltogether.
 577
 578           -}
 579           CCALL(setBufWPtr) obj (I# n)
 580
 581       ((C# x):xs) -> do
 582         write_char buf n x
 583         if n ==# bufLen
 584          then do
 585            rc <-  mayBlock obj (CCALL(writeFileObject) obj (I# (n +# 1#)))   -- ConcHask: UNSAFE, may block.
 586            if rc == 0
 587             then shoveString 0# xs
 588             else constructErrorAndFail "writeChunks"
 589          else
 590            shoveString (n +# 1#) xs
 591   in
 592   shoveString initPos# s
 593 #endif /* ndef __HUGS__ */
 594
 595 #ifndef __PARALLEL_HASKELL__
 596 writeChars :: ForeignObj -> String -> IO ()
 597 #else
 598 writeChars :: Addr -> String -> IO ()
 599 #endif
 600 writeChars _fo ""    = return ()
 601 writeChars fo (c:cs) = do
 602   rc <- mayBlock fo (CCALL(filePutc) fo c)   -- ConcHask: UNSAFE, may block.
 603   if rc == 0
 604    then writeChars fo cs
 605    else constructErrorAndFail "writeChars"
 606
 607 \end{code}
 608
 609 Computation @hPrint hdl t@ writes the string representation of {\em t}
 610 given by the @shows@ function to the file or channel managed by {\em
 611 hdl}.
 612
 613 [ Seem to have disappeared from the 1.4 interface  - SOF 2/97 ]
 614
 615 \begin{code}
 616 hPrint :: Show a => Handle -> a -> IO ()
 617 hPrint hdl = hPutStrLn hdl . show
 618 \end{code}
 619
 620 Derived action @hPutStrLn hdl str@ writes the string \tr{str} to
 621 the handle \tr{hdl}, adding a newline at the end.
 622
 623 \begin{code}
 624 hPutStrLn :: Handle -> String -> IO ()
 625 hPutStrLn hndl str = do
 626  hPutStr  hndl str
 627  hPutChar hndl '\n'
 628
 629 \end{code}
 630
 631
 632 %*********************************************************
 633 %*                                                      *
 634 \subsection{Try and bracket}
 635 %*                                                      *
 636 %*********************************************************
 637
 638 The construct @try comp@ exposes errors which occur within a
 639 computation, and which are not fully handled.  It always succeeds.
 640
 641 \begin{code}
 642 try            :: IO a -> IO (Either IOError a)
 643 try f          =  catch (do r <- f
 644                             return (Right r))
 645                         (return . Left)
 646
 647 bracket        :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
 648 bracket before after m = do
 649         x  <- before
 650         rs <- try (m x)
 651         after x
 652         case rs of
 653            Right r -> return r
 654            Left  e -> ioError e
 655
 656 -- variant of the above where middle computation doesn't want x
 657 bracket_        :: IO a -> (a -> IO b) -> IO c -> IO c
 658 bracket_ before after m = do
 659          x  <- before
 660          rs <- try m
 661          after x
 662          case rs of
 663             Right r -> return r
 664             Left  e -> ioError e
 665 \end{code}
 666
 667 %*********************************************************
 668 %*                                                       *
 669 \subsection{Standard IO}
 670 %*                                                       *
 671 %*********************************************************
 672
 673 The Prelude has from Day 1 provided a collection of common
 674 IO functions. We define these here, but let the Prelude
 675 export them.
 676
 677 \begin{code}
 678 putChar         :: Char -> IO ()
 679 putChar c       =  hPutChar stdout c
 680
 681 putStr          :: String -> IO ()
 682 putStr s        =  hPutStr stdout s
 683
 684 putStrLn        :: String -> IO ()
 685 putStrLn s      =  do putStr s
 686                       putChar '\n'
 687
 688 print           :: Show a => a -> IO ()
 689 print x         =  putStrLn (show x)
 690
 691 getChar         :: IO Char
 692 getChar         =  hGetChar stdin
 693
 694 getLine         :: IO String
 695 getLine         =  hGetLine stdin
 696
 697 getContents     :: IO String
 698 getContents     =  hGetContents stdin
 699
 700 interact        ::  (String -> String) -> IO ()
 701 interact f      =   do s <- getContents
 702                        putStr (f s)
 703
 704 readFile        :: FilePath -> IO String
 705 readFile name   =  openFile name ReadMode >>= hGetContents
 706
 707 writeFile       :: FilePath -> String -> IO ()
 708 writeFile name str = do
 709     hdl <- openFile name WriteMode
 710     hPutStr hdl str
 711     hClose hdl
 712
 713 appendFile      :: FilePath -> String -> IO ()
 714 appendFile name str = do
 715     hdl <- openFile name AppendMode
 716     hPutStr hdl str
 717     hClose hdl
 718
 719 readLn          :: Read a => IO a
 720 readLn          =  do l <- getLine
 721                       r <- readIO l
 722                       return r
 723
 724 #endif /* ndef HEAD */
 725
 726 \end{code}