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 \end{code}
 359
 360
 361 %*********************************************************
 362 %*                                                      *
 363 \subsection{Simple output functions}
 364 %*                                                      *
 365 %*********************************************************
 366
 367 Computation $hPutChar hdl c$ writes the character {\em c} to the file
 368 or channel managed by {\em hdl}.  Characters may be buffered if
 369 buffering is enabled for {\em hdl}.
 370
 371 \begin{code}
 372 --hPutChar :: Handle -> Char -> IO ()
 373
 374 hPutChar handle c =
 375     readHandle handle                               >>= \ htype ->
 376     case htype of
 377       ErrorHandle ioError ->
 378           writeHandle handle htype                  >>
 379           fail ioError
 380       ClosedHandle ->
 381           writeHandle handle htype                  >>
 382           ioe_closedHandle handle
 383       SemiClosedHandle _ _ ->
 384           writeHandle handle htype                  >>
 385           ioe_closedHandle handle
 386       ReadHandle _ _ _ ->
 387           writeHandle handle htype                  >>
 388           fail (IOError (Just handle) IllegalOperation "handle is not open for writing")
 389       other ->
 390           _ccall_ filePutc (filePtr other) (ord c) `thenIO_Prim` \ rc ->
 391           writeHandle handle (markHandle htype)   >>
 392           if rc == 0 then
 393               return ()
 394           else
 395               constructErrorAndFail "hPutChar"
 396 \end{code}
 397
 398 Computation $hPutStr hdl s$ writes the string {\em s} to the file or
 399 channel managed by {\em hdl}.
 400
 401 \begin{code}
 402 --hPutStr :: Handle -> String -> IO ()
 403
 404 hPutStr handle str =
 405     readHandle handle                               >>= \ htype ->
 406     case htype of
 407       ErrorHandle ioError ->
 408           writeHandle handle htype                  >>
 409           fail ioError
 410       ClosedHandle ->
 411           writeHandle handle htype                  >>
 412           ioe_closedHandle handle
 413       SemiClosedHandle _ _ ->
 414           writeHandle handle htype                  >>
 415           ioe_closedHandle handle
 416       ReadHandle _ _ _ ->
 417           writeHandle handle htype                  >>
 418           fail (IOError (Just handle) IllegalOperation "handle is not open for writing")
 419       other ->
 420           getBufferMode other                       `thenIO_Prim` \ other ->
 421           (case bufferMode other of
 422             Just LineBuffering ->
 423                 writeLines (filePtr other) str
 424             Just (BlockBuffering (Just size)) ->
 425                 writeBlocks (filePtr other) size str
 426             Just (BlockBuffering Nothing) ->
 427                 writeBlocks (filePtr other) ``BUFSIZ'' str
 428             _ -> -- Nothing is treated pessimistically as NoBuffering
 429                 writeChars (filePtr other) str
 430           )                                         `thenIO_Prim` \ success ->
 431           writeHandle handle (markHandle other) >>
 432           if success then
 433               return ()
 434           else
 435               constructErrorAndFail "hPutStr"
 436   where
 437 #ifndef PAR
 438     writeLines :: ForeignObj -> String -> PrimIO Bool
 439 #else
 440     writeLines :: Addr -> String -> PrimIO Bool
 441 #endif
 442     writeLines = writeChunks ``BUFSIZ'' True
 443
 444 #ifndef PAR
 445     writeBlocks :: ForeignObj -> Int -> String -> PrimIO Bool
 446 #else
 447     writeBlocks :: Addr -> Int -> String -> PrimIO Bool
 448 #endif
 449     writeBlocks fp size s = writeChunks size False fp s
 450
 451     {-
 452       The breaking up of output into lines along \n boundaries
 453       works fine as long as there are newlines to split by.
 454       Avoid the splitting up into lines alltogether (doesn't work
 455       for overly long lines like the stuff that showsPrec instances
 456       normally return). Instead, we split them up into fixed size
 457       chunks before blasting them off to the Real World.
 458
 459       Hacked to avoid multiple passes over the strings - unsightly, but
 460       a whole lot quicker. -- SOF 3/96
 461     -}
 462
 463 #ifndef PAR
 464     writeChunks :: Int -> Bool -> ForeignObj -> String -> PrimIO Bool
 465 #else
 466     writeChunks :: Int -> Bool -> Addr -> String -> PrimIO Bool
 467 #endif
 468     writeChunks (I# bufLen) chopOnNewLine fp s =
 469      newCharArray (0,I# bufLen) >>= \ arr@(MutableByteArray _ arr#) ->
 470      let
 471       write_char :: MutableByteArray# RealWorld -> Int# -> Char# -> PrimIO ()
 472       write_char arr# n x = ST $ \ (S# s#) ->
 473           case (writeCharArray# arr# n x s#) of { s1# ->
 474           ( (), S# s1# ) }
 475
 476       shoveString :: Int# -> [Char] -> PrimIO Bool
 477       shoveString n ls =
 478        case ls of
 479          [] ->
 480            if n ==# 0# then
 481               returnPrimIO True
 482            else
 483              _ccall_ writeFile arr fp (I# n) >>= \rc ->
 484              returnPrimIO (rc==0)
 485
 486          ((C# x):xs) ->
 487            write_char arr# n x  >>
 488
 489            {- Flushing lines - should we bother? -}
 490            if n ==# bufLen {- || (chopOnNewLine && (x `eqChar#` '\n'#)) -} then
 491               _ccall_ writeFile arr fp (I# (n +# 1#)) >>= \ rc ->
 492               if rc == 0 then
 493                  shoveString 0# xs
 494                else
 495                  return False
 496             else
 497                shoveString (n +# 1#) xs
 498      in
 499      shoveString 0# s
 500
 501 #ifndef PAR
 502     writeChars :: ForeignObj -> String -> PrimIO Bool
 503 #else
 504     writeChars :: Addr -> String -> PrimIO Bool
 505 #endif
 506     writeChars fp "" = returnPrimIO True
 507     writeChars fp (c:cs) =
 508         _ccall_ filePutc fp (ord c) >>= \ rc ->
 509         if rc == 0 then
 510             writeChars fp cs
 511         else
 512             returnPrimIO False
 513 \end{code}
 514
 515 Computation $hPrint hdl t$ writes the string representation of {\em t}
 516 given by the $shows$ function to the file or channel managed by {\em
 517 hdl}.
 518
 519 SOF 2/97: Seem to have disappeared in 1.4 libs.
 520
 521 \begin{code}
 522 --hPrint :: Show a => Handle -> a -> IO ()
 523 hPrint hdl = hPutStr hdl . show
 524 \end{code}
 525
 526 Derived action @hPutStrLn hdl str@ writes the string \tr{str} to
 527 the handle \tr{hdl}, adding a newline at the end.
 528
 529 \begin{code}
 530 --hPutStrLn :: Handle -> String -> IO ()
 531 hPutStrLn hndl str = do
 532  hPutStr  hndl str
 533  hPutChar hndl '\n'
 534
 535 \end{code}