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