ghc/lib/prelude/PreludeReadTextIO.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1994
   3 %
   4 \section[PrelReadTextIO]{Haskell 1.3 Text Input}
   5
   6 This module defines the standard set of input operations for reading
   7 characters and strings from text files, using {\em handles}.
   8
   9 \begin{code}
  10 module PreludeReadTextIO (
  11     hReady,
  12     hGetChar,
  13     getChar,
  14     hLookAhead,
  15     hGetContents,
  16     readFile13
  17   ) where
  18
  19 import Cls
  20 import Core
  21 import IChar
  22 import IInt
  23 import IList
  24 import List             ( (++) )
  25 import Prel             ( chr )
  26 import Text
  27 import TyArray
  28 import TyComplex
  29
  30 import PreludeIOError
  31 import PreludeMonadicIO
  32 import PreludePrimIO
  33 import PreludeGlaST
  34 import PreludeStdIO
  35 import PS
  36
  37 ---------------------------------
  38 infixr 1 `my_then`
  39
  40 my_then :: IO a -> (a -> PrimIO b) -> PrimIO b
  41 {-# INLINE my_then   #-}
  42
  43 my_then m k = m `thenPrimIO` \ r -> k' r
  44   where
  45     k' (Right x)  = k x
  46     k' (Left err) = error "my_then"
  47 ---------------------------------
  48
  49
  50 hReady :: Handle -> IO Bool
  51 hReady handle =
  52     takeMVar handle                                 >>= \ htype ->
  53     case htype of
  54       _ErrorHandle ioError ->
  55           putMVar handle htype                      >>
  56           failWith ioError
  57       _ClosedHandle ->
  58           putMVar handle htype                      >>
  59           failWith (IllegalOperation "handle is closed")
  60       _SemiClosedHandle _ _ ->
  61           putMVar handle htype                      >>
  62           failWith (IllegalOperation "handle is closed")
  63       _AppendHandle _ _ _ ->
  64           putMVar handle htype                      >>
  65           failWith (IllegalOperation "handle is not open for reading")
  66       _WriteHandle _ _ _ ->
  67           putMVar handle htype                      >>
  68           failWith (IllegalOperation "handle is not open for reading")
  69       other ->
  70           _ccall_ inputReady (_filePtr other)       `thenPrimIO` \ rc ->
  71           putMVar handle (_markHandle htype)        >>
  72           case rc of
  73             0 -> return False
  74             1 -> return True
  75             _ -> _constructError                    `thenPrimIO` \ ioError ->
  76                  failWith ioError
  77
  78 \end{code}
  79
  80 Computation $hReady hdl$ indicates whether at least
  81 one item is available for input from handle {\em hdl}.
  82
  83 \begin{code}
  84
  85 hGetChar :: Handle -> IO Char
  86 hGetChar handle =
  87     takeMVar handle                                 >>= \ htype ->
  88     case htype of
  89       _ErrorHandle ioError ->
  90           putMVar handle htype                      >>
  91           failWith ioError
  92       _ClosedHandle ->
  93           putMVar handle htype                      >>
  94           failWith (IllegalOperation "handle is closed")
  95       _SemiClosedHandle _ _ ->
  96           putMVar handle htype                      >>
  97           failWith (IllegalOperation "handle is closed")
  98       _AppendHandle _ _ _ ->
  99           putMVar handle htype                      >>
 100           failWith (IllegalOperation "handle is not open for reading")
 101       _WriteHandle _ _ _ ->
 102           putMVar handle htype                      >>
 103           failWith (IllegalOperation "handle is not open for reading")
 104       other ->
 105           _ccall_ fileGetc (_filePtr other)         `thenPrimIO` \ intc ->
 106           putMVar handle (_markHandle htype)        >>
 107           if intc /= ``EOF'' then
 108               return (chr intc)
 109           else
 110               _constructError                       `thenPrimIO` \ ioError ->
 111               failWith ioError
 112
 113 getChar :: IO Char
 114 getChar = hGetChar stdin13
 115
 116 \end{code}
 117
 118 Computation $hGetChar hdl$ reads the next character from handle {\em
 119 hdl}, blocking until a character is available.
 120
 121 $getChar$ reads the next character from $stdin$.
 122
 123 \begin{code}
 124
 125 hLookAhead :: Handle -> IO Char
 126 hLookAhead handle =
 127     takeMVar handle                                 >>= \ htype ->
 128     case htype of
 129       _ErrorHandle ioError ->
 130           putMVar handle htype                      >>
 131           failWith ioError
 132       _ClosedHandle ->
 133           putMVar handle htype                      >>
 134           failWith (IllegalOperation "handle is closed")
 135       _SemiClosedHandle _ _ ->
 136           putMVar handle htype                      >>
 137           failWith (IllegalOperation "handle is closed")
 138       _AppendHandle _ _ _ ->
 139           putMVar handle htype                      >>
 140           failWith (IllegalOperation "handle is not open for reading")
 141       _WriteHandle _ _ _ ->
 142           putMVar handle htype                      >>
 143           failWith (IllegalOperation "handle is not open for reading")
 144       other ->
 145           _ccall_ fileLookAhead (_filePtr other)    `thenPrimIO` \ intc ->
 146           putMVar handle (_markHandle htype)        >>
 147           if intc /= ``EOF'' then
 148               return (chr intc)
 149           else
 150               _constructError                       `thenPrimIO` \ ioError ->
 151               failWith ioError
 152
 153 \end{code}
 154
 155 Computation $hLookahead hdl$ returns the next character from handle
 156 {\em hdl} without removing it from the input buffer, blocking until a
 157 character is available.
 158
 159 \begin{code}
 160
 161 hGetContents :: Handle -> IO String
 162 hGetContents handle =
 163     takeMVar handle                                 >>= \ htype ->
 164     case htype of
 165       _ErrorHandle ioError ->
 166           putMVar handle htype                      >>
 167           failWith ioError
 168       _ClosedHandle ->
 169           putMVar handle htype                      >>
 170           failWith (IllegalOperation "handle is closed")
 171       _SemiClosedHandle _ _ ->
 172           putMVar handle htype                      >>
 173           failWith (IllegalOperation "handle is closed")
 174       _AppendHandle _ _ _ ->
 175           putMVar handle htype                      >>
 176           failWith (IllegalOperation "handle is not open for reading")
 177       _WriteHandle _ _ _ ->
 178           putMVar handle htype                      >>
 179           failWith (IllegalOperation "handle is not open for reading")
 180       other ->
 181
 182           {-
 183              To avoid introducing an extra layer of buffering here,
 184              we provide three lazy read methods, based on character,
 185              line, and block buffering.
 186           -}
 187
 188           _getBufferMode other                      `thenPrimIO` \ other ->
 189           case _bufferMode other of
 190             Just LineBuffering ->
 191                 allocBuf Nothing                    >>= \ buf_info ->
 192                 putMVar handle (_SemiClosedHandle (_filePtr other) buf_info)
 193                                                     >>
 194                 unsafeInterleavePrimIO (lazyReadLine handle)
 195                                                     `thenPrimIO` \ contents ->
 196                 return contents
 197
 198             Just (BlockBuffering size) ->
 199                 allocBuf size                       >>= \ buf_info ->
 200                 putMVar handle (_SemiClosedHandle (_filePtr other) buf_info)
 201                                                     >>
 202                 unsafeInterleavePrimIO (lazyReadBlock handle)
 203                                                     `thenPrimIO` \ contents ->
 204                 return contents
 205             _ -> -- Nothing is treated pessimistically as NoBuffering
 206                 putMVar handle (_SemiClosedHandle (_filePtr other) (``NULL'', 0))
 207                                                     >>
 208                 unsafeInterleavePrimIO (lazyReadChar handle)
 209                                                     `thenPrimIO` \ contents ->
 210                 return contents
 211   where
 212     allocBuf :: (Maybe Int) -> IO (_Addr, Int)
 213     allocBuf msize =
 214         _ccall_ malloc size                         `thenPrimIO` \ buf ->
 215         if buf /= ``NULL'' then
 216             return (buf, size)
 217         else
 218             failWith (ResourceExhausted "not enough virtual memory")
 219       where
 220         size =
 221             case msize of
 222               Just x -> x
 223               Nothing -> ``BUFSIZ''
 224
 225 {-
 226    Note that someone may yank our handle out from under us, and then re-use
 227    the same FILE * for something else.  Therefore, we have to re-examine the
 228    handle every time through.
 229 -}
 230
 231 lazyReadBlock :: Handle -> PrimIO String
 232 lazyReadBlock handle =
 233     takeMVar handle                                 `my_then` \ htype ->
 234     case htype of
 235       -- There cannae be an _ErrorHandle here
 236       _ClosedHandle ->
 237           putMVar handle htype                      `seqPrimIO`
 238           returnPrimIO ""
 239       _SemiClosedHandle fp (buf, size) ->
 240           _ccall_ readBlock buf fp size             `thenPrimIO` \ bytes ->
 241           (if bytes <= 0 then returnStrictlyST _nilPS
 242            else _packCBytesST bytes buf)            `thenStrictlyST` \ some ->
 243           if bytes < 0 then
 244               putMVar handle (_SemiClosedHandle ``NULL'' (``NULL'', 0))
 245                                                     `seqPrimIO`
 246               _ccall_ free buf                      `thenPrimIO` \ () ->
 247               _ccall_ closeFile fp                  `seqPrimIO`
 248               returnPrimIO (_unpackPS some)
 249           else
 250               putMVar handle htype                  `seqPrimIO`
 251               unsafeInterleavePrimIO (lazyReadBlock handle)
 252                                                     `thenPrimIO` \ more ->
 253               returnPrimIO (_unpackPS some ++ more)
 254
 255 lazyReadLine :: Handle -> PrimIO String
 256 lazyReadLine handle =
 257     takeMVar handle                                 `my_then` \ htype ->
 258     case htype of
 259       -- There cannae be an _ErrorHandle here
 260       _ClosedHandle ->
 261           putMVar handle htype                      `seqPrimIO`
 262           returnPrimIO ""
 263       _SemiClosedHandle fp (buf, size) ->
 264           _ccall_ readLine buf fp size              `thenPrimIO` \ bytes ->
 265           (if bytes <= 0 then returnStrictlyST _nilPS
 266            else _packCBytesST bytes buf)            `thenStrictlyST` \ some ->
 267           if bytes < 0 then
 268               putMVar handle (_SemiClosedHandle ``NULL'' (``NULL'', 0))
 269                                                     `seqPrimIO`
 270               _ccall_ free buf                      `thenPrimIO` \ () ->
 271               _ccall_ closeFile fp                  `seqPrimIO`
 272               returnPrimIO (_unpackPS some)
 273           else
 274               putMVar handle htype                  `seqPrimIO`
 275               unsafeInterleavePrimIO (lazyReadLine handle)
 276                                                     `thenPrimIO` \ more ->
 277               returnPrimIO (_unpackPS some ++ more)
 278
 279 lazyReadChar :: Handle -> PrimIO String
 280 lazyReadChar handle =
 281     takeMVar handle                                 `my_then` \ htype ->
 282     case htype of
 283       -- There cannae be an _ErrorHandle here
 284       _ClosedHandle ->
 285           putMVar handle htype                      `seqPrimIO`
 286           returnPrimIO ""
 287       _SemiClosedHandle fp buf_info ->
 288           _ccall_ readChar fp                       `thenPrimIO` \ char ->
 289           if char == ``EOF'' then
 290               putMVar handle (_SemiClosedHandle ``NULL'' buf_info)
 291                                                     `seqPrimIO`
 292               _ccall_ closeFile fp                  `seqPrimIO`
 293               returnPrimIO ""
 294           else
 295               putMVar handle htype                  `seqPrimIO`
 296               unsafeInterleavePrimIO (lazyReadChar handle)
 297                                                     `thenPrimIO` \ more ->
 298               returnPrimIO (chr char : more)
 299
 300 \end{code}
 301
 302 Computation $hGetContents hdl$ returns the list of characters
 303 corresponding to the unread portion of the channel or file managed by
 304 {\em hdl}, which is made semi-closed.
 305
 306 \begin{code}
 307
 308 readFile13 :: FilePath -> IO String
 309 readFile13 name = openFile name ReadMode >>= hGetContents
 310
 311 \end{code}
 312
 313 $readFile file$ returns the contents of {\em file} as a lazy string.