1 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
2 {-# OPTIONS_GHC -fno-warn-unused-matches #-}
3 {-# OPTIONS_HADDOCK hide #-}
4 {-# LANGUAGE NoImplicitPrelude, RecordWildCards, BangPatterns #-}
6 -----------------------------------------------------------------------------
8 -- Module : GHC.IO.Text
9 -- Copyright : (c) The University of Glasgow, 1992-2008
10 -- License : see libraries/base/LICENSE
12 -- Maintainer : libraries@haskell.org
13 -- Stability : internal
14 -- Portability : non-portable
16 -- String I\/O functions
18 -----------------------------------------------------------------------------
21 module GHC.IO.Handle.Text (
22 hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,
23 commitBuffer', -- hack, see below
24 hGetBuf, hGetBufSome, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking,
31 import qualified GHC.IO.BufferedIO as Buffered
32 import GHC.IO.Exception
34 import GHC.IO.Handle.Types
35 import GHC.IO.Handle.Internals
36 import qualified GHC.IO.Device as IODevice
37 import qualified GHC.IO.Device as RawIO
42 import qualified Control.Exception as Exception
44 import System.IO.Error
55 -- ---------------------------------------------------------------------------
56 -- Simple input operations
58 -- If hWaitForInput finds anything in the Handle's buffer, it
59 -- immediately returns. If not, it tries to read from the underlying
60 -- OS handle. Notice that for buffered Handles connected to terminals
61 -- this means waiting until a complete line is available.
63 -- | Computation 'hWaitForInput' @hdl t@
64 -- waits until input is available on handle @hdl@.
65 -- It returns 'True' as soon as input is available on @hdl@,
66 -- or 'False' if no input is available within @t@ milliseconds. Note that
67 -- 'hWaitForInput' waits until one or more full /characters/ are available,
68 -- which means that it needs to do decoding, and hence may fail
69 -- with a decoding error.
71 -- If @t@ is less than zero, then @hWaitForInput@ waits indefinitely.
73 -- This operation may fail with:
75 -- * 'isEOFError' if the end of file has been reached.
77 -- * a decoding error, if the input begins with an invalid byte sequence
78 -- in this Handle's encoding.
80 -- NOTE for GHC users: unless you use the @-threaded@ flag,
81 -- @hWaitForInput t@ where @t >= 0@ will block all other Haskell
82 -- threads for the duration of the call. It behaves like a
83 -- @safe@ foreign call in this respect.
86 hWaitForInput :: Handle -> Int -> IO Bool
87 hWaitForInput h msecs = do
88 wantReadableHandle_ "hWaitForInput" h $ \ handle_@Handle__{..} -> do
89 cbuf <- readIORef haCharBuffer
91 if not (isEmptyBuffer cbuf) then return True else do
94 then do cbuf' <- readTextDevice handle_ cbuf
95 writeIORef haCharBuffer cbuf'
98 -- there might be bytes in the byte buffer waiting to be decoded
99 cbuf' <- decodeByteBuf handle_ cbuf
100 writeIORef haCharBuffer cbuf'
102 if not (isEmptyBuffer cbuf') then return True else do
104 r <- IODevice.ready haDevice False{-read-} msecs
105 if r then do -- Call hLookAhead' to throw an EOF
106 -- exception if appropriate
107 _ <- hLookAhead_ handle_
110 -- XXX we should only return when there are full characters
111 -- not when there are only bytes. That would mean looping
112 -- and re-running IODevice.ready if we don't have any full
113 -- characters; but we don't know how long we've waited
116 -- ---------------------------------------------------------------------------
119 -- | Computation 'hGetChar' @hdl@ reads a character from the file or
120 -- channel managed by @hdl@, blocking until a character is available.
122 -- This operation may fail with:
124 -- * 'isEOFError' if the end of file has been reached.
126 hGetChar :: Handle -> IO Char
128 wantReadableHandle_ "hGetChar" handle $ \handle_@Handle__{..} -> do
130 -- buffering mode makes no difference: we just read whatever is available
131 -- from the device (blocking only if there is nothing available), and then
132 -- return the first character.
133 -- See [note Buffered Reading] in GHC.IO.Handle.Types
134 buf0 <- readIORef haCharBuffer
136 buf1 <- if isEmptyBuffer buf0
137 then readTextDevice handle_ buf0
140 (c1,i) <- readCharBuf (bufRaw buf1) (bufL buf1)
141 let buf2 = bufferAdjustL i buf1
143 if haInputNL == CRLF && c1 == '\r'
145 mbuf3 <- if isEmptyBuffer buf2
146 then maybeFillReadBuffer handle_ buf2
147 else return (Just buf2)
150 -- EOF, so just return the '\r' we have
152 writeIORef haCharBuffer buf2
155 (c2,i2) <- readCharBuf (bufRaw buf2) (bufL buf2)
158 writeIORef haCharBuffer (bufferAdjustL i2 buf3)
161 -- not a \r\n sequence, so just return the \r
162 writeIORef haCharBuffer buf3
165 writeIORef haCharBuffer buf2
168 -- ---------------------------------------------------------------------------
171 -- | Computation 'hGetLine' @hdl@ reads a line from the file or
172 -- channel managed by @hdl@.
174 -- This operation may fail with:
176 -- * 'isEOFError' if the end of file is encountered when reading
177 -- the /first/ character of the line.
179 -- If 'hGetLine' encounters end-of-file at any other point while reading
180 -- in a line, it is treated as a line terminator and the (partial)
183 hGetLine :: Handle -> IO String
185 wantReadableHandle_ "hGetLine" h $ \ handle_ -> do
186 hGetLineBuffered handle_
188 hGetLineBuffered :: Handle__ -> IO String
189 hGetLineBuffered handle_@Handle__{..} = do
190 buf <- readIORef haCharBuffer
191 hGetLineBufferedLoop handle_ buf []
193 hGetLineBufferedLoop :: Handle__
194 -> CharBuffer -> [String]
196 hGetLineBufferedLoop handle_@Handle__{..}
197 buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } xss =
199 -- find the end-of-line character, if there is one
201 | r == w = return (False, w)
203 (c,r') <- readCharBuf raw r
205 then return (True, r) -- NB. not r': don't include the '\n'
208 (eol, off) <- loop raw0 r0
210 debugIO ("hGetLineBufferedLoop: r=" ++ show r0 ++ ", w=" ++ show w ++ ", off=" ++ show off)
212 (xs,r') <- if haInputNL == CRLF
213 then unpack_nl raw0 r0 off ""
214 else do xs <- unpack raw0 r0 off ""
217 -- if eol == True, then off is the offset of the '\n'
218 -- otherwise off == w and the buffer is now empty.
220 then do writeIORef haCharBuffer (bufferAdjustL (off+1) buf)
221 return (concat (reverse (xs:xss)))
223 let buf1 = bufferAdjustL r' buf
224 maybe_buf <- maybeFillReadBuffer handle_ buf1
226 -- Nothing indicates we caught an EOF, and we may have a
227 -- partial line to return.
229 -- we reached EOF. There might be a lone \r left
230 -- in the buffer, so check for that and
231 -- append it to the line if necessary.
233 let pre = if not (isEmptyBuffer buf1) then "\r" else ""
234 writeIORef haCharBuffer buf1{ bufL=0, bufR=0 }
235 let str = concat (reverse (pre:xs:xss))
240 hGetLineBufferedLoop handle_ new_buf (xs:xss)
242 maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)
243 maybeFillReadBuffer handle_ buf
245 (do buf' <- getSomeCharacters handle_ buf
248 (\e -> do if isEOFError e
253 #define CHARBUF_UTF32
254 -- #define CHARBUF_UTF16
256 -- NB. performance-critical code: eyeball the Core.
257 unpack :: RawCharBuffer -> Int -> Int -> [Char] -> IO [Char]
258 unpack !buf !r !w acc0
259 | r == w = return acc0
261 withRawBuffer buf $ \pbuf ->
267 -- reverse-order decoding of UTF-16
268 c2 <- peekElemOff pbuf i
269 if (c2 < 0xdc00 || c2 > 0xdffff)
270 then unpackRB (unsafeChr (fromIntegral c2) : acc) (i-1)
271 else do c1 <- peekElemOff pbuf (i-1)
272 let c = (fromIntegral c1 - 0xd800) * 0x400 +
273 (fromIntegral c2 - 0xdc00) + 0x10000
274 unpackRB (unsafeChr c : acc) (i-2)
276 c <- peekElemOff pbuf i
277 unpackRB (c:acc) (i-1)
282 -- NB. performance-critical code: eyeball the Core.
283 unpack_nl :: RawCharBuffer -> Int -> Int -> [Char] -> IO ([Char],Int)
284 unpack_nl !buf !r !w acc0
285 | r == w = return (acc0, 0)
287 withRawBuffer buf $ \pbuf ->
292 c <- peekElemOff pbuf i
293 if (c == '\n' && i > r)
295 c1 <- peekElemOff pbuf (i-1)
297 then unpackRB ('\n':acc) (i-2)
298 else unpackRB ('\n':acc) (i-1)
300 unpackRB (c:acc) (i-1)
302 c <- peekElemOff pbuf (w-1)
305 -- If the last char is a '\r', we need to know whether or
306 -- not it is followed by a '\n', so leave it in the buffer
307 -- for now and just unpack the rest.
308 str <- unpackRB acc0 (w-2)
311 str <- unpackRB acc0 (w-1)
315 -- -----------------------------------------------------------------------------
318 -- hGetContents on a DuplexHandle only affects the read side: you can
319 -- carry on writing to it afterwards.
321 -- | Computation 'hGetContents' @hdl@ returns the list of characters
322 -- corresponding to the unread portion of the channel or file managed
323 -- by @hdl@, which is put into an intermediate state, /semi-closed/.
324 -- In this state, @hdl@ is effectively closed,
325 -- but items are read from @hdl@ on demand and accumulated in a special
326 -- list returned by 'hGetContents' @hdl@.
328 -- Any operation that fails because a handle is closed,
329 -- also fails if a handle is semi-closed. The only exception is 'hClose'.
330 -- A semi-closed handle becomes closed:
332 -- * if 'hClose' is applied to it;
334 -- * if an I\/O error occurs when reading an item from the handle;
336 -- * or once the entire contents of the handle has been read.
338 -- Once a semi-closed handle becomes closed, the contents of the
339 -- associated list becomes fixed. The contents of this final list is
340 -- only partially specified: it will contain at least all the items of
341 -- the stream that were evaluated prior to the handle becoming closed.
343 -- Any I\/O errors encountered while a handle is semi-closed are simply
346 -- This operation may fail with:
348 -- * 'isEOFError' if the end of file has been reached.
350 hGetContents :: Handle -> IO String
351 hGetContents handle =
352 wantReadableHandle "hGetContents" handle $ \handle_ -> do
353 xs <- lazyRead handle
354 return (handle_{ haType=SemiClosedHandle}, xs )
356 -- Note that someone may close the semi-closed handle (or change its
357 -- buffering), so each time these lazy read functions are pulled on,
358 -- they have to check whether the handle has indeed been closed.
360 lazyRead :: Handle -> IO String
363 withHandle "hGetContents" handle $ \ handle_ -> do
364 case haType handle_ of
365 ClosedHandle -> return (handle_, "")
366 SemiClosedHandle -> lazyReadBuffered handle handle_
368 (IOError (Just handle) IllegalOperation "hGetContents"
369 "illegal handle type" Nothing Nothing)
371 lazyReadBuffered :: Handle -> Handle__ -> IO (Handle__, [Char])
372 lazyReadBuffered h handle_@Handle__{..} = do
373 buf <- readIORef haCharBuffer
376 buf'@Buffer{..} <- getSomeCharacters handle_ buf
377 lazy_rest <- lazyRead h
378 (s,r) <- if haInputNL == CRLF
379 then unpack_nl bufRaw bufL bufR lazy_rest
380 else do s <- unpack bufRaw bufL bufR lazy_rest
382 writeIORef haCharBuffer (bufferAdjustL r buf')
385 (\e -> do (handle_', _) <- hClose_help handle_
386 debugIO ("hGetContents caught: " ++ show e)
387 -- We might have a \r cached in CRLF mode. So we
388 -- need to check for that and return it:
389 let r = if isEOFError e
390 then if not (isEmptyBuffer buf)
394 throw (augmentIOError e "hGetContents" h)
399 -- ensure we have some characters in the buffer
400 getSomeCharacters :: Handle__ -> CharBuffer -> IO CharBuffer
401 getSomeCharacters handle_@Handle__{..} buf@Buffer{..} =
402 case bufferElems buf of
404 -- buffer empty: read some more
405 0 -> readTextDevice handle_ buf
407 -- if the buffer has a single '\r' in it and we're doing newline
408 -- translation: read some more
409 1 | haInputNL == CRLF -> do
410 (c,_) <- readCharBuf bufRaw bufL
412 then do -- shuffle the '\r' to the beginning. This is only safe
413 -- if we're about to call readTextDevice, otherwise it
414 -- would mess up flushCharBuffer.
415 -- See [note Buffer Flushing], GHC.IO.Handle.Types
416 _ <- writeCharBuf bufRaw 0 '\r'
417 let buf' = buf{ bufL=0, bufR=1 }
418 readTextDevice handle_ buf'
422 -- buffer has some chars in it already: just return it
426 -- ---------------------------------------------------------------------------
429 -- | Computation 'hPutChar' @hdl ch@ writes the character @ch@ to the
430 -- file or channel managed by @hdl@. Characters may be buffered if
431 -- buffering is enabled for @hdl@.
433 -- This operation may fail with:
435 -- * 'isFullError' if the device is full; or
437 -- * 'isPermissionError' if another system resource limit would be exceeded.
439 hPutChar :: Handle -> Char -> IO ()
440 hPutChar handle c = do
442 wantWritableHandle "hPutChar" handle $ \ handle_ -> do
443 hPutcBuffered handle_ c
445 hPutcBuffered :: Handle__ -> Char -> IO ()
446 hPutcBuffered handle_@Handle__{..} c = do
447 buf <- readIORef haCharBuffer
449 then do buf1 <- if haOutputNL == CRLF
451 buf1 <- putc buf '\r'
455 writeCharBuffer handle_ buf1
456 when is_line $ flushByteWriteBuffer handle_
459 writeCharBuffer handle_ buf1
462 is_line = case haBufferMode of
463 LineBuffering -> True
466 putc buf@Buffer{ bufRaw=raw, bufR=w } c = do
467 debugIO ("putc: " ++ summaryBuffer buf)
468 w' <- writeCharBuf raw w c
469 return buf{ bufR = w' }
471 -- ---------------------------------------------------------------------------
474 -- We go to some trouble to avoid keeping the handle locked while we're
475 -- evaluating the string argument to hPutStr, in case doing so triggers another
476 -- I/O operation on the same handle which would lead to deadlock. The classic
479 -- putStr (trace "hello" "world")
481 -- so the basic scheme is this:
483 -- * copy the string into a fresh buffer,
484 -- * "commit" the buffer to the handle.
486 -- Committing may involve simply copying the contents of the new
487 -- buffer into the handle's buffer, flushing one or both buffers, or
488 -- maybe just swapping the buffers over (if the handle's buffer was
489 -- empty). See commitBuffer below.
491 -- | Computation 'hPutStr' @hdl s@ writes the string
492 -- @s@ to the file or channel managed by @hdl@.
494 -- This operation may fail with:
496 -- * 'isFullError' if the device is full; or
498 -- * 'isPermissionError' if another system resource limit would be exceeded.
500 hPutStr :: Handle -> String -> IO ()
501 hPutStr handle str = hPutStr' handle str False
503 -- | The same as 'hPutStr', but adds a newline character.
504 hPutStrLn :: Handle -> String -> IO ()
505 hPutStrLn handle str = hPutStr' handle str True
506 -- An optimisation: we treat hPutStrLn specially, to avoid the
507 -- overhead of a single putChar '\n', which is quite high now that we
508 -- have to encode eagerly.
510 hPutStr' :: Handle -> String -> Bool -> IO ()
511 hPutStr' handle str add_nl =
514 wantWritableHandle "hPutStr" handle $ \h_ -> do
515 bmode <- getSpareBuffer h_
516 return (bmode, haOutputNL h_)
519 (NoBuffering, _) -> do
520 hPutChars handle str -- v. slow, but we don't care
521 when add_nl $ hPutChar handle '\n'
522 (LineBuffering, buf) -> do
523 writeBlocks handle True add_nl nl buf str
524 (BlockBuffering _, buf) -> do
525 writeBlocks handle False add_nl nl buf str
527 hPutChars :: Handle -> [Char] -> IO ()
528 hPutChars _ [] = return ()
529 hPutChars handle (c:cs) = hPutChar handle c >> hPutChars handle cs
531 getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)
532 getSpareBuffer Handle__{haCharBuffer=ref,
537 NoBuffering -> return (mode, error "no buffer!")
539 bufs <- readIORef spare_ref
542 BufferListCons b rest -> do
543 writeIORef spare_ref rest
544 return ( mode, emptyBuffer b (bufSize buf) WriteBuffer)
546 new_buf <- newCharBuffer (bufSize buf) WriteBuffer
547 return (mode, new_buf)
550 -- NB. performance-critical code: eyeball the Core.
551 writeBlocks :: Handle -> Bool -> Bool -> Newline -> Buffer CharBufElem -> String -> IO ()
552 writeBlocks hdl line_buffered add_nl nl
553 buf@Buffer{ bufRaw=raw, bufSize=len } s =
555 shoveString :: Int -> [Char] -> [Char] -> IO ()
556 shoveString !n [] [] = do
557 commitBuffer hdl raw len n False{-no flush-} True{-release-}
558 shoveString !n [] rest = do
559 shoveString n rest []
560 shoveString !n (c:cs) rest
561 -- n+1 so we have enough room to write '\r\n' if necessary
563 commitBuffer hdl raw len n False{-flush-} False
564 shoveString 0 (c:cs) rest
568 n1 <- writeCharBuf raw n '\r'
569 writeCharBuf raw n1 '\n'
574 -- end of line, so write and flush
575 commitBuffer hdl raw len n' True{-flush-} False
576 shoveString 0 cs rest
578 shoveString n' cs rest
580 n' <- writeCharBuf raw n c
581 shoveString n' cs rest
583 shoveString 0 s (if add_nl then "\n" else "")
585 -- -----------------------------------------------------------------------------
586 -- commitBuffer handle buf sz count flush release
588 -- Write the contents of the buffer 'buf' ('sz' bytes long, containing
589 -- 'count' bytes of data) to handle (handle must be block or line buffered).
592 :: Handle -- handle to commit to
593 -> RawCharBuffer -> Int -- address and size (in bytes) of buffer
594 -> Int -- number of bytes of data in buffer
595 -> Bool -- True <=> flush the handle afterward
596 -> Bool -- release the buffer?
599 commitBuffer hdl !raw !sz !count flush release =
600 wantWritableHandle "commitBuffer" hdl $ \h_@Handle__{..} -> do
601 debugIO ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count
602 ++ ", flush=" ++ show flush ++ ", release=" ++ show release)
604 writeCharBuffer h_ Buffer{ bufRaw=raw, bufState=WriteBuffer,
605 bufL=0, bufR=count, bufSize=sz }
607 when flush $ flushByteWriteBuffer h_
609 -- release the buffer if necessary
611 -- find size of current buffer
612 old_buf@Buffer{ bufSize=size } <- readIORef haCharBuffer
613 when (sz == size) $ do
614 spare_bufs <- readIORef haBuffers
615 writeIORef haBuffers (BufferListCons raw spare_bufs)
619 -- backwards compatibility; the text package uses this
620 commitBuffer' :: RawCharBuffer -> Int -> Int -> Bool -> Bool -> Handle__
622 commitBuffer' raw sz@(I# _) count@(I# _) flush release h_@Handle__{..}
624 debugIO ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count
625 ++ ", flush=" ++ show flush ++ ", release=" ++ show release)
627 let this_buf = Buffer{ bufRaw=raw, bufState=WriteBuffer,
628 bufL=0, bufR=count, bufSize=sz }
630 writeCharBuffer h_ this_buf
632 when flush $ flushByteWriteBuffer h_
634 -- release the buffer if necessary
636 -- find size of current buffer
637 old_buf@Buffer{ bufSize=size } <- readIORef haCharBuffer
638 when (sz == size) $ do
639 spare_bufs <- readIORef haBuffers
640 writeIORef haBuffers (BufferListCons raw spare_bufs)
644 -- ---------------------------------------------------------------------------
645 -- Reading/writing sequences of bytes.
647 -- ---------------------------------------------------------------------------
650 -- | 'hPutBuf' @hdl buf count@ writes @count@ 8-bit bytes from the
651 -- buffer @buf@ to the handle @hdl@. It returns ().
653 -- 'hPutBuf' ignores any text encoding that applies to the 'Handle',
654 -- writing the bytes directly to the underlying file or device.
656 -- 'hPutBuf' ignores the prevailing 'TextEncoding' and
657 -- 'NewlineMode' on the 'Handle', and writes bytes directly.
659 -- This operation may fail with:
661 -- * 'ResourceVanished' if the handle is a pipe or socket, and the
662 -- reading end is closed. (If this is a POSIX system, and the program
663 -- has not asked to ignore SIGPIPE, then a SIGPIPE may be delivered
664 -- instead, whose default action is to terminate the program).
666 hPutBuf :: Handle -- handle to write to
667 -> Ptr a -- address of buffer
668 -> Int -- number of bytes of data in buffer
670 hPutBuf h ptr count = do _ <- hPutBuf' h ptr count True
674 :: Handle -- handle to write to
675 -> Ptr a -- address of buffer
676 -> Int -- number of bytes of data in buffer
677 -> IO Int -- returns: number of bytes written
678 hPutBufNonBlocking h ptr count = hPutBuf' h ptr count False
680 hPutBuf':: Handle -- handle to write to
681 -> Ptr a -- address of buffer
682 -> Int -- number of bytes of data in buffer
683 -> Bool -- allow blocking?
685 hPutBuf' handle ptr count can_block
686 | count == 0 = return 0
687 | count < 0 = illegalBufferSize handle "hPutBuf" count
689 wantWritableHandle "hPutBuf" handle $
690 \ h_@Handle__{..} -> do
691 debugIO ("hPutBuf count=" ++ show count)
693 r <- bufWrite h_ (castPtr ptr) count can_block
695 -- we must flush if this Handle is set to NoBuffering. If
696 -- it is set to LineBuffering, be conservative and flush
697 -- anyway (we didn't check for newlines in the data).
699 BlockBuffering _ -> do return ()
700 _line_or_no_buffering -> do flushWriteBuffer h_
703 bufWrite :: Handle__-> Ptr Word8 -> Int -> Bool -> IO Int
704 bufWrite h_@Handle__{..} ptr count can_block =
705 seq count $ do -- strictness hack
706 old_buf@Buffer{ bufRaw=old_raw, bufR=w, bufSize=size }
707 <- readIORef haByteBuffer
709 -- enough room in handle buffer?
710 if (size - w > count)
711 -- There's enough room in the buffer:
712 -- just copy the data in and update bufR.
713 then do debugIO ("hPutBuf: copying to buffer, w=" ++ show w)
714 copyToRawBuffer old_raw w ptr count
715 writeIORef haByteBuffer old_buf{ bufR = w + count }
718 -- else, we have to flush
719 else do debugIO "hPutBuf: flushing first"
720 old_buf' <- Buffered.flushWriteBuffer haDevice old_buf
721 -- TODO: we should do a non-blocking flush here
722 writeIORef haByteBuffer old_buf'
723 -- if we can fit in the buffer, then just loop
725 then bufWrite h_ ptr count can_block
727 then do writeChunk h_ (castPtr ptr) count
729 else writeChunkNonBlocking h_ (castPtr ptr) count
731 writeChunk :: Handle__ -> Ptr Word8 -> Int -> IO ()
732 writeChunk h_@Handle__{..} ptr bytes
733 | Just fd <- cast haDevice = RawIO.write (fd::FD) ptr bytes
734 | otherwise = error "Todo: hPutBuf"
736 writeChunkNonBlocking :: Handle__ -> Ptr Word8 -> Int -> IO Int
737 writeChunkNonBlocking h_@Handle__{..} ptr bytes
738 | Just fd <- cast haDevice = RawIO.writeNonBlocking (fd::FD) ptr bytes
739 | otherwise = error "Todo: hPutBuf"
741 -- ---------------------------------------------------------------------------
744 -- | 'hGetBuf' @hdl buf count@ reads data from the handle @hdl@
745 -- into the buffer @buf@ until either EOF is reached or
746 -- @count@ 8-bit bytes have been read.
747 -- It returns the number of bytes actually read. This may be zero if
748 -- EOF was reached before any data was read (or if @count@ is zero).
750 -- 'hGetBuf' never raises an EOF exception, instead it returns a value
751 -- smaller than @count@.
753 -- If the handle is a pipe or socket, and the writing end
754 -- is closed, 'hGetBuf' will behave as if EOF was reached.
756 -- 'hGetBuf' ignores the prevailing 'TextEncoding' and 'NewlineMode'
757 -- on the 'Handle', and reads bytes directly.
759 hGetBuf :: Handle -> Ptr a -> Int -> IO Int
761 | count == 0 = return 0
762 | count < 0 = illegalBufferSize h "hGetBuf" count
764 wantReadableHandle_ "hGetBuf" h $ \ h_@Handle__{..} -> do
765 flushCharReadBuffer h_
766 buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
767 <- readIORef haByteBuffer
769 then bufReadEmpty h_ buf (castPtr ptr) 0 count
770 else bufReadNonEmpty h_ buf (castPtr ptr) 0 count
772 -- small reads go through the buffer, large reads are satisfied by
773 -- taking data first from the buffer and then direct from the file
776 bufReadNonEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
777 bufReadNonEmpty h_@Handle__{..}
778 buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
784 copyFromRawBuffer ptr raw r count
785 writeIORef haByteBuffer buf{ bufL = r + count }
786 return (so_far + count)
789 copyFromRawBuffer ptr raw r avail
790 let buf' = buf{ bufR=0, bufL=0 }
791 writeIORef haByteBuffer buf'
792 let remaining = count - avail
793 so_far' = so_far + avail
794 ptr' = ptr `plusPtr` avail
798 else bufReadEmpty h_ buf' ptr' so_far' remaining
801 bufReadEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
802 bufReadEmpty h_@Handle__{..}
803 buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
805 | count > sz, Just fd <- cast haDevice = loop fd 0 count
807 (r,buf') <- Buffered.fillReadBuffer haDevice buf
810 else do writeIORef haByteBuffer buf'
811 bufReadNonEmpty h_ buf' ptr so_far count
813 loop :: FD -> Int -> Int -> IO Int
814 loop fd off bytes | bytes <= 0 = return (so_far + off)
815 loop fd off bytes = do
816 r <- RawIO.read (fd::FD) (ptr `plusPtr` off) bytes
818 then return (so_far + off)
819 else loop fd (off + r) (bytes - r)
821 -- ---------------------------------------------------------------------------
824 -- | 'hGetBufSome' @hdl buf count@ reads data from the handle @hdl@
825 -- into the buffer @buf@. If there is any data available to read,
826 -- then 'hGetBufSome' returns it immediately; it only blocks if there
827 -- is no data to be read.
829 -- It returns the number of bytes actually read. This may be zero if
830 -- EOF was reached before any data was read (or if @count@ is zero).
832 -- 'hGetBufSome' never raises an EOF exception, instead it returns a value
833 -- smaller than @count@.
835 -- If the handle is a pipe or socket, and the writing end
836 -- is closed, 'hGetBufSome' will behave as if EOF was reached.
838 -- 'hGetBufSome' ignores the prevailing 'TextEncoding' and 'NewlineMode'
839 -- on the 'Handle', and reads bytes directly.
841 hGetBufSome :: Handle -> Ptr a -> Int -> IO Int
842 hGetBufSome h ptr count
843 | count == 0 = return 0
844 | count < 0 = illegalBufferSize h "hGetBufSome" count
846 wantReadableHandle_ "hGetBufSome" h $ \ h_@Handle__{..} -> do
847 flushCharReadBuffer h_
848 buf@Buffer{ bufSize=sz } <- readIORef haByteBuffer
850 then if count > sz -- large read?
851 then do RawIO.read (haFD h_) (castPtr ptr) count
852 else do (r,buf') <- Buffered.fillReadBuffer haDevice buf
855 else do writeIORef haByteBuffer buf'
856 bufReadNBNonEmpty h_ buf' (castPtr ptr) 0 (min r count)
857 -- new count is (min r count), so
858 -- that bufReadNBNonEmpty will not
859 -- issue another read.
861 bufReadNBNonEmpty h_ buf (castPtr ptr) 0 count
863 haFD :: Handle__ -> FD
864 haFD h_@Handle__{..} =
865 case cast haDevice of
866 Nothing -> error "not an FD"
869 -- | 'hGetBufNonBlocking' @hdl buf count@ reads data from the handle @hdl@
870 -- into the buffer @buf@ until either EOF is reached, or
871 -- @count@ 8-bit bytes have been read, or there is no more data available
872 -- to read immediately.
874 -- 'hGetBufNonBlocking' is identical to 'hGetBuf', except that it will
875 -- never block waiting for data to become available, instead it returns
876 -- only whatever data is available. To wait for data to arrive before
877 -- calling 'hGetBufNonBlocking', use 'hWaitForInput'.
879 -- If the handle is a pipe or socket, and the writing end
880 -- is closed, 'hGetBufNonBlocking' will behave as if EOF was reached.
882 -- 'hGetBufNonBlocking' ignores the prevailing 'TextEncoding' and
883 -- 'NewlineMode' on the 'Handle', and reads bytes directly.
885 -- NOTE: on Windows, this function does not work correctly; it
886 -- behaves identically to 'hGetBuf'.
888 hGetBufNonBlocking :: Handle -> Ptr a -> Int -> IO Int
889 hGetBufNonBlocking h ptr count
890 | count == 0 = return 0
891 | count < 0 = illegalBufferSize h "hGetBufNonBlocking" count
893 wantReadableHandle_ "hGetBufNonBlocking" h $ \ h_@Handle__{..} -> do
894 flushCharReadBuffer h_
895 buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
896 <- readIORef haByteBuffer
898 then bufReadNBEmpty h_ buf (castPtr ptr) 0 count
899 else bufReadNBNonEmpty h_ buf (castPtr ptr) 0 count
901 bufReadNBEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
902 bufReadNBEmpty h_@Handle__{..}
903 buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
906 Just fd <- cast haDevice = do
907 m <- RawIO.readNonBlocking (fd::FD) ptr count
909 Nothing -> return so_far
910 Just n -> return (so_far + n)
913 buf <- readIORef haByteBuffer
914 (r,buf') <- Buffered.fillReadBuffer0 haDevice buf
916 Nothing -> return so_far
917 Just 0 -> return so_far
919 writeIORef haByteBuffer buf'
920 bufReadNBNonEmpty h_ buf' ptr so_far (min count r)
921 -- NOTE: new count is min count r
922 -- so we will just copy the contents of the
923 -- buffer in the recursive call, and not
927 bufReadNBNonEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
928 bufReadNBNonEmpty h_@Handle__{..}
929 buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
935 copyFromRawBuffer ptr raw r count
936 writeIORef haByteBuffer buf{ bufL = r + count }
937 return (so_far + count)
940 copyFromRawBuffer ptr raw r avail
941 let buf' = buf{ bufR=0, bufL=0 }
942 writeIORef haByteBuffer buf'
943 let remaining = count - avail
944 so_far' = so_far + avail
945 ptr' = ptr `plusPtr` avail
949 else bufReadNBEmpty h_ buf' ptr' so_far' remaining
951 -- ---------------------------------------------------------------------------
954 copyToRawBuffer :: RawBuffer e -> Int -> Ptr e -> Int -> IO ()
955 copyToRawBuffer raw off ptr bytes =
956 withRawBuffer raw $ \praw ->
957 do _ <- memcpy (praw `plusPtr` off) ptr (fromIntegral bytes)
960 copyFromRawBuffer :: Ptr e -> RawBuffer e -> Int -> Int -> IO ()
961 copyFromRawBuffer ptr raw off bytes =
962 withRawBuffer raw $ \praw ->
963 do _ <- memcpy ptr (praw `plusPtr` off) (fromIntegral bytes)
966 foreign import ccall unsafe "memcpy"
967 memcpy :: Ptr a -> Ptr a -> CSize -> IO (Ptr ())
969 -----------------------------------------------------------------------------
972 illegalBufferSize :: Handle -> String -> Int -> IO a
973 illegalBufferSize handle fn sz =
974 ioException (IOError (Just handle)
976 ("illegal buffer size " ++ showsPrec 9 sz [])