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