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