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