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_
36 import PrelUnsafe ( unsafePerformIO, unsafeInterleaveIO )
38 import PrelArr ( MutableByteArray(..), newCharArray )
39 import PrelHandle -- much of the real stuff is in here
40 import PrelPack ( unpackNBytesST )
42 import PrelRead ( readParen, Read(..), reads, lex )
48 #ifndef __PARALLEL_HASKELL__
49 import PrelForeign ( ForeignObj, makeForeignObj, writeForeignObj )
53 import Char ( ord, chr )
56 %*********************************************************
58 \subsection{Signatures}
60 %*********************************************************
63 --IOHandle:hClose :: Handle -> IO ()
64 --IOHandle:hFileSize :: Handle -> IO Integer
65 --IOHandle:hFlush :: Handle -> IO ()
66 --IOHandle:hGetBuffering :: Handle -> IO BufferMode
67 hGetChar :: Handle -> IO Char
68 hGetContents :: Handle -> IO String
69 --IOHandle:hGetPosn :: Handle -> IO HandlePosn
70 --IOHandle:hIsClosed :: Handle -> IO Bool
71 --IOHandle:hIsEOF :: Handle -> IO Bool
72 --IOHandle:hIsOpen :: Handle -> IO Bool
73 --IOHandle:hIsReadable :: Handle -> IO Bool
74 --IOHandle:hIsSeekable :: Handle -> IO Bool
75 --IOHandle:hIsWritable :: Handle -> IO Bool
76 hLookAhead :: Handle -> IO Char
77 hPrint :: Show a => Handle -> a -> IO ()
78 hPutChar :: Handle -> Char -> IO ()
79 hPutStr :: Handle -> String -> IO ()
80 hPutStrLn :: Handle -> String -> IO ()
81 hReady :: Handle -> IO Bool
82 hWaitForInput :: Handle -> Int -> IO Bool
84 --IOHandle:hSeek :: Handle -> SeekMode -> Integer -> IO ()
85 --IOHandle:hSetBuffering :: Handle -> BufferMode -> IO ()
86 --IOHandle:hSetPosn :: HandlePosn -> IO ()
87 -- ioeGetFileName :: IOError -> Maybe FilePath
88 -- ioeGetErrorString :: IOError -> Maybe String
89 -- ioeGetHandle :: IOError -> Maybe Handle
90 -- isAlreadyExistsError :: IOError -> Bool
91 -- isAlreadyInUseError :: IOError -> Bool
92 --IOHandle:isEOF :: IO Bool
93 -- isEOFError :: IOError -> Bool
94 -- isFullError :: IOError -> Bool
95 -- isIllegalOperation :: IOError -> Bool
96 -- isPermissionError :: IOError -> Bool
97 -- isUserError :: IOError -> Bool
98 --IOHandle:openFile :: FilePath -> IOMode -> IO Handle
99 --IOHandle:stdin, stdout, stderr :: Handle
102 Standard instances for @Handle@:
105 instance Eq IOError where
106 (IOError h1 e1 str1) == (IOError h2 e2 str2) =
107 e1==e2 && str1==str2 && h1==h2
109 #ifndef __CONCURRENT_HASKELL__
111 instance Eq Handle where
112 (Handle h1) == (Handle h2) = h1 == h2
116 {- OLD equality instance. The simpler one above
117 seems more accurate! This one is still used for concurrent haskell,
118 since there's no equality instance over MVars.
121 instance Eq Handle where
130 (ErrorHandle (IOError h1 _ _), ErrorHandle (IOError h2 _ _)) -> h1 == h2
131 (ClosedHandle, ClosedHandle) -> True
132 (SemiClosedHandle v1 _, SemiClosedHandle v2 _) -> v1 == v2
133 (ReadHandle v1 _ _ , ReadHandle v2 _ _) -> v1 == v2
134 (WriteHandle v1 _ _ , WriteHandle v2 _ _) -> v1 == v2
135 (AppendHandle v1 _ _ , AppendHandle v2 _ _) -> v1 == v2
136 (ReadWriteHandle v1 _ _ , ReadWriteHandle v2 _ _) -> v1 == v2
141 instance Show Handle where {showsPrec p h = showString "<<Handle>>"}
143 --Type declared in IOHandle, instance here because it depends on Eq.Handle
144 instance Eq HandlePosn where
145 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
147 -- Type declared in IOBase, instance here because it
148 -- depends on PrelRead.(Read Maybe) instance.
149 instance Read BufferMode where
152 (\r -> let lr = lex r
154 [(NoBuffering, rest) | ("NoBuffering", rest) <- lr] ++
155 [(LineBuffering,rest) | ("LineBuffering",rest) <- lr] ++
156 [(BlockBuffering mb,rest2) | ("BlockBuffering",rest1) <- lr,
157 (mb, rest2) <- reads rest1])
161 %*********************************************************
163 \subsection{Simple input operations}
165 %*********************************************************
167 Computation @hReady hdl@ indicates whether at least
168 one item is available for input from handle {\em hdl}.
170 @hWaitForInput@ is the generalisation, wait for \tr{n} seconds
171 before deciding whether the Handle has run dry or not.
174 --hReady :: Handle -> IO Bool
175 hReady h = hWaitForInput h 0
177 --hWaitForInput :: Handle -> Int -> IO Bool
178 hWaitForInput handle nsecs = do
179 htype <- readHandle handle
181 ErrorHandle ioError -> do
182 writeHandle handle htype
185 writeHandle handle htype
186 ioe_closedHandle handle
187 SemiClosedHandle _ _ -> do
188 writeHandle handle htype
189 ioe_closedHandle handle
190 AppendHandle _ _ _ -> do
191 writeHandle handle htype
192 fail (IOError (Just handle) IllegalOperation
193 "handle is not open for reading")
194 WriteHandle _ _ _ -> do
195 writeHandle handle htype
196 fail (IOError (Just handle) IllegalOperation
197 "handle is not open for reading")
199 rc <- _ccall_ inputReady (filePtr other) nsecs
200 writeHandle handle (markHandle htype)
204 _ -> constructErrorAndFail "hWaitForInput"
207 Computation $hGetChar hdl$ reads the next character from handle
208 {\em hdl}, blocking until a character is available.
211 --hGetChar :: Handle -> IO Char
214 htype <- readHandle handle
216 ErrorHandle ioError ->
217 writeHandle handle htype >>
220 writeHandle handle htype >>
221 ioe_closedHandle handle
222 SemiClosedHandle _ _ ->
223 writeHandle handle htype >>
224 ioe_closedHandle handle
225 AppendHandle _ _ _ ->
226 writeHandle handle htype >>
227 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
229 writeHandle handle htype >>
230 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
232 intc <- _ccall_ fileGetc (filePtr other)
233 writeHandle handle (markHandle htype)
234 if intc /= ``EOF'' then
237 constructErrorAndFail "hGetChar"
239 hGetLine :: Handle -> IO String
241 hGetChar h >>= \ c ->
245 hGetLine h >>= \ s -> return (c:s)
248 Computation $hLookahead hdl$ returns the next character from handle
249 {\em hdl} without removing it from the input buffer, blocking until a
250 character is available.
253 --hLookAhead :: Handle -> IO Char
256 readHandle handle >>= \ htype ->
258 ErrorHandle ioError ->
259 writeHandle handle htype >>
262 writeHandle handle htype >>
263 ioe_closedHandle handle
264 SemiClosedHandle _ _ ->
265 writeHandle handle htype >>
266 ioe_closedHandle handle
267 AppendHandle _ _ _ ->
268 writeHandle handle htype >>
269 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
271 writeHandle handle htype >>
272 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
274 intc <- _ccall_ fileLookAhead (filePtr other)
275 writeHandle handle (markHandle htype)
276 if intc /= ``EOF'' then
279 constructErrorAndFail "hLookAhead"
283 %*********************************************************
285 \subsection{Getting the entire contents of a handle}
287 %*********************************************************
289 Computation $hGetContents hdl$ returns the list of characters
290 corresponding to the unread portion of the channel or file managed by
291 {\em hdl}, which is made semi-closed.
294 --hGetContents :: Handle -> IO String
296 hGetContents handle =
297 readHandle handle >>= \ htype ->
299 ErrorHandle ioError ->
300 writeHandle handle htype >>
303 writeHandle handle htype >>
304 ioe_closedHandle handle
305 SemiClosedHandle _ _ ->
306 writeHandle handle htype >>
307 ioe_closedHandle handle
308 AppendHandle _ _ _ ->
309 writeHandle handle htype >>
310 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
312 writeHandle handle htype >>
313 fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
316 To avoid introducing an extra layer of buffering here,
317 we provide three lazy read methods, based on character,
318 line, and block buffering.
320 getBufferMode other >>= \ other ->
321 case (bufferMode other) of
322 Just LineBuffering ->
323 allocBuf Nothing >>= \ buf_info ->
324 writeHandle handle (SemiClosedHandle (filePtr other) buf_info)
326 unsafeInterleaveIO (lazyReadLine handle)
330 Just (BlockBuffering size) ->
331 allocBuf size >>= \ buf_info ->
332 writeHandle handle (SemiClosedHandle (filePtr other) buf_info)
334 unsafeInterleaveIO (lazyReadBlock handle)
337 _ -> -- Nothing is treated pessimistically as NoBuffering
338 writeHandle handle (SemiClosedHandle (filePtr other) (``NULL'', 0))
340 unsafeInterleaveIO (lazyReadChar handle) >>= \ contents ->
343 allocBuf :: Maybe Int -> IO (Addr, Int)
345 _ccall_ malloc size >>= \ buf ->
346 if buf /= ``NULL'' then
349 fail (IOError Nothing ResourceExhausted "not enough virtual memory")
354 Nothing -> ``BUFSIZ''
357 Note that someone may yank our handle out from under us, and then re-use
358 the same FILE * for something else. Therefore, we have to re-examine the
359 handle every time through.
362 lazyReadBlock :: Handle -> IO String
363 lazyReadLine :: Handle -> IO String
364 lazyReadChar :: Handle -> IO String
366 lazyReadBlock handle =
367 readHandle handle >>= \ htype ->
369 -- There cannae be an ErrorHandle here
371 writeHandle handle htype >>
373 SemiClosedHandle fp (buf, size) ->
374 _ccall_ readBlock buf fp size >>= \ bytes ->
377 else stToIO (unpackNBytesST buf bytes)) >>= \ some ->
379 _ccall_ free buf >>= \ () ->
380 _ccall_ closeFile fp >>
381 #ifndef __PARALLEL_HASKELL__
382 writeForeignObj fp ``NULL'' >>
383 writeHandle handle (SemiClosedHandle fp (``NULL'', 0)) >>
385 writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0)) >>
389 writeHandle handle htype >>
390 unsafeInterleaveIO (lazyReadBlock handle) >>= \ more ->
391 return (some ++ more)
393 lazyReadLine handle =
394 readHandle handle >>= \ htype ->
396 -- There cannae be an ErrorHandle here
398 writeHandle handle htype >>
400 SemiClosedHandle fp (buf, size) ->
401 _ccall_ readLine buf fp size >>= \ bytes ->
404 else stToIO (unpackNBytesST buf bytes)) >>= \ some ->
406 _ccall_ free buf >>= \ () ->
407 _ccall_ closeFile fp >>
408 #ifndef __PARALLEL_HASKELL__
409 writeForeignObj fp ``NULL'' >>
410 writeHandle handle (SemiClosedHandle fp (``NULL'', 0)) >>
412 writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0)) >>
416 writeHandle handle htype >>
417 unsafeInterleaveIO (lazyReadLine handle)
419 return (some ++ more)
421 lazyReadChar handle =
422 readHandle handle >>= \ htype ->
424 -- There cannae be an ErrorHandle here
426 writeHandle handle htype >>
428 SemiClosedHandle fp buf_info ->
429 _ccall_ readChar fp >>= \ char ->
430 if char == ``EOF'' then
431 _ccall_ closeFile fp >>
432 #ifndef __PARALLEL_HASKELL__
433 writeForeignObj fp ``NULL'' >>
434 writeHandle handle (SemiClosedHandle fp (``NULL'', 0)) >>
436 writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0)) >>
440 writeHandle handle htype >>
441 unsafeInterleaveIO (lazyReadChar handle) >>= \ more ->
442 return (chr char : more)
447 %*********************************************************
449 \subsection{Simple output functions}
451 %*********************************************************
453 Computation $hPutChar hdl c$ writes the character {\em c} to the file
454 or channel managed by {\em hdl}. Characters may be buffered if
455 buffering is enabled for {\em hdl}.
458 --hPutChar :: Handle -> Char -> IO ()
461 readHandle handle >>= \ htype ->
463 ErrorHandle ioError ->
464 writeHandle handle htype >>
467 writeHandle handle htype >>
468 ioe_closedHandle handle
469 SemiClosedHandle _ _ ->
470 writeHandle handle htype >>
471 ioe_closedHandle handle
473 writeHandle handle htype >>
474 fail (IOError (Just handle) IllegalOperation "handle is not open for writing")
476 _ccall_ filePutc (filePtr other) (ord c) >>= \ rc ->
477 writeHandle handle (markHandle htype) >>
481 constructErrorAndFail "hPutChar"
484 Computation $hPutStr hdl s$ writes the string {\em s} to the file or
485 channel managed by {\em hdl}.
488 --hPutStr :: Handle -> String -> IO ()
491 readHandle handle >>= \ htype ->
493 ErrorHandle ioError ->
494 writeHandle handle htype >>
497 writeHandle handle htype >>
498 ioe_closedHandle handle
499 SemiClosedHandle _ _ ->
500 writeHandle handle htype >>
501 ioe_closedHandle handle
503 writeHandle handle htype >>
504 fail (IOError (Just handle) IllegalOperation "handle is not open for writing")
507 The code below is not correct for line-buffered terminal streams,
508 as the output stream is not flushed when terminal input is requested
509 again, just upon seeing a newline character. A temporary fix for the
510 most common line-buffered output stream, stdout, is to assume the
511 buffering it was given when created (no buffering). This is not
512 as bad as it looks, since stdio buffering sits underneath this.
516 getBufferMode other >>= \ other ->
517 (case bufferMode other of
518 Just LineBuffering ->
519 writeChars (filePtr other) str
520 --writeLines (filePtr other) str
521 Just (BlockBuffering (Just size)) ->
522 writeBlocks (filePtr other) size str
523 Just (BlockBuffering Nothing) ->
524 writeBlocks (filePtr other) ``BUFSIZ'' str
525 _ -> -- Nothing is treated pessimistically as NoBuffering
526 writeChars (filePtr other) str
528 writeHandle handle (markHandle other) >>
532 constructErrorAndFail "hPutStr"
534 #ifndef __PARALLEL_HASKELL__
535 writeLines :: ForeignObj -> String -> IO Bool
537 writeLines :: Addr -> String -> IO Bool
539 writeLines = writeChunks ``BUFSIZ'' True
541 #ifndef __PARALLEL_HASKELL__
542 writeBlocks :: ForeignObj -> Int -> String -> IO Bool
544 writeBlocks :: Addr -> Int -> String -> IO Bool
546 writeBlocks fp size s = writeChunks size False fp s
549 The breaking up of output into lines along \n boundaries
550 works fine as long as there are newlines to split by.
551 Avoid the splitting up into lines alltogether (doesn't work
552 for overly long lines like the stuff that showsPrec instances
553 normally return). Instead, we split them up into fixed size
554 chunks before blasting them off to the Real World.
556 Hacked to avoid multiple passes over the strings - unsightly, but
557 a whole lot quicker. -- SOF 3/96
560 #ifndef __PARALLEL_HASKELL__
561 writeChunks :: Int -> Bool -> ForeignObj -> String -> IO Bool
563 writeChunks :: Int -> Bool -> Addr -> String -> IO Bool
565 writeChunks (I# bufLen) chopOnNewLine fp s =
566 stToIO (newCharArray (0,I# bufLen)) >>= \ arr@(MutableByteArray _ arr#) ->
568 write_char :: MutableByteArray# RealWorld -> Int# -> Char# -> IO ()
569 write_char arr# n x = IO $ \ s# ->
570 case (writeCharArray# arr# n x s#) of { s1# ->
573 shoveString :: Int# -> [Char] -> IO Bool
580 _ccall_ writeFile arr fp (I# n) >>= \rc ->
584 write_char arr# n x >>
586 {- Flushing lines - should we bother? Yes, for line-buffered output. -}
587 if n ==# bufLen || (chopOnNewLine && (x `eqChar#` '\n'#)) then
588 _ccall_ writeFile arr fp (I# (n +# 1#)) >>= \ rc ->
594 shoveString (n +# 1#) xs
598 #ifndef __PARALLEL_HASKELL__
599 writeChars :: ForeignObj -> String -> IO Bool
601 writeChars :: Addr -> String -> IO Bool
603 writeChars fp "" = return True
604 writeChars fp (c:cs) =
605 _ccall_ filePutc fp (ord c) >>= \ rc ->
612 Computation $hPrint hdl t$ writes the string representation of {\em t}
613 given by the $shows$ function to the file or channel managed by {\em
616 SOF 2/97: Seem to have disappeared in 1.4 libs.
619 --hPrint :: Show a => Handle -> a -> IO ()
620 hPrint hdl = hPutStr hdl . show
623 Derived action @hPutStrLn hdl str@ writes the string \tr{str} to
624 the handle \tr{hdl}, adding a newline at the end.
627 --hPutStrLn :: Handle -> String -> IO ()
628 hPutStrLn hndl str = do
635 %*********************************************************
637 \subsection{Try and bracket}
639 %*********************************************************
641 The construct $try comp$ exposes errors which occur within a
642 computation, and which are not fully handled. It always succeeds.
645 try :: IO a -> IO (Either IOError a)
646 try f = catch (do r <- f
650 bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
651 bracket before after m = do
659 -- variant of the above where middle computation doesn't want x
660 bracket_ :: IO a -> (a -> IO b) -> IO c -> IO c
661 bracket_ before after m = do