2 % (c) The AQUA Project, Glasgow University, 1994-1996
5 \section[IO]{Module @IO@}
8 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
13 IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),
14 BufferMode(NoBuffering,LineBuffering,BlockBuffering),
15 SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
17 stdin, stdout, stderr,
20 hFileSize, hIsEOF, isEOF,
21 hSetBuffering, hGetBuffering, hFlush,
22 hGetPosn, hSetPosn, hSeek,
23 hWaitForInput, hReady, hGetChar, hGetLine, hLookAhead, hGetContents,
24 hPutChar, hPutStr, hPutStrLn, hPrint,
25 hIsOpen, hIsClosed, hIsReadable, hIsWritable, hIsSeekable,
27 isAlreadyExistsError, isDoesNotExistError, isAlreadyInUseError,
28 isFullError, isEOFError,
29 isIllegalOperation, isPermissionError, isUserError,
31 ioeGetHandle, ioeGetFileName,
32 try, bracket, bracket_
37 import UnsafeST ( unsafePerformPrimIO, unsafeInterleavePrimIO )
39 import ArrBase ( MutableByteArray(..), newCharArray )
40 import IOHandle -- much of the real stuff is in here
41 import PackBase ( unpackNBytesST )
44 import Foreign ( ForeignObj, Addr, makeForeignObj, writeForeignObj )
45 import Char ( ord, chr )
48 %*********************************************************
50 \subsection{Signatures}
52 %*********************************************************
55 --IOHandle:hClose :: Handle -> IO ()
56 --IOHandle:hFileSize :: Handle -> IO Integer
57 --IOHandle:hFlush :: Handle -> IO ()
58 --IOHandle:hGetBuffering :: Handle -> IO BufferMode
59 hGetChar :: Handle -> IO Char
60 hGetContents :: Handle -> IO String
61 --IOHandle:hGetPosn :: Handle -> IO HandlePosn
62 --IOHandle:hIsClosed :: Handle -> IO Bool
63 --IOHandle:hIsEOF :: Handle -> IO Bool
64 --IOHandle:hIsOpen :: Handle -> IO Bool
65 --IOHandle:hIsReadable :: Handle -> IO Bool
66 --IOHandle:hIsSeekable :: Handle -> IO Bool
67 --IOHandle:hIsWritable :: Handle -> IO Bool
68 hLookAhead :: Handle -> IO Char
69 hPrint :: Show a => Handle -> a -> IO ()
70 hPutChar :: Handle -> Char -> IO ()
71 hPutStr :: Handle -> String -> IO ()
72 hPutStrLn :: Handle -> String -> IO ()
73 hReady :: Handle -> IO Bool
74 hWaitForInput :: Handle -> Int -> IO Bool
76 --IOHandle:hSeek :: Handle -> SeekMode -> Integer -> IO ()
77 --IOHandle:hSetBuffering :: Handle -> BufferMode -> IO ()
78 --IOHandle:hSetPosn :: HandlePosn -> IO ()
79 -- ioeGetFileName :: IOError -> Maybe FilePath
80 -- ioeGetErrorString :: IOError -> Maybe String
81 -- ioeGetHandle :: IOError -> Maybe Handle
82 -- isAlreadyExistsError :: IOError -> Bool
83 -- isAlreadyInUseError :: IOError -> Bool
84 --IOHandle:isEOF :: IO Bool
85 -- isEOFError :: IOError -> Bool
86 -- isFullError :: IOError -> Bool
87 -- isIllegalOperation :: IOError -> Bool
88 -- isPermissionError :: IOError -> Bool
89 -- isUserError :: IOError -> Maybe String
90 --IOHandle:openFile :: FilePath -> IOMode -> IO Handle
91 --IOHandle:stdin, stdout, stderr :: Handle
94 Standard instances for @Handle@:
97 instance Eq IOError where
98 (IOError h1 e1 str1) == (IOError h2 e2 str2) =
99 e1==e2 && str1==str2 && h1==h2
101 instance Eq Handle where
103 unsafePerformPrimIO (
104 ioToPrimIO (readHandle h1) >>= \ h1_ ->
105 ioToPrimIO (writeHandle h1 h1_) >>
106 ioToPrimIO (readHandle h2) >>= \ h2_ ->
107 ioToPrimIO (writeHandle h2 h2_) >>
110 (ErrorHandle (IOError h1 _ _), ErrorHandle (IOError h2 _ _)) -> h1 == h2
111 (ClosedHandle, ClosedHandle) -> True
112 (SemiClosedHandle v1 _, SemiClosedHandle v2 _) -> v1 == v2
113 (ReadHandle v1 _ _ , ReadHandle v2 _ _) -> v1 == v2
114 (WriteHandle v1 _ _ , WriteHandle v2 _ _) -> v1 == v2
115 (AppendHandle v1 _ _ , AppendHandle v2 _ _) -> v1 == v2
116 (ReadWriteHandle v1 _ _ , ReadWriteHandle v2 _ _) -> v1 == v2
119 instance Show Handle where {showsPrec p h = showString "<<Handle>>"}
121 --Type declared in IOHandle, instance here because it depends on Eq.Handle
122 instance Eq HandlePosn where
123 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
127 %*********************************************************
129 \subsection{Simple input operations}
131 %*********************************************************
133 Computation @hReady hdl@ indicates whether at least
134 one item is available for input from handle {\em hdl}.
136 @hWaitForInput@ is the generalisation, wait for \tr{n} seconds
137 before deciding whether the Handle has run dry or not.
140 --hReady :: Handle -> IO Bool
141 hReady h = hWaitForInput h 0
143 --hWaitForInput :: Handle -> Int -> IO Bool
144 hWaitForInput handle nsecs =
145 readHandle handle >>= \ htype ->
147 ErrorHandle ioError ->
148 writeHandle handle htype >>
151 writeHandle handle htype >>
152 ioe_closedHandle handle
153 SemiClosedHandle _ _ ->
154 writeHandle handle htype >>
155 ioe_closedHandle handle
156 AppendHandle _ _ _ ->
157 writeHandle handle htype >>
158 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
160 writeHandle handle htype >>
161 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
163 _ccall_ inputReady (filePtr other) nsecs `thenIO_Prim` \ rc ->
164 writeHandle handle (markHandle htype) >>
168 _ -> constructErrorAndFail "hWaitForInput"
171 Computation $hGetChar hdl$ reads the next character from handle
172 {\em hdl}, blocking until a character is available.
175 --hGetChar :: Handle -> IO Char
178 readHandle handle >>= \ htype ->
180 ErrorHandle ioError ->
181 writeHandle handle htype >>
184 writeHandle handle htype >>
185 ioe_closedHandle handle
186 SemiClosedHandle _ _ ->
187 writeHandle handle htype >>
188 ioe_closedHandle handle
189 AppendHandle _ _ _ ->
190 writeHandle handle htype >>
191 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
193 writeHandle handle htype >>
194 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
196 _ccall_ fileGetc (filePtr other) `thenIO_Prim` \ intc ->
197 writeHandle handle (markHandle htype) >>
198 if intc /= ``EOF'' then
201 constructErrorAndFail "hGetChar"
203 hGetLine :: Handle -> IO String
205 hGetChar h >>= \ c ->
209 hGetLine h >>= \ s -> return (c:s)
212 Computation $hLookahead hdl$ returns the next character from handle
213 {\em hdl} without removing it from the input buffer, blocking until a
214 character is available.
217 --hLookAhead :: Handle -> IO Char
220 readHandle handle >>= \ htype ->
222 ErrorHandle ioError ->
223 writeHandle handle htype >>
226 writeHandle handle htype >>
227 ioe_closedHandle handle
228 SemiClosedHandle _ _ ->
229 writeHandle handle htype >>
230 ioe_closedHandle handle
231 AppendHandle _ _ _ ->
232 writeHandle handle htype >>
233 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
235 writeHandle handle htype >>
236 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
238 _ccall_ fileLookAhead (filePtr other) `thenIO_Prim` \ intc ->
239 writeHandle handle (markHandle htype) >>
240 if intc /= ``EOF'' then
243 constructErrorAndFail "hLookAhead"
247 %*********************************************************
249 \subsection{Getting the entire contents of a handle}
251 %*********************************************************
253 Computation $hGetContents hdl$ returns the list of characters
254 corresponding to the unread portion of the channel or file managed by
255 {\em hdl}, which is made semi-closed.
258 --hGetContents :: Handle -> IO String
260 hGetContents handle =
261 readHandle handle >>= \ htype ->
263 ErrorHandle ioError ->
264 writeHandle handle htype >>
267 writeHandle handle htype >>
268 ioe_closedHandle handle
269 SemiClosedHandle _ _ ->
270 writeHandle handle htype >>
271 ioe_closedHandle handle
272 AppendHandle _ _ _ ->
273 writeHandle handle htype >>
274 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
276 writeHandle handle htype >>
277 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
280 To avoid introducing an extra layer of buffering here,
281 we provide three lazy read methods, based on character,
282 line, and block buffering.
284 stToIO (getBufferMode other) >>= \ other ->
285 case (bufferMode other) of
286 Just LineBuffering ->
287 allocBuf Nothing >>= \ buf_info ->
288 writeHandle handle (SemiClosedHandle (filePtr other) buf_info)
290 unsafeInterleavePrimIO (lazyReadLine handle)
291 `thenIO_Prim` \ contents ->
294 Just (BlockBuffering size) ->
295 allocBuf size >>= \ buf_info ->
296 writeHandle handle (SemiClosedHandle (filePtr other) buf_info)
298 unsafeInterleavePrimIO (lazyReadBlock handle)
299 `thenIO_Prim` \ contents ->
301 _ -> -- Nothing is treated pessimistically as NoBuffering
302 writeHandle handle (SemiClosedHandle (filePtr other) (``NULL'', 0))
304 unsafeInterleavePrimIO (lazyReadChar handle)
305 `thenIO_Prim` \ contents ->
308 allocBuf :: Maybe Int -> IO (Addr, Int)
310 _ccall_ malloc size `thenIO_Prim` \ buf ->
311 if buf /= ``NULL'' then
314 fail (IOError Nothing ResourceExhausted "not enough virtual memory")
319 Nothing -> ``BUFSIZ''
322 Note that someone may yank our handle out from under us, and then re-use
323 the same FILE * for something else. Therefore, we have to re-examine the
324 handle every time through.
327 lazyReadBlock :: Handle -> PrimIO String
328 lazyReadLine :: Handle -> PrimIO String
329 lazyReadChar :: Handle -> PrimIO String
331 lazyReadBlock handle =
332 ioToST (readHandle handle) >>= \ htype ->
334 -- There cannae be an ErrorHandle here
336 ioToST (writeHandle handle htype) >>
338 SemiClosedHandle fp (buf, size) ->
339 _ccall_ readBlock buf fp size >>= \ bytes ->
342 else unpackNBytesST buf bytes) >>= \ some ->
344 _ccall_ free buf >>= \ () ->
345 _ccall_ closeFile fp >>
347 writeForeignObj fp ``NULL'' >>
348 ioToST (writeHandle handle (SemiClosedHandle fp (``NULL'', 0))) >>
350 ioToST (writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0))) >>
354 ioToST (writeHandle handle htype) >>
355 unsafeInterleavePrimIO (lazyReadBlock handle)
357 returnPrimIO (some ++ more)
359 lazyReadLine handle =
360 ioToST (readHandle handle) >>= \ htype ->
362 -- There cannae be an ErrorHandle here
364 ioToST (writeHandle handle htype) >>
366 SemiClosedHandle fp (buf, size) ->
367 _ccall_ readLine buf fp size >>= \ bytes ->
370 else unpackNBytesST buf bytes) >>= \ some ->
372 _ccall_ free buf >>= \ () ->
373 _ccall_ closeFile fp >>
375 writeForeignObj fp ``NULL'' >>
376 ioToST (writeHandle handle (SemiClosedHandle fp (``NULL'', 0))) >>
378 ioToST (writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0))) >>
382 ioToST (writeHandle handle htype) >>
383 unsafeInterleavePrimIO (lazyReadLine handle)
385 return (some ++ more)
387 lazyReadChar handle =
388 ioToST (readHandle handle) >>= \ htype ->
390 -- There cannae be an ErrorHandle here
392 ioToST (writeHandle handle htype) >>
394 SemiClosedHandle fp buf_info ->
395 _ccall_ readChar fp >>= \ char ->
396 if char == ``EOF'' then
397 _ccall_ closeFile fp >>
399 writeForeignObj fp ``NULL'' >>
400 ioToST (writeHandle handle (SemiClosedHandle fp (``NULL'', 0))) >>
402 ioToST (writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0))) >>
406 ioToST (writeHandle handle htype) >>
407 unsafeInterleavePrimIO (lazyReadChar handle)
409 returnPrimIO (chr char : more)
414 %*********************************************************
416 \subsection{Simple output functions}
418 %*********************************************************
420 Computation $hPutChar hdl c$ writes the character {\em c} to the file
421 or channel managed by {\em hdl}. Characters may be buffered if
422 buffering is enabled for {\em hdl}.
425 --hPutChar :: Handle -> Char -> IO ()
428 readHandle handle >>= \ htype ->
430 ErrorHandle ioError ->
431 writeHandle handle htype >>
434 writeHandle handle htype >>
435 ioe_closedHandle handle
436 SemiClosedHandle _ _ ->
437 writeHandle handle htype >>
438 ioe_closedHandle handle
440 writeHandle handle htype >>
441 fail (IOError (Just handle) IllegalOperation "handle is not open for writing")
443 _ccall_ filePutc (filePtr other) (ord c) `thenIO_Prim` \ rc ->
444 writeHandle handle (markHandle htype) >>
448 constructErrorAndFail "hPutChar"
451 Computation $hPutStr hdl s$ writes the string {\em s} to the file or
452 channel managed by {\em hdl}.
455 --hPutStr :: Handle -> String -> IO ()
458 readHandle handle >>= \ htype ->
460 ErrorHandle ioError ->
461 writeHandle handle htype >>
464 writeHandle handle htype >>
465 ioe_closedHandle handle
466 SemiClosedHandle _ _ ->
467 writeHandle handle htype >>
468 ioe_closedHandle handle
470 writeHandle handle htype >>
471 fail (IOError (Just handle) IllegalOperation "handle is not open for writing")
474 The code below is not correct for line-buffered terminal streams,
475 as the output stream is not flushed when terminal input is requested
476 again, just upon seeing a newline character. A temporary fix for the
477 most common line-buffered output stream, stdout, is to assume the
478 buffering it was given when created (no buffering). This is not
479 as bad as it looks, since stdio buffering sits underneath this.
483 getBufferMode other `thenIO_Prim` \ other ->
484 (case bufferMode other of
485 Just LineBuffering ->
486 writeChars (filePtr other) str
487 --writeLines (filePtr other) str
488 Just (BlockBuffering (Just size)) ->
489 writeBlocks (filePtr other) size str
490 Just (BlockBuffering Nothing) ->
491 writeBlocks (filePtr other) ``BUFSIZ'' str
492 _ -> -- Nothing is treated pessimistically as NoBuffering
493 writeChars (filePtr other) str
494 ) `thenIO_Prim` \ success ->
495 writeHandle handle (markHandle other) >>
499 constructErrorAndFail "hPutStr"
502 writeLines :: ForeignObj -> String -> PrimIO Bool
504 writeLines :: Addr -> String -> PrimIO Bool
506 writeLines = writeChunks ``BUFSIZ'' True
509 writeBlocks :: ForeignObj -> Int -> String -> PrimIO Bool
511 writeBlocks :: Addr -> Int -> String -> PrimIO Bool
513 writeBlocks fp size s = writeChunks size False fp s
516 The breaking up of output into lines along \n boundaries
517 works fine as long as there are newlines to split by.
518 Avoid the splitting up into lines alltogether (doesn't work
519 for overly long lines like the stuff that showsPrec instances
520 normally return). Instead, we split them up into fixed size
521 chunks before blasting them off to the Real World.
523 Hacked to avoid multiple passes over the strings - unsightly, but
524 a whole lot quicker. -- SOF 3/96
528 writeChunks :: Int -> Bool -> ForeignObj -> String -> PrimIO Bool
530 writeChunks :: Int -> Bool -> Addr -> String -> PrimIO Bool
532 writeChunks (I# bufLen) chopOnNewLine fp s =
533 newCharArray (0,I# bufLen) >>= \ arr@(MutableByteArray _ arr#) ->
535 write_char :: MutableByteArray# RealWorld -> Int# -> Char# -> PrimIO ()
536 write_char arr# n x = ST $ \ (S# s#) ->
537 case (writeCharArray# arr# n x s#) of { s1# ->
540 shoveString :: Int# -> [Char] -> PrimIO Bool
547 _ccall_ writeFile arr fp (I# n) >>= \rc ->
551 write_char arr# n x >>
553 {- Flushing lines - should we bother? Yes, for line-buffered output. -}
554 if n ==# bufLen || (chopOnNewLine && (x `eqChar#` '\n'#)) then
555 _ccall_ writeFile arr fp (I# (n +# 1#)) >>= \ rc ->
561 shoveString (n +# 1#) xs
566 writeChars :: ForeignObj -> String -> PrimIO Bool
568 writeChars :: Addr -> String -> PrimIO Bool
570 writeChars fp "" = returnPrimIO True
571 writeChars fp (c:cs) =
572 _ccall_ filePutc fp (ord c) >>= \ rc ->
579 Computation $hPrint hdl t$ writes the string representation of {\em t}
580 given by the $shows$ function to the file or channel managed by {\em
583 SOF 2/97: Seem to have disappeared in 1.4 libs.
586 --hPrint :: Show a => Handle -> a -> IO ()
587 hPrint hdl = hPutStr hdl . show
590 Derived action @hPutStrLn hdl str@ writes the string \tr{str} to
591 the handle \tr{hdl}, adding a newline at the end.
594 --hPutStrLn :: Handle -> String -> IO ()
595 hPutStrLn hndl str = do
602 %*********************************************************
604 \subsection{Try and bracket}
606 %*********************************************************
608 The construct $try comp$ exposes errors which occur within a
609 computation, and which are not fully handled. It always succeeds.
612 try :: IO a -> IO (Either IOError a)
613 try f = catch (do r <- f
617 bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
618 bracket before after m = do
626 -- variant of the above where middle computation doesn't want x
627 bracket_ :: IO a -> (a -> IO b) -> IO c -> IO c
628 bracket_ before after m = do