2 % (c) The GRASP/AQUA Project, Glasgow University, 1994
4 \section[PrelReadTextIO]{Haskell 1.3 Text Input}
6 This module defines the standard set of input operations for reading
7 characters and strings from text files, using {\em handles}.
10 module PreludeReadTextIO (
29 import PreludeMonadicIO
35 ---------------------------------
38 my_then :: IO a -> (a -> PrimIO b) -> PrimIO b
39 {-# INLINE my_then #-}
41 my_then m k = m `thenPrimIO` \ r -> k' r
44 k' (Left err) = error "my_then"
45 ---------------------------------
48 hReady :: Handle -> IO Bool
50 takeMVar handle >>= \ htype ->
52 _ErrorHandle ioError ->
53 putMVar handle htype >>
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")
65 putMVar handle htype >>
66 failWith (IllegalOperation "handle is not open for reading")
68 _ccall_ inputReady (_filePtr other) `thenPrimIO` \ rc ->
69 putMVar handle (_markHandle htype) >>
73 _ -> _constructError `thenPrimIO` \ ioError ->
78 Computation $hReady hdl$ indicates whether at least
79 one item is available for input from handle {\em hdl}.
83 hGetChar :: Handle -> IO Char
85 takeMVar handle >>= \ htype ->
87 _ErrorHandle ioError ->
88 putMVar handle htype >>
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")
100 putMVar handle htype >>
101 failWith (IllegalOperation "handle is not open for reading")
103 _ccall_ fileGetc (_filePtr other) `thenPrimIO` \ intc ->
104 putMVar handle (_markHandle htype) >>
105 if intc /= ``EOF'' then
108 _constructError `thenPrimIO` \ ioError ->
112 getChar = hGetChar stdin13
116 Computation $hGetChar hdl$ reads the next character from handle {\em
117 hdl}, blocking until a character is available.
119 $getChar$ reads the next character from $stdin$.
123 hLookAhead :: Handle -> IO Char
125 takeMVar handle >>= \ htype ->
127 _ErrorHandle ioError ->
128 putMVar handle htype >>
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")
143 _ccall_ fileLookAhead (_filePtr other) `thenPrimIO` \ intc ->
144 putMVar handle (_markHandle htype) >>
145 if intc /= ``EOF'' then
148 _constructError `thenPrimIO` \ ioError ->
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.
159 hGetContents :: Handle -> IO String
160 hGetContents handle =
161 takeMVar handle >>= \ htype ->
163 _ErrorHandle ioError ->
164 putMVar handle htype >>
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")
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.
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)
192 unsafeInterleavePrimIO (lazyReadLine handle)
193 `thenPrimIO` \ contents ->
196 Just (BlockBuffering size) ->
197 allocBuf size >>= \ buf_info ->
198 putMVar handle (_SemiClosedHandle (_filePtr other) buf_info)
200 unsafeInterleavePrimIO (lazyReadBlock handle)
201 `thenPrimIO` \ contents ->
203 _ -> -- Nothing is treated pessimistically as NoBuffering
204 putMVar handle (_SemiClosedHandle (_filePtr other) (``NULL'', 0))
206 unsafeInterleavePrimIO (lazyReadChar handle)
207 `thenPrimIO` \ contents ->
210 allocBuf :: (Maybe Int) -> IO (_Addr, Int)
212 _ccall_ malloc size `thenPrimIO` \ buf ->
213 if buf /= ``NULL'' then
216 failWith (ResourceExhausted "not enough virtual memory")
221 Nothing -> ``BUFSIZ''
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.
229 lazyReadBlock :: Handle -> PrimIO String
230 lazyReadBlock handle =
231 takeMVar handle `my_then` \ htype ->
233 -- There cannae be an _ErrorHandle here
235 putMVar handle htype `seqPrimIO`
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 ->
242 putMVar handle (_SemiClosedHandle ``NULL'' (``NULL'', 0))
244 _ccall_ free buf `thenPrimIO` \ () ->
245 _ccall_ closeFile fp `seqPrimIO`
246 returnPrimIO (_unpackPS some)
248 putMVar handle htype `seqPrimIO`
249 unsafeInterleavePrimIO (lazyReadBlock handle)
250 `thenPrimIO` \ more ->
251 returnPrimIO (_unpackPS some ++ more)
253 lazyReadLine :: Handle -> PrimIO String
254 lazyReadLine handle =
255 takeMVar handle `my_then` \ htype ->
257 -- There cannae be an _ErrorHandle here
259 putMVar handle htype `seqPrimIO`
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 ->
266 putMVar handle (_SemiClosedHandle ``NULL'' (``NULL'', 0))
268 _ccall_ free buf `thenPrimIO` \ () ->
269 _ccall_ closeFile fp `seqPrimIO`
270 returnPrimIO (_unpackPS some)
272 putMVar handle htype `seqPrimIO`
273 unsafeInterleavePrimIO (lazyReadLine handle)
274 `thenPrimIO` \ more ->
275 returnPrimIO (_unpackPS some ++ more)
277 lazyReadChar :: Handle -> PrimIO String
278 lazyReadChar handle =
279 takeMVar handle `my_then` \ htype ->
281 -- There cannae be an _ErrorHandle here
283 putMVar handle htype `seqPrimIO`
285 _SemiClosedHandle fp buf_info ->
286 _ccall_ readChar fp `thenPrimIO` \ char ->
287 if char == ``EOF'' then
288 putMVar handle (_SemiClosedHandle ``NULL'' buf_info)
290 _ccall_ closeFile fp `seqPrimIO`
293 putMVar handle htype `seqPrimIO`
294 unsafeInterleavePrimIO (lazyReadChar handle)
295 `thenPrimIO` \ more ->
296 returnPrimIO (chr char : more)
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.
306 readFile13 :: FilePath -> IO String
307 readFile13 name = openFile name ReadMode >>= hGetContents
311 $readFile file$ returns the contents of {\em file} as a lazy string.