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     rc       <- mayBlock fo (_ccall_ filePutc fo (ord c))   -- ConcHask: UNSAFE, may block.
 333     writeHandle handle handle_
 334     if rc == 0
 335      then return ()
 336      else constructErrorAndFail "hPutChar"
 337
 338 \end{code}
 339
 340 @hPutStr hdl s@ writes the string @s@ to the file or
 341 channel managed by @hdl@, buffering the output if needs be.
 342
 343 \begin{code}
 344 hPutStr :: Handle -> String -> IO ()
 345 hPutStr handle str = do
 346     handle_ <- wantWriteableHandle "hPutStr" handle
 347     let fo = haFO__ handle_
 348     case haBufferMode__ handle_ of
 349        LineBuffering -> do
 350             buf <- _ccall_ getWriteableBuf fo
 351             pos <- _ccall_ getBufWPtr fo
 352             bsz <- _ccall_ getBufSize fo
 353             writeLines fo buf bsz pos str
 354        BlockBuffering _ -> do
 355             buf <- _ccall_ getWriteableBuf fo
 356             pos <- _ccall_ getBufWPtr fo
 357             bsz <- _ccall_ getBufSize fo
 358             writeBlocks fo buf bsz pos str
 359        NoBuffering -> do
 360             writeChars fo str
 361     writeHandle handle handle_
 362
 363 \end{code}
 364
 365 Going across the border between Haskell and C is relatively costly,
 366 so for block writes we pack the character strings on the Haskell-side
 367 before passing the external write routine a pointer to the buffer.
 368
 369 \begin{code}
 370
 371 #ifndef __PARALLEL_HASKELL__
 372 writeLines :: ForeignObj -> Addr -> Int -> Int -> String -> IO ()
 373 #else
 374 writeLines :: Addr -> Addr -> Int -> Int -> String -> IO ()
 375 #endif
 376 writeLines obj buf bf@(I# bufLen) (I# initPos#) s =
 377   let
 378    write_char :: Addr -> Int# -> Char# -> IO ()
 379    write_char (A# buf) n# c# =
 380       IO $ \ s# ->
 381       case (writeCharOffAddr# buf n# c# s#) of s2# -> IOok s2# ()
 382
 383    shoveString :: Int# -> [Char] -> IO ()
 384    shoveString n ls =
 385      case ls of
 386       [] ->
 387         if n ==# 0# then
 388           _ccall_ setBufWPtr obj (0::Int)
 389         else do
 390           {-
 391             At the end of a buffer write, update the buffer position
 392             in the underlying file object, so that if the handle
 393             is subsequently dropped by the program, the whole
 394             buffer will be properly flushed.
 395
 396             There's one case where this delayed up-date of the buffer
 397             position can go wrong: if a thread is killed, it might be
 398             in the middle of filling up a buffer, with the result that
 399             the partial buffer update is lost upon finalisation. Not
 400             that killing of threads is supported at the moment.
 401
 402           -}
 403           _ccall_ setBufWPtr obj (I# n)
 404
 405       ((C# x):xs) -> do
 406         write_char buf n x
 407           {- Flushing on buffer exhaustion or newlines (even if it isn't the last one) -}
 408         if n ==# bufLen || x `eqChar#` '\n'#
 409          then do
 410            rc <-  mayBlock obj (_ccall_ writeFileObject obj (I# (n +# 1#)))  -- ConcHask: UNSAFE, may block.
 411            if rc == 0
 412             then shoveString 0# xs
 413             else constructErrorAndFail "writeLines"
 414          else
 415            shoveString (n +# 1#) xs
 416   in
 417   shoveString initPos# s
 418
 419 #ifndef __PARALLEL_HASKELL__
 420 writeBlocks :: ForeignObj -> Addr -> Int -> Int -> String -> IO ()
 421 #else
 422 writeBlocks :: Addr -> Addr -> Int -> Int -> String -> IO ()
 423 #endif
 424 writeBlocks obj buf bf@(I# bufLen) (I# initPos#) s =
 425   let
 426    write_char :: Addr -> Int# -> Char# -> IO ()
 427    write_char (A# buf) n# c# =
 428       IO $ \ s# ->
 429       case (writeCharOffAddr# buf n# c# s#) of s2# -> IOok s2# ()
 430
 431    shoveString :: Int# -> [Char] -> IO ()
 432    shoveString n ls =
 433      case ls of
 434       [] ->
 435         if n ==# 0# then
 436           _ccall_ setBufWPtr obj (0::Int)
 437         else do
 438           {-
 439             At the end of a buffer write, update the buffer position
 440             in the underlying file object, so that if the handle
 441             is subsequently dropped by the program, the whole
 442             buffer will be properly flushed.
 443
 444             There's one case where this delayed up-date of the buffer
 445             position can go wrong: if a thread is killed, it might be
 446             in the middle of filling up a buffer, with the result that
 447             the partial buffer update is lost upon finalisation. However,
 448             by the time killThread is supported, Haskell finalisers are also
 449             likely to be in, which means the 'IOFileObject' hack can go
 450             alltogether.
 451
 452           -}
 453           _ccall_ setBufWPtr obj (I# n)
 454
 455       ((C# x):xs) -> do
 456         write_char buf n x
 457         if n ==# bufLen
 458          then do
 459            rc <-  mayBlock obj (_ccall_ writeFileObject obj (I# (n +# 1#)))   -- ConcHask: UNSAFE, may block.
 460            if rc == 0
 461             then shoveString 0# xs
 462             else constructErrorAndFail "writeChunks"
 463          else
 464            shoveString (n +# 1#) xs
 465   in
 466   shoveString initPos# s
 467
 468 #ifndef __PARALLEL_HASKELL__
 469 writeChars :: ForeignObj -> String -> IO ()
 470 #else
 471 writeChars :: Addr -> String -> IO ()
 472 #endif
 473 writeChars fo "" = return ()
 474 writeChars fo (c:cs) = do
 475   rc <- mayBlock fo (_ccall_ filePutc fo (ord c))   -- ConcHask: UNSAFE, may block.
 476   if rc == 0
 477    then writeChars fo cs
 478    else constructErrorAndFail "writeChars"
 479
 480 \end{code}
 481
 482 Computation @hPrint hdl t@ writes the string representation of {\em t}
 483 given by the @shows@ function to the file or channel managed by {\em
 484 hdl}.
 485
 486 [ Seem to have disappeared from the 1.4 interface  - SOF 2/97 ]
 487
 488 \begin{code}
 489 hPrint :: Show a => Handle -> a -> IO ()
 490 hPrint hdl = hPutStr hdl . show
 491 \end{code}
 492
 493 Derived action @hPutStrLn hdl str@ writes the string \tr{str} to
 494 the handle \tr{hdl}, adding a newline at the end.
 495
 496 \begin{code}
 497 hPutStrLn :: Handle -> String -> IO ()
 498 hPutStrLn hndl str = do
 499  hPutStr  hndl str
 500  hPutChar hndl '\n'
 501
 502 \end{code}
 503
 504
 505 %*********************************************************
 506 %*                                                      *
 507 \subsection{Try and bracket}
 508 %*                                                      *
 509 %*********************************************************
 510
 511 The construct @try comp@ exposes errors which occur within a
 512 computation, and which are not fully handled.  It always succeeds.
 513
 514 \begin{code}
 515 try            :: IO a -> IO (Either IOError a)
 516 try f          =  catch (do r <- f
 517                             return (Right r))
 518                         (return . Left)
 519
 520 bracket        :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
 521 bracket before after m = do
 522         x  <- before
 523         rs <- try (m x)
 524         after x
 525         case rs of
 526            Right r -> return r
 527            Left  e -> fail e
 528
 529 -- variant of the above where middle computation doesn't want x
 530 bracket_        :: IO a -> (a -> IO b) -> IO c -> IO c
 531 bracket_ before after m = do
 532          x  <- before
 533          rs <- try m
 534          after x
 535          case rs of
 536             Right r -> return r
 537             Left  e -> fail e
 538 \end{code}
 539
 540 %*********************************************************
 541 %*                                                       *
 542 \subsection{Standard IO}
 543 %*                                                       *
 544 %*********************************************************
 545
 546 The Prelude has from Day 1 provided a collection of common
 547 IO functions. We define these here, but let the Prelude
 548 export them.
 549
 550 \begin{code}
 551 putChar         :: Char -> IO ()
 552 putChar c       =  hPutChar stdout c
 553
 554 putStr          :: String -> IO ()
 555 putStr s        =  hPutStr stdout s
 556
 557 putStrLn        :: String -> IO ()
 558 putStrLn s      =  do putStr s
 559                       putChar '\n'
 560
 561 print           :: Show a => a -> IO ()
 562 print x         =  putStrLn (show x)
 563
 564 getChar         :: IO Char
 565 getChar         =  hGetChar stdin
 566
 567 getLine         :: IO String
 568 getLine         =  hGetLine stdin
 569
 570 getContents     :: IO String
 571 getContents     =  hGetContents stdin
 572
 573 interact        ::  (String -> String) -> IO ()
 574 interact f      =   do s <- getContents
 575                        putStr (f s)
 576
 577 readFile        :: FilePath -> IO String
 578 readFile name   =  openFile name ReadMode >>= hGetContents
 579
 580 writeFile       :: FilePath -> String -> IO ()
 581 writeFile name str = do
 582     hdl <- openFile name WriteMode
 583     hPutStr hdl str
 584     hClose hdl
 585
 586 appendFile      :: FilePath -> String -> IO ()
 587 appendFile name str = do
 588     hdl <- openFile name AppendMode
 589     hPutStr hdl str
 590     hClose hdl
 591
 592 readLn          :: Read a => IO a
 593 readLn          =  do l <- getLine
 594                       r <- readIO l
 595                       return r
 596 \end{code}