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 PackedString ( nilPS, packCBytesST, unpackPS )
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>>"}
123 %*********************************************************
125 \subsection{Simple input operations}
127 %*********************************************************
129 Computation @hReady hdl@ indicates whether at least
130 one item is available for input from handle {\em hdl}.
132 @hWaitForInput@ is the generalisation, wait for \tr{n} seconds
133 before deciding whether the Handle has run dry or not.
136 --hReady :: Handle -> IO Bool
137 hReady h = hWaitForInput h 0
139 --hWaitForInput :: Handle -> Int -> IO Bool
140 hWaitForInput handle nsecs =
141 readHandle handle >>= \ htype ->
143 ErrorHandle ioError ->
144 writeHandle handle htype >>
147 writeHandle handle htype >>
148 ioe_closedHandle handle
149 SemiClosedHandle _ _ ->
150 writeHandle handle htype >>
151 ioe_closedHandle handle
152 AppendHandle _ _ _ ->
153 writeHandle handle htype >>
154 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
156 writeHandle handle htype >>
157 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
159 _ccall_ inputReady (filePtr other) nsecs `thenIO_Prim` \ rc ->
160 writeHandle handle (markHandle htype) >>
164 _ -> constructErrorAndFail "hWaitForInput"
167 Computation $hGetChar hdl$ reads the next character from handle
168 {\em hdl}, blocking until a character is available.
171 --hGetChar :: Handle -> IO Char
174 readHandle handle >>= \ htype ->
176 ErrorHandle ioError ->
177 writeHandle handle htype >>
180 writeHandle handle htype >>
181 ioe_closedHandle handle
182 SemiClosedHandle _ _ ->
183 writeHandle handle htype >>
184 ioe_closedHandle handle
185 AppendHandle _ _ _ ->
186 writeHandle handle htype >>
187 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
189 writeHandle handle htype >>
190 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
192 _ccall_ fileGetc (filePtr other) `thenIO_Prim` \ intc ->
193 writeHandle handle (markHandle htype) >>
194 if intc /= ``EOF'' then
197 constructErrorAndFail "hGetChar"
199 hGetLine :: Handle -> IO String
201 hGetChar h >>= \ c ->
205 hGetLine h >>= \ s -> return (c:s)
208 Computation $hLookahead hdl$ returns the next character from handle
209 {\em hdl} without removing it from the input buffer, blocking until a
210 character is available.
213 --hLookAhead :: Handle -> IO Char
216 readHandle handle >>= \ htype ->
218 ErrorHandle ioError ->
219 writeHandle handle htype >>
222 writeHandle handle htype >>
223 ioe_closedHandle handle
224 SemiClosedHandle _ _ ->
225 writeHandle handle htype >>
226 ioe_closedHandle handle
227 AppendHandle _ _ _ ->
228 writeHandle handle htype >>
229 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
231 writeHandle handle htype >>
232 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
234 _ccall_ fileLookAhead (filePtr other) `thenIO_Prim` \ intc ->
235 writeHandle handle (markHandle htype) >>
236 if intc /= ``EOF'' then
239 constructErrorAndFail "hLookAhead"
243 %*********************************************************
245 \subsection{Getting the entire contents of a handle}
247 %*********************************************************
249 Computation $hGetContents hdl$ returns the list of characters
250 corresponding to the unread portion of the channel or file managed by
251 {\em hdl}, which is made semi-closed.
254 --hGetContents :: Handle -> IO String
256 hGetContents handle =
257 readHandle handle >>= \ htype ->
259 ErrorHandle ioError ->
260 writeHandle handle htype >>
263 writeHandle handle htype >>
264 ioe_closedHandle handle
265 SemiClosedHandle _ _ ->
266 writeHandle handle htype >>
267 ioe_closedHandle handle
268 AppendHandle _ _ _ ->
269 writeHandle handle htype >>
270 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
272 writeHandle handle htype >>
273 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
276 To avoid introducing an extra layer of buffering here,
277 we provide three lazy read methods, based on character,
278 line, and block buffering.
280 stToIO (getBufferMode other) >>= \ other ->
281 case (bufferMode other) of
282 Just LineBuffering ->
283 allocBuf Nothing >>= \ buf_info ->
284 writeHandle handle (SemiClosedHandle (filePtr other) buf_info)
286 unsafeInterleavePrimIO (lazyReadLine handle)
287 `thenIO_Prim` \ contents ->
290 Just (BlockBuffering size) ->
291 allocBuf size >>= \ buf_info ->
292 writeHandle handle (SemiClosedHandle (filePtr other) buf_info)
294 unsafeInterleavePrimIO (lazyReadBlock handle)
295 `thenIO_Prim` \ contents ->
297 _ -> -- Nothing is treated pessimistically as NoBuffering
298 writeHandle handle (SemiClosedHandle (filePtr other) (``NULL'', 0))
300 unsafeInterleavePrimIO (lazyReadChar handle)
301 `thenIO_Prim` \ contents ->
304 allocBuf :: Maybe Int -> IO (Addr, Int)
306 _ccall_ malloc size `thenIO_Prim` \ buf ->
307 if buf /= ``NULL'' then
310 fail (IOError Nothing ResourceExhausted "not enough virtual memory")
315 Nothing -> ``BUFSIZ''
318 Note that someone may yank our handle out from under us, and then re-use
319 the same FILE * for something else. Therefore, we have to re-examine the
320 handle every time through.
323 lazyReadBlock :: Handle -> PrimIO String
324 lazyReadLine :: Handle -> PrimIO String
325 lazyReadChar :: Handle -> PrimIO String
327 lazyReadBlock handle =
328 ioToST (readHandle handle) >>= \ htype ->
330 -- There cannae be an ErrorHandle here
332 ioToST (writeHandle handle htype) >>
334 SemiClosedHandle fp (buf, size) ->
335 _ccall_ readBlock buf fp size >>= \ bytes ->
338 else packCBytesST bytes buf) >>= \ some ->
340 _ccall_ free buf >>= \ () ->
341 _ccall_ closeFile fp >>
343 writeForeignObj fp ``NULL'' >>
344 ioToST (writeHandle handle (SemiClosedHandle fp (``NULL'', 0))) >>
346 ioToST (writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0))) >>
348 returnPrimIO (unpackPS some)
350 ioToST (writeHandle handle htype) >>
351 unsafeInterleavePrimIO (lazyReadBlock handle)
353 returnPrimIO (unpackPS some ++ more)
355 lazyReadLine handle =
356 ioToST (readHandle handle) >>= \ htype ->
358 -- There cannae be an ErrorHandle here
360 ioToST (writeHandle handle htype) >>
362 SemiClosedHandle fp (buf, size) ->
363 _ccall_ readLine buf fp size >>= \ bytes ->
366 else packCBytesST bytes buf) >>= \ some ->
368 _ccall_ free buf >>= \ () ->
369 _ccall_ closeFile fp >>
371 writeForeignObj fp ``NULL'' >>
372 ioToST (writeHandle handle (SemiClosedHandle fp (``NULL'', 0))) >>
374 ioToST (writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0))) >>
376 returnPrimIO (unpackPS some)
378 ioToST (writeHandle handle htype) >>
379 unsafeInterleavePrimIO (lazyReadLine handle)
381 returnPrimIO (unpackPS some ++ more)
383 lazyReadChar handle =
384 ioToST (readHandle handle) >>= \ htype ->
386 -- There cannae be an ErrorHandle here
388 ioToST (writeHandle handle htype) >>
390 SemiClosedHandle fp buf_info ->
391 _ccall_ readChar fp >>= \ char ->
392 if char == ``EOF'' then
393 _ccall_ closeFile fp >>
395 writeForeignObj fp ``NULL'' >>
396 ioToST (writeHandle handle (SemiClosedHandle fp (``NULL'', 0))) >>
398 ioToST (writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0))) >>
402 ioToST (writeHandle handle htype) >>
403 unsafeInterleavePrimIO (lazyReadChar handle)
405 returnPrimIO (chr char : more)
410 %*********************************************************
412 \subsection{Simple output functions}
414 %*********************************************************
416 Computation $hPutChar hdl c$ writes the character {\em c} to the file
417 or channel managed by {\em hdl}. Characters may be buffered if
418 buffering is enabled for {\em hdl}.
421 --hPutChar :: Handle -> Char -> IO ()
424 readHandle handle >>= \ htype ->
426 ErrorHandle ioError ->
427 writeHandle handle htype >>
430 writeHandle handle htype >>
431 ioe_closedHandle handle
432 SemiClosedHandle _ _ ->
433 writeHandle handle htype >>
434 ioe_closedHandle handle
436 writeHandle handle htype >>
437 fail (IOError (Just handle) IllegalOperation "handle is not open for writing")
439 _ccall_ filePutc (filePtr other) (ord c) `thenIO_Prim` \ rc ->
440 writeHandle handle (markHandle htype) >>
444 constructErrorAndFail "hPutChar"
447 Computation $hPutStr hdl s$ writes the string {\em s} to the file or
448 channel managed by {\em hdl}.
451 --hPutStr :: Handle -> String -> IO ()
454 readHandle handle >>= \ htype ->
456 ErrorHandle ioError ->
457 writeHandle handle htype >>
460 writeHandle handle htype >>
461 ioe_closedHandle handle
462 SemiClosedHandle _ _ ->
463 writeHandle handle htype >>
464 ioe_closedHandle handle
466 writeHandle handle htype >>
467 fail (IOError (Just handle) IllegalOperation "handle is not open for writing")
470 The code below is not correct for line-buffered terminal streams,
471 as the output stream is not flushed when terminal input is requested
472 again, just upon seeing a newline character. A temporary fix for the
473 most common line-buffered output stream, stdout, is to assume the
474 buffering it was given when created (no buffering). This is not
475 as bad as it looks, since stdio buffering sits underneath this.
479 getBufferMode other `thenIO_Prim` \ other ->
480 (case bufferMode other of
481 Just LineBuffering ->
482 writeChars (filePtr other) str
483 --writeLines (filePtr other) str
484 Just (BlockBuffering (Just size)) ->
485 writeBlocks (filePtr other) size str
486 Just (BlockBuffering Nothing) ->
487 writeBlocks (filePtr other) ``BUFSIZ'' str
488 _ -> -- Nothing is treated pessimistically as NoBuffering
489 writeChars (filePtr other) str
490 ) `thenIO_Prim` \ success ->
491 writeHandle handle (markHandle other) >>
495 constructErrorAndFail "hPutStr"
498 writeLines :: ForeignObj -> String -> PrimIO Bool
500 writeLines :: Addr -> String -> PrimIO Bool
502 writeLines = writeChunks ``BUFSIZ'' True
505 writeBlocks :: ForeignObj -> Int -> String -> PrimIO Bool
507 writeBlocks :: Addr -> Int -> String -> PrimIO Bool
509 writeBlocks fp size s = writeChunks size False fp s
512 The breaking up of output into lines along \n boundaries
513 works fine as long as there are newlines to split by.
514 Avoid the splitting up into lines alltogether (doesn't work
515 for overly long lines like the stuff that showsPrec instances
516 normally return). Instead, we split them up into fixed size
517 chunks before blasting them off to the Real World.
519 Hacked to avoid multiple passes over the strings - unsightly, but
520 a whole lot quicker. -- SOF 3/96
524 writeChunks :: Int -> Bool -> ForeignObj -> String -> PrimIO Bool
526 writeChunks :: Int -> Bool -> Addr -> String -> PrimIO Bool
528 writeChunks (I# bufLen) chopOnNewLine fp s =
529 newCharArray (0,I# bufLen) >>= \ arr@(MutableByteArray _ arr#) ->
531 write_char :: MutableByteArray# RealWorld -> Int# -> Char# -> PrimIO ()
532 write_char arr# n x = ST $ \ (S# s#) ->
533 case (writeCharArray# arr# n x s#) of { s1# ->
536 shoveString :: Int# -> [Char] -> PrimIO Bool
543 _ccall_ writeFile arr fp (I# n) >>= \rc ->
547 write_char arr# n x >>
549 {- Flushing lines - should we bother? Yes, for line-buffered output. -}
550 if n ==# bufLen || (chopOnNewLine && (x `eqChar#` '\n'#)) then
551 _ccall_ writeFile arr fp (I# (n +# 1#)) >>= \ rc ->
557 shoveString (n +# 1#) xs
562 writeChars :: ForeignObj -> String -> PrimIO Bool
564 writeChars :: Addr -> String -> PrimIO Bool
566 writeChars fp "" = returnPrimIO True
567 writeChars fp (c:cs) =
568 _ccall_ filePutc fp (ord c) >>= \ rc ->
575 Computation $hPrint hdl t$ writes the string representation of {\em t}
576 given by the $shows$ function to the file or channel managed by {\em
579 SOF 2/97: Seem to have disappeared in 1.4 libs.
582 --hPrint :: Show a => Handle -> a -> IO ()
583 hPrint hdl = hPutStr hdl . show
586 Derived action @hPutStrLn hdl str@ writes the string \tr{str} to
587 the handle \tr{hdl}, adding a newline at the end.
590 --hPutStrLn :: Handle -> String -> IO ()
591 hPutStrLn hndl str = do
598 %*********************************************************
600 \subsection{Try and bracket}
602 %*********************************************************
604 The construct $try comp$ exposes errors which occur within a
605 computation, and which are not fully handled. It always succeeds.
608 try :: IO a -> IO (Either IOError a)
609 try f = catch (do r <- f
613 bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
614 bracket before after m = do
622 -- variant of the above where middle computation doesn't want x
623 bracket_ :: IO a -> (a -> IO b) -> IO c -> IO c
624 bracket_ before after m = do