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