ghc/lib/required/IO.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4
   5 \section[IO]{Module @IO@}
   6
   7 \begin{code}
   8 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
   9
  10 module IO (
  11     Handle, HandlePosn,
  12
  13     IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),
  14     BufferMode(NoBuffering,LineBuffering,BlockBuffering),
  15     SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
  16
  17     stdin, stdout, stderr,
  18
  19     openFile, hClose,
  20     hFileSize, hIsEOF, isEOF,
  21     hSetBuffering, hGetBuffering, hFlush,
  22     hGetPosn, hSetPosn, hSeek,
  23     hReady, hGetChar, hLookAhead, hGetContents,
  24     hPutChar, hPutStr, hPutStrLn, hPrint,
  25     hIsOpen, hIsClosed, hIsReadable, hIsWritable, hIsSeekable,
  26
  27     isAlreadyExistsError, isDoesNotExistError, isAlreadyInUseError,
  28     isFullError, isEOFError,
  29     isIllegalOperation, isPermissionError, isUserError,
  30     ioeGetErrorString,
  31     ioeGetHandle, ioeGetFileName
  32   ) where
  33
  34 import Ix
  35 import STBase
  36 import IOBase
  37 import ArrBase          ( MutableByteArray(..), newCharArray )
  38 import IOHandle         -- much of the real stuff is in here
  39 import PackedString     ( nilPS, packCBytesST, unpackPS )
  40 import PrelBase
  41 import GHC
  42 import Foreign          ( makeForeignObj, writeForeignObj )
  43 \end{code}
  44
  45 %*********************************************************
  46 %*                                                      *
  47 \subsection{Signatures}
  48 %*                                                      *
  49 %*********************************************************
  50
  51 \begin{code}
  52 --IOHandle:hClose                :: Handle -> IO ()
  53 --IOHandle:hFileSize             :: Handle -> IO Integer
  54 --IOHandle:hFlush                :: Handle -> IO ()
  55 --IOHandle:hGetBuffering         :: Handle -> IO BufferMode
  56 hGetChar              :: Handle -> IO Char
  57 hGetContents          :: Handle -> IO String
  58 --IOHandle:hGetPosn              :: Handle -> IO HandlePosn
  59 --IOHandle:hIsClosed             :: Handle -> IO Bool
  60 --IOHandle:hIsEOF                :: Handle -> IO Bool
  61 --IOHandle:hIsOpen               :: Handle -> IO Bool
  62 --IOHandle:hIsReadable           :: Handle -> IO Bool
  63 --IOHandle:hIsSeekable           :: Handle -> IO Bool
  64 --IOHandle:hIsWritable           :: Handle -> IO Bool
  65 hLookAhead            :: Handle -> IO Char
  66 hPrint                :: Show a => Handle -> a -> IO ()
  67 hPutChar              :: Handle -> Char -> IO ()
  68 hPutStr               :: Handle -> String -> IO ()
  69 hPutStrLn             :: Handle -> String -> IO ()
  70 hReady                :: Handle -> IO Bool
  71 --IOHandle:hSeek                 :: Handle -> SeekMode -> Integer -> IO ()
  72 --IOHandle:hSetBuffering         :: Handle -> BufferMode -> IO ()
  73 --IOHandle:hSetPosn              :: HandlePosn -> IO ()
  74 -- ioeGetFileName        :: IOError -> Maybe FilePath
  75 -- ioeGetErrorString     :: IOError -> Maybe String
  76 -- ioeGetHandle          :: IOError -> Maybe Handle
  77 -- isAlreadyExistsError  :: IOError -> Bool
  78 -- isAlreadyInUseError   :: IOError -> Bool
  79 --IOHandle:isEOF                 :: IO Bool
  80 -- isEOFError            :: IOError -> Bool
  81 -- isFullError           :: IOError -> Bool
  82 -- isIllegalOperation    :: IOError -> Bool
  83 -- isPermissionError     :: IOError -> Bool
  84 -- isUserError           :: IOError -> Maybe String
  85 --IOHandle:openFile              :: FilePath -> IOMode -> IO Handle
  86 --IOHandle:stdin, stdout, stderr :: Handle
  87 \end{code}
  88
  89 %*********************************************************
  90 %*                                                      *
  91 \subsection{Simple input operations}
  92 %*                                                      *
  93 %*********************************************************
  94
  95 Computation $hReady hdl$ indicates whether at least
  96 one item is available for input from handle {\em hdl}.
  97
  98 \begin{code}
  99 --hReady :: Handle -> IO Bool
 100 hReady handle =
 101     readHandle handle                               >>= \ htype ->
 102     case htype of
 103       ErrorHandle ioError ->
 104           writeHandle handle htype                  >>
 105           fail ioError
 106       ClosedHandle ->
 107           writeHandle handle htype                  >>
 108           ioe_closedHandle handle
 109       SemiClosedHandle _ _ ->
 110           writeHandle handle htype                  >>
 111           ioe_closedHandle handle
 112       AppendHandle _ _ _ ->
 113           writeHandle handle htype                  >>
 114           fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
 115       WriteHandle _ _ _ ->
 116           writeHandle handle htype                  >>
 117           fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
 118       other ->
 119           _ccall_ inputReady (filePtr other)        `thenIO_Prim` \ rc ->
 120           writeHandle handle (markHandle htype)   >>
 121           case rc of
 122             0 -> return False
 123             1 -> return True
 124             _ -> constructErrorAndFail "hReady"
 125 \end{code}
 126
 127 Computation $hGetChar hdl$ reads the next character from handle
 128 {\em hdl}, blocking until a character is available.
 129
 130 \begin{code}
 131 --hGetChar :: Handle -> IO Char
 132
 133 hGetChar handle =
 134     readHandle handle                               >>= \ htype ->
 135     case htype of
 136       ErrorHandle ioError ->
 137           writeHandle handle htype                  >>
 138           fail ioError
 139       ClosedHandle ->
 140           writeHandle handle htype                  >>
 141           ioe_closedHandle handle
 142       SemiClosedHandle _ _ ->
 143           writeHandle handle htype                  >>
 144           ioe_closedHandle handle
 145       AppendHandle _ _ _ ->
 146           writeHandle handle htype                  >>
 147           fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
 148       WriteHandle _ _ _ ->
 149           writeHandle handle htype                  >>
 150           fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
 151       other ->
 152           _ccall_ fileGetc (filePtr other)          `thenIO_Prim` \ intc ->
 153           writeHandle handle (markHandle htype)   >>
 154           if intc /= ``EOF'' then
 155               return (chr intc)
 156           else
 157               constructErrorAndFail "hGetChar"
 158 \end{code}
 159
 160 Computation $hLookahead hdl$ returns the next character from handle
 161 {\em hdl} without removing it from the input buffer, blocking until a
 162 character is available.
 163
 164 \begin{code}
 165 --hLookAhead :: Handle -> IO Char
 166
 167 hLookAhead handle =
 168     readHandle handle                               >>= \ htype ->
 169     case htype of
 170       ErrorHandle ioError ->
 171           writeHandle handle htype                  >>
 172           fail ioError
 173       ClosedHandle ->
 174           writeHandle handle htype                  >>
 175           ioe_closedHandle handle
 176       SemiClosedHandle _ _ ->
 177           writeHandle handle htype                  >>
 178           ioe_closedHandle handle
 179       AppendHandle _ _ _ ->
 180           writeHandle handle htype                  >>
 181           fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
 182       WriteHandle _ _ _ ->
 183           writeHandle handle htype                  >>
 184           fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
 185       other ->
 186           _ccall_ fileLookAhead (filePtr other)    `thenIO_Prim` \ intc ->
 187           writeHandle handle (markHandle htype)   >>
 188           if intc /= ``EOF'' then
 189               return (chr intc)
 190           else
 191               constructErrorAndFail "hLookAhead"
 192 \end{code}
 193
 194
 195 %*********************************************************
 196 %*                                                      *
 197 \subsection{Getting the entire contents of a handle}
 198 %*                                                      *
 199 %*********************************************************
 200
 201 Computation $hGetContents hdl$ returns the list of characters
 202 corresponding to the unread portion of the channel or file managed by
 203 {\em hdl}, which is made semi-closed.
 204
 205 \begin{code}
 206 --hGetContents :: Handle -> IO String
 207
 208 hGetContents handle =
 209     readHandle handle                               >>= \ htype ->
 210     case htype of
 211       ErrorHandle ioError ->
 212           writeHandle handle htype                  >>
 213           fail ioError
 214       ClosedHandle ->
 215           writeHandle handle htype                  >>
 216           ioe_closedHandle handle
 217       SemiClosedHandle _ _ ->
 218           writeHandle handle htype                  >>
 219           ioe_closedHandle handle
 220       AppendHandle _ _ _ ->
 221           writeHandle handle htype                  >>
 222           fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
 223       WriteHandle _ _ _ ->
 224           writeHandle handle htype                  >>
 225           fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
 226       other ->
 227           {-
 228              To avoid introducing an extra layer of buffering here,
 229              we provide three lazy read methods, based on character,
 230              line, and block buffering.
 231           -}
 232           stToIO (getBufferMode other)  >>= \ other ->
 233           case (bufferMode other) of
 234             Just LineBuffering ->
 235                 allocBuf Nothing                    >>= \ buf_info ->
 236                 writeHandle handle (SemiClosedHandle (filePtr other) buf_info)
 237                                                     >>
 238                 unsafeInterleavePrimIO (lazyReadLine handle)
 239                                                     `thenIO_Prim` \ contents ->
 240                 return contents
 241
 242             Just (BlockBuffering size) ->
 243                 allocBuf size                       >>= \ buf_info ->
 244                 writeHandle handle (SemiClosedHandle (filePtr other) buf_info)
 245                                                     >>
 246                 unsafeInterleavePrimIO (lazyReadBlock handle)
 247                                                     `thenIO_Prim` \ contents ->
 248                 return contents
 249             _ -> -- Nothing is treated pessimistically as NoBuffering
 250                 writeHandle handle (SemiClosedHandle (filePtr other) (``NULL'', 0))
 251                                                     >>
 252                 unsafeInterleavePrimIO (lazyReadChar handle)
 253                                                     `thenIO_Prim` \ contents ->
 254                 return contents
 255   where
 256     allocBuf :: Maybe Int -> IO (Addr, Int)
 257     allocBuf msize =
 258         _ccall_ malloc size                         `thenIO_Prim` \ buf ->
 259         if buf /= ``NULL'' then
 260             return (buf, size)
 261         else
 262             fail (IOError Nothing ResourceExhausted "not enough virtual memory")
 263       where
 264         size =
 265             case msize of
 266               Just x -> x
 267               Nothing -> ``BUFSIZ''
 268 \end{code}
 269
 270 Note that someone may yank our handle out from under us, and then re-use
 271 the same FILE * for something else.  Therefore, we have to re-examine the
 272 handle every time through.
 273
 274 \begin{code}
 275 lazyReadBlock :: Handle -> PrimIO String
 276 lazyReadLine  :: Handle -> PrimIO String
 277 lazyReadChar  :: Handle -> PrimIO String
 278
 279 lazyReadBlock handle =
 280     ioToST (readHandle handle)                  >>= \ htype ->
 281     case htype of
 282       -- There cannae be an ErrorHandle here
 283       ClosedHandle ->
 284           ioToST (writeHandle handle htype)     >>
 285           returnPrimIO ""
 286       SemiClosedHandle fp (buf, size) ->
 287           _ccall_ readBlock buf fp size             >>= \ bytes ->
 288           (if bytes <= 0
 289           then return nilPS
 290           else packCBytesST bytes buf)              >>= \ some ->
 291           if bytes < 0 then
 292               _ccall_ free buf                      >>= \ () ->
 293               _ccall_ closeFile fp                  >>
 294 #ifndef PAR
 295               writeForeignObj fp ``NULL''           >>
 296               ioToST (writeHandle handle (SemiClosedHandle fp (``NULL'', 0))) >>
 297 #else
 298               ioToST (writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0))) >>
 299 #endif
 300               returnPrimIO (unpackPS some)
 301           else
 302               ioToST (writeHandle handle htype)     >>
 303               unsafeInterleavePrimIO (lazyReadBlock handle)
 304                                                     >>= \ more ->
 305               returnPrimIO (unpackPS some ++ more)
 306
 307 lazyReadLine handle =
 308     ioToST (readHandle handle)                      >>= \ htype ->
 309     case htype of
 310       -- There cannae be an ErrorHandle here
 311       ClosedHandle ->
 312           ioToST (writeHandle handle htype) >>
 313           returnPrimIO ""
 314       SemiClosedHandle fp (buf, size) ->
 315           _ccall_ readLine buf fp size              >>= \ bytes ->
 316           (if bytes <= 0
 317           then return nilPS
 318           else packCBytesST bytes buf)              >>= \ some ->
 319           if bytes < 0 then
 320               _ccall_ free buf                      >>= \ () ->
 321               _ccall_ closeFile fp                  >>
 322 #ifndef PAR
 323               writeForeignObj fp ``NULL''           >>
 324               ioToST (writeHandle handle (SemiClosedHandle fp (``NULL'', 0))) >>
 325 #else
 326               ioToST (writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0))) >>
 327 #endif
 328               returnPrimIO (unpackPS some)
 329           else
 330               ioToST (writeHandle handle htype)     >>
 331               unsafeInterleavePrimIO (lazyReadLine handle)
 332                                                     >>= \ more ->
 333               returnPrimIO (unpackPS some ++ more)
 334
 335 lazyReadChar handle =
 336     ioToST (readHandle handle)                      >>= \ htype ->
 337     case htype of
 338       -- There cannae be an ErrorHandle here
 339       ClosedHandle ->
 340           ioToST (writeHandle handle htype)         >>
 341           returnPrimIO ""
 342       SemiClosedHandle fp buf_info ->
 343           _ccall_ readChar fp                       >>= \ char ->
 344           if char == ``EOF'' then
 345               _ccall_ closeFile fp                  >>
 346 #ifndef PAR
 347               writeForeignObj fp ``NULL''           >>
 348               ioToST (writeHandle handle (SemiClosedHandle fp (``NULL'', 0))) >>
 349 #else
 350               ioToST (writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0))) >>
 351 #endif
 352               returnPrimIO ""
 353           else
 354               ioToST (writeHandle handle htype)     >>
 355               unsafeInterleavePrimIO (lazyReadChar handle)
 356                                                     >>= \ more ->
 357               returnPrimIO (chr char : more)
 358
 359 \end{code}
 360
 361
 362 %*********************************************************
 363 %*                                                      *
 364 \subsection{Simple output functions}
 365 %*                                                      *
 366 %*********************************************************
 367
 368 Computation $hPutChar hdl c$ writes the character {\em c} to the file
 369 or channel managed by {\em hdl}.  Characters may be buffered if
 370 buffering is enabled for {\em hdl}.
 371
 372 \begin{code}
 373 --hPutChar :: Handle -> Char -> IO ()
 374
 375 hPutChar handle c =
 376     readHandle handle                               >>= \ htype ->
 377     case htype of
 378       ErrorHandle ioError ->
 379           writeHandle handle htype                  >>
 380           fail ioError
 381       ClosedHandle ->
 382           writeHandle handle htype                  >>
 383           ioe_closedHandle handle
 384       SemiClosedHandle _ _ ->
 385           writeHandle handle htype                  >>
 386           ioe_closedHandle handle
 387       ReadHandle _ _ _ ->
 388           writeHandle handle htype                  >>
 389           fail (IOError (Just handle) IllegalOperation "handle is not open for writing")
 390       other ->
 391           _ccall_ filePutc (filePtr other) (ord c) `thenIO_Prim` \ rc ->
 392           writeHandle handle (markHandle htype)   >>
 393           if rc == 0 then
 394               return ()
 395           else
 396               constructErrorAndFail "hPutChar"
 397 \end{code}
 398
 399 Computation $hPutStr hdl s$ writes the string {\em s} to the file or
 400 channel managed by {\em hdl}.
 401
 402 \begin{code}
 403 --hPutStr :: Handle -> String -> IO ()
 404
 405 hPutStr handle str =
 406     readHandle handle                               >>= \ htype ->
 407     case htype of
 408       ErrorHandle ioError ->
 409           writeHandle handle htype                  >>
 410           fail ioError
 411       ClosedHandle ->
 412           writeHandle handle htype                  >>
 413           ioe_closedHandle handle
 414       SemiClosedHandle _ _ ->
 415           writeHandle handle htype                  >>
 416           ioe_closedHandle handle
 417       ReadHandle _ _ _ ->
 418           writeHandle handle htype                  >>
 419           fail (IOError (Just handle) IllegalOperation "handle is not open for writing")
 420       other ->
 421           {-
 422            The code below is not correct for line-buffered terminal streams,
 423            as the output stream is not flushed when terminal input is requested
 424            again, just upon seeing a newline character. A temporary fix for the
 425            most common line-buffered output stream, stdout, is to assume the
 426            buffering it was given when created (no buffering). This is not
 427            as bad as it looks, since stdio buffering sits underneath this.
 428
 429            ToDo: fix me
 430           -}
 431           getBufferMode other                       `thenIO_Prim` \ other ->
 432           (case bufferMode other of
 433             Just LineBuffering ->
 434                 writeChars (filePtr other) str
 435                 --writeLines (filePtr other) str
 436             Just (BlockBuffering (Just size)) ->
 437                 writeBlocks (filePtr other) size str
 438             Just (BlockBuffering Nothing) ->
 439                 writeBlocks (filePtr other) ``BUFSIZ'' str
 440             _ -> -- Nothing is treated pessimistically as NoBuffering
 441                 writeChars (filePtr other) str
 442           )                                         `thenIO_Prim` \ success ->
 443           writeHandle handle (markHandle other) >>
 444           if success then
 445               return ()
 446           else
 447               constructErrorAndFail "hPutStr"
 448   where
 449 #ifndef PAR
 450     writeLines :: ForeignObj -> String -> PrimIO Bool
 451 #else
 452     writeLines :: Addr -> String -> PrimIO Bool
 453 #endif
 454     writeLines = writeChunks ``BUFSIZ'' True
 455
 456 #ifndef PAR
 457     writeBlocks :: ForeignObj -> Int -> String -> PrimIO Bool
 458 #else
 459     writeBlocks :: Addr -> Int -> String -> PrimIO Bool
 460 #endif
 461     writeBlocks fp size s = writeChunks size False fp s
 462
 463     {-
 464       The breaking up of output into lines along \n boundaries
 465       works fine as long as there are newlines to split by.
 466       Avoid the splitting up into lines alltogether (doesn't work
 467       for overly long lines like the stuff that showsPrec instances
 468       normally return). Instead, we split them up into fixed size
 469       chunks before blasting them off to the Real World.
 470
 471       Hacked to avoid multiple passes over the strings - unsightly, but
 472       a whole lot quicker. -- SOF 3/96
 473     -}
 474
 475 #ifndef PAR
 476     writeChunks :: Int -> Bool -> ForeignObj -> String -> PrimIO Bool
 477 #else
 478     writeChunks :: Int -> Bool -> Addr -> String -> PrimIO Bool
 479 #endif
 480     writeChunks (I# bufLen) chopOnNewLine fp s =
 481      newCharArray (0,I# bufLen) >>= \ arr@(MutableByteArray _ arr#) ->
 482      let
 483       write_char :: MutableByteArray# RealWorld -> Int# -> Char# -> PrimIO ()
 484       write_char arr# n x = ST $ \ (S# s#) ->
 485           case (writeCharArray# arr# n x s#) of { s1# ->
 486           ( (), S# s1# ) }
 487
 488       shoveString :: Int# -> [Char] -> PrimIO Bool
 489       shoveString n ls =
 490        case ls of
 491          [] ->
 492            if n ==# 0# then
 493               returnPrimIO True
 494            else
 495              _ccall_ writeFile arr fp (I# n) >>= \rc ->
 496              returnPrimIO (rc==0)
 497
 498          ((C# x):xs) ->
 499            write_char arr# n x  >>
 500
 501            {- Flushing lines - should we bother? Yes, for line-buffered output. -}
 502            if n ==# bufLen || (chopOnNewLine && (x `eqChar#` '\n'#)) then
 503               _ccall_ writeFile arr fp (I# (n +# 1#)) >>= \ rc ->
 504               if rc == 0 then
 505                  shoveString 0# xs
 506                else
 507                  return False
 508             else
 509                shoveString (n +# 1#) xs
 510      in
 511      shoveString 0# s
 512
 513 #ifndef PAR
 514     writeChars :: ForeignObj -> String -> PrimIO Bool
 515 #else
 516     writeChars :: Addr -> String -> PrimIO Bool
 517 #endif
 518     writeChars fp "" = returnPrimIO True
 519     writeChars fp (c:cs) =
 520         _ccall_ filePutc fp (ord c) >>= \ rc ->
 521         if rc == 0 then
 522             writeChars fp cs
 523         else
 524             returnPrimIO False
 525 \end{code}
 526
 527 Computation $hPrint hdl t$ writes the string representation of {\em t}
 528 given by the $shows$ function to the file or channel managed by {\em
 529 hdl}.
 530
 531 SOF 2/97: Seem to have disappeared in 1.4 libs.
 532
 533 \begin{code}
 534 --hPrint :: Show a => Handle -> a -> IO ()
 535 hPrint hdl = hPutStr hdl . show
 536 \end{code}
 537
 538 Derived action @hPutStrLn hdl str@ writes the string \tr{str} to
 539 the handle \tr{hdl}, adding a newline at the end.
 540
 541 \begin{code}
 542 --hPutStrLn :: Handle -> String -> IO ()
 543 hPutStrLn hndl str = do
 544  hPutStr  hndl str
 545  hPutChar hndl '\n'
 546
 547 \end{code}