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 )
  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               makeForeignObj ``NULL'' ``&freeFile'' >>= \ null_fp ->
 293               ioToST (writeHandle handle (SemiClosedHandle null_fp (``NULL'', 0)))
 294                                                     >>
 295               _ccall_ free buf                      >>= \ () ->
 296               _ccall_ closeFile fp                  >>
 297               returnPrimIO (unpackPS some)
 298           else
 299               ioToST (writeHandle handle htype)     >>
 300               unsafeInterleavePrimIO (lazyReadBlock handle)
 301                                                     >>= \ more ->
 302               returnPrimIO (unpackPS some ++ more)
 303
 304 lazyReadLine handle =
 305     ioToST (readHandle handle) >>= \ htype ->
 306     case htype of
 307       -- There cannae be an ErrorHandle here
 308       ClosedHandle ->
 309           ioToST (writeHandle handle htype) >>
 310           returnPrimIO ""
 311       SemiClosedHandle fp (buf, size) ->
 312           _ccall_ readLine buf fp size              >>= \ bytes ->
 313           (if bytes <= 0
 314           then return nilPS
 315           else packCBytesST bytes buf)              >>= \ some ->
 316           if bytes < 0 then
 317               makeForeignObj ``NULL'' ``&freeFile'' >>= \ null_fp ->
 318               ioToST (writeHandle handle (SemiClosedHandle null_fp (``NULL'', 0)))
 319                                                     >>
 320               _ccall_ free buf                      >>= \ () ->
 321               _ccall_ closeFile fp                  >>
 322               returnPrimIO (unpackPS some)
 323           else
 324               ioToST (writeHandle handle htype)     >>
 325               unsafeInterleavePrimIO (lazyReadLine handle)
 326                                                     >>= \ more ->
 327               returnPrimIO (unpackPS some ++ more)
 328
 329 lazyReadChar handle =
 330     ioToST (readHandle handle) >>= \ htype ->
 331     case htype of
 332       -- There cannae be an ErrorHandle here
 333       ClosedHandle ->
 334           ioToST (writeHandle handle htype)         >>
 335           returnPrimIO ""
 336       SemiClosedHandle fp buf_info ->
 337           _ccall_ readChar fp                       >>= \ char ->
 338           if char == ``EOF'' then
 339               makeForeignObj ``NULL'' ``&freeFile'' >>= \ null_fp ->
 340               ioToST (writeHandle handle (SemiClosedHandle null_fp buf_info))
 341                                                     >>
 342               _ccall_ closeFile fp                  >>
 343               returnPrimIO ""
 344           else
 345               ioToST (writeHandle handle htype)     >>
 346               unsafeInterleavePrimIO (lazyReadChar handle)
 347                                                     >>= \ more ->
 348               returnPrimIO (chr char : more)
 349 \end{code}
 350
 351
 352 %*********************************************************
 353 %*                                                      *
 354 \subsection{Simple output functions}
 355 %*                                                      *
 356 %*********************************************************
 357
 358 Computation $hPutChar hdl c$ writes the character {\em c} to the file
 359 or channel managed by {\em hdl}.  Characters may be buffered if
 360 buffering is enabled for {\em hdl}.
 361
 362 \begin{code}
 363 --hPutChar :: Handle -> Char -> IO ()
 364
 365 hPutChar handle c =
 366     readHandle handle                               >>= \ htype ->
 367     case htype of
 368       ErrorHandle ioError ->
 369           writeHandle handle htype                  >>
 370           fail ioError
 371       ClosedHandle ->
 372           writeHandle handle htype                  >>
 373           ioe_closedHandle handle
 374       SemiClosedHandle _ _ ->
 375           writeHandle handle htype                  >>
 376           ioe_closedHandle handle
 377       ReadHandle _ _ _ ->
 378           writeHandle handle htype                  >>
 379           fail (IOError (Just handle) IllegalOperation "handle is not open for writing")
 380       other ->
 381           _ccall_ filePutc (filePtr other) (ord c) `thenIO_Prim` \ rc ->
 382           writeHandle handle (markHandle htype)   >>
 383           if rc == 0 then
 384               return ()
 385           else
 386               constructErrorAndFail "hPutChar"
 387 \end{code}
 388
 389 Computation $hPutStr hdl s$ writes the string {\em s} to the file or
 390 channel managed by {\em hdl}.
 391
 392 \begin{code}
 393 --hPutStr :: Handle -> String -> IO ()
 394
 395 hPutStr handle str =
 396     readHandle handle                               >>= \ htype ->
 397     case htype of
 398       ErrorHandle ioError ->
 399           writeHandle handle htype                  >>
 400           fail ioError
 401       ClosedHandle ->
 402           writeHandle handle htype                  >>
 403           ioe_closedHandle handle
 404       SemiClosedHandle _ _ ->
 405           writeHandle handle htype                  >>
 406           ioe_closedHandle handle
 407       ReadHandle _ _ _ ->
 408           writeHandle handle htype                  >>
 409           fail (IOError (Just handle) IllegalOperation "handle is not open for writing")
 410       other ->
 411           getBufferMode other                       `thenIO_Prim` \ other ->
 412           (case bufferMode other of
 413             Just LineBuffering ->
 414                 writeLines (filePtr other) str
 415             Just (BlockBuffering (Just size)) ->
 416                 writeBlocks (filePtr other) size str
 417             Just (BlockBuffering Nothing) ->
 418                 writeBlocks (filePtr other) ``BUFSIZ'' str
 419             _ -> -- Nothing is treated pessimistically as NoBuffering
 420                 writeChars (filePtr other) str
 421           )                                         `thenIO_Prim` \ success ->
 422           writeHandle handle (markHandle other) >>
 423           if success then
 424               return ()
 425           else
 426               constructErrorAndFail "hPutStr"
 427   where
 428     writeLines :: ForeignObj -> String -> PrimIO Bool
 429     writeLines = writeChunks ``BUFSIZ'' True
 430
 431     writeBlocks :: ForeignObj -> Int -> String -> PrimIO Bool
 432     writeBlocks fp size s = writeChunks size False fp s
 433
 434     {-
 435       The breaking up of output into lines along \n boundaries
 436       works fine as long as there are newlines to split by.
 437       Avoid the splitting up into lines alltogether (doesn't work
 438       for overly long lines like the stuff that showsPrec instances
 439       normally return). Instead, we split them up into fixed size
 440       chunks before blasting them off to the Real World.
 441
 442       Hacked to avoid multiple passes over the strings - unsightly, but
 443       a whole lot quicker. -- SOF 3/96
 444     -}
 445
 446     writeChunks :: Int -> Bool -> ForeignObj -> String -> PrimIO Bool
 447
 448     writeChunks (I# bufLen) chopOnNewLine fp s =
 449      newCharArray (0,I# bufLen) >>= \ arr@(MutableByteArray _ arr#) ->
 450      let
 451       write_char :: MutableByteArray# RealWorld -> Int# -> Char# -> PrimIO ()
 452       write_char arr# n x = ST $ \ (S# s#) ->
 453           case (writeCharArray# arr# n x s#) of { s1# ->
 454           ( (), S# s1# ) }
 455
 456       shoveString :: Int# -> [Char] -> PrimIO Bool
 457       shoveString n ls =
 458        case ls of
 459          [] ->
 460            if n ==# 0# then
 461               returnPrimIO True
 462            else
 463              _ccall_ writeFile arr fp (I# n) >>= \rc ->
 464              returnPrimIO (rc==0)
 465
 466          ((C# x):xs) ->
 467            write_char arr# n x  >>
 468
 469            {- Flushing lines - should we bother? -}
 470            if n ==# bufLen {- || (chopOnNewLine && (x `eqChar#` '\n'#)) -} then
 471               _ccall_ writeFile arr fp (I# (n +# 1#)) >>= \ rc ->
 472               if rc == 0 then
 473                  shoveString 0# xs
 474                else
 475                  return False
 476             else
 477                shoveString (n +# 1#) xs
 478      in
 479      shoveString 0# s
 480
 481     writeChars :: ForeignObj -> String -> PrimIO Bool
 482     writeChars fp "" = returnPrimIO True
 483     writeChars fp (c:cs) =
 484         _ccall_ filePutc fp (ord c) >>= \ rc ->
 485         if rc == 0 then
 486             writeChars fp cs
 487         else
 488             returnPrimIO False
 489 \end{code}
 490
 491 Computation $hPrint hdl t$ writes the string representation of {\em t}
 492 given by the $shows$ function to the file or channel managed by {\em
 493 hdl}.
 494
 495 SOF 2/97: Seem to have disappeared in 1.4 libs.
 496
 497 \begin{code}
 498 --hPrint :: Show a => Handle -> a -> IO ()
 499 hPrint hdl = hPutStr hdl . show
 500 \end{code}
 501
 502 Derived action @hPutStrLn hdl str@ writes the string \tr{str} to
 503 the handle \tr{hdl}, adding a newline at the end.
 504
 505 \begin{code}
 506 --hPutStrLn :: Handle -> String -> IO ()
 507 hPutStrLn hndl str = do
 508  hPutStr  hndl str
 509  hPutChar hndl '\n'
 510
 511 \end{code}