6 , NondecreasingIndentation
8 , ForeignFunctionInterface
10 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
11 {-# OPTIONS_GHC -fno-warn-unused-matches #-}
12 {-# OPTIONS_HADDOCK hide #-}
14 -----------------------------------------------------------------------------
16 -- Module : GHC.IO.Text
17 -- Copyright : (c) The University of Glasgow, 1992-2008
18 -- License : see libraries/base/LICENSE
20 -- Maintainer : libraries@haskell.org
21 -- Stability : internal
22 -- Portability : non-portable
24 -- String I\/O functions
26 -----------------------------------------------------------------------------
29 module GHC.IO.Handle.Text (
30 hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,
31 commitBuffer', -- hack, see below
32 hGetBuf, hGetBufSome, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking,
39 import qualified GHC.IO.BufferedIO as Buffered
40 import GHC.IO.Exception
41 import GHC.IO.Encoding.Failure (surrogatifyRoundtripCharacter, desurrogatifyRoundtripCharacter)
43 import GHC.IO.Handle.Types
44 import GHC.IO.Handle.Internals
45 import qualified GHC.IO.Device as IODevice
46 import qualified GHC.IO.Device as RawIO
51 import qualified Control.Exception as Exception
53 import System.IO.Error
64 -- ---------------------------------------------------------------------------
65 -- Simple input operations
67 -- If hWaitForInput finds anything in the Handle's buffer, it
68 -- immediately returns. If not, it tries to read from the underlying
69 -- OS handle. Notice that for buffered Handles connected to terminals
70 -- this means waiting until a complete line is available.
72 -- | Computation 'hWaitForInput' @hdl t@
73 -- waits until input is available on handle @hdl@.
74 -- It returns 'True' as soon as input is available on @hdl@,
75 -- or 'False' if no input is available within @t@ milliseconds. Note that
76 -- 'hWaitForInput' waits until one or more full /characters/ are available,
77 -- which means that it needs to do decoding, and hence may fail
78 -- with a decoding error.
80 -- If @t@ is less than zero, then @hWaitForInput@ waits indefinitely.
82 -- This operation may fail with:
84 -- * 'isEOFError' if the end of file has been reached.
86 -- * a decoding error, if the input begins with an invalid byte sequence
87 -- in this Handle's encoding.
89 -- NOTE for GHC users: unless you use the @-threaded@ flag,
90 -- @hWaitForInput t@ where @t >= 0@ will block all other Haskell
91 -- threads for the duration of the call. It behaves like a
92 -- @safe@ foreign call in this respect.
95 hWaitForInput :: Handle -> Int -> IO Bool
96 hWaitForInput h msecs = do
97 wantReadableHandle_ "hWaitForInput" h $ \ handle_@Handle__{..} -> do
98 cbuf <- readIORef haCharBuffer
100 if not (isEmptyBuffer cbuf) then return True else do
103 then do cbuf' <- readTextDevice handle_ cbuf
104 writeIORef haCharBuffer cbuf'
107 -- there might be bytes in the byte buffer waiting to be decoded
108 cbuf' <- decodeByteBuf handle_ cbuf
109 writeIORef haCharBuffer cbuf'
111 if not (isEmptyBuffer cbuf') then return True else do
113 r <- IODevice.ready haDevice False{-read-} msecs
114 if r then do -- Call hLookAhead' to throw an EOF
115 -- exception if appropriate
116 _ <- hLookAhead_ handle_
119 -- XXX we should only return when there are full characters
120 -- not when there are only bytes. That would mean looping
121 -- and re-running IODevice.ready if we don't have any full
122 -- characters; but we don't know how long we've waited
125 -- ---------------------------------------------------------------------------
128 -- | Computation 'hGetChar' @hdl@ reads a character from the file or
129 -- channel managed by @hdl@, blocking until a character is available.
131 -- This operation may fail with:
133 -- * 'isEOFError' if the end of file has been reached.
135 hGetChar :: Handle -> IO Char
137 wantReadableHandle_ "hGetChar" handle $ \handle_@Handle__{..} -> do
139 -- buffering mode makes no difference: we just read whatever is available
140 -- from the device (blocking only if there is nothing available), and then
141 -- return the first character.
142 -- See [note Buffered Reading] in GHC.IO.Handle.Types
143 buf0 <- readIORef haCharBuffer
145 buf1 <- if isEmptyBuffer buf0
146 then readTextDevice handle_ buf0
149 (c1,i) <- readCharBuf (bufRaw buf1) (bufL buf1)
150 let buf2 = bufferAdjustL i buf1
152 if haInputNL == CRLF && c1 == '\r'
154 mbuf3 <- if isEmptyBuffer buf2
155 then maybeFillReadBuffer handle_ buf2
156 else return (Just buf2)
159 -- EOF, so just return the '\r' we have
161 writeIORef haCharBuffer buf2
164 (c2,i2) <- readCharBuf (bufRaw buf2) (bufL buf2)
167 writeIORef haCharBuffer (bufferAdjustL i2 buf3)
170 -- not a \r\n sequence, so just return the \r
171 writeIORef haCharBuffer buf3
174 writeIORef haCharBuffer buf2
177 -- ---------------------------------------------------------------------------
180 -- | Computation 'hGetLine' @hdl@ reads a line from the file or
181 -- channel managed by @hdl@.
183 -- This operation may fail with:
185 -- * 'isEOFError' if the end of file is encountered when reading
186 -- the /first/ character of the line.
188 -- If 'hGetLine' encounters end-of-file at any other point while reading
189 -- in a line, it is treated as a line terminator and the (partial)
192 hGetLine :: Handle -> IO String
194 wantReadableHandle_ "hGetLine" h $ \ handle_ -> do
195 hGetLineBuffered handle_
197 hGetLineBuffered :: Handle__ -> IO String
198 hGetLineBuffered handle_@Handle__{..} = do
199 buf <- readIORef haCharBuffer
200 hGetLineBufferedLoop handle_ buf []
202 hGetLineBufferedLoop :: Handle__
203 -> CharBuffer -> [String]
205 hGetLineBufferedLoop handle_@Handle__{..}
206 buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } xss =
208 -- find the end-of-line character, if there is one
210 | r == w = return (False, w)
212 (c,r') <- readCharBuf raw r
214 then return (True, r) -- NB. not r': don't include the '\n'
217 (eol, off) <- loop raw0 r0
219 debugIO ("hGetLineBufferedLoop: r=" ++ show r0 ++ ", w=" ++ show w ++ ", off=" ++ show off)
221 (xs,r') <- if haInputNL == CRLF
222 then unpack_nl raw0 r0 off ""
223 else do xs <- unpack raw0 r0 off ""
226 -- if eol == True, then off is the offset of the '\n'
227 -- otherwise off == w and the buffer is now empty.
229 then do writeIORef haCharBuffer (bufferAdjustL (off+1) buf)
230 return (concat (reverse (xs:xss)))
232 let buf1 = bufferAdjustL r' buf
233 maybe_buf <- maybeFillReadBuffer handle_ buf1
235 -- Nothing indicates we caught an EOF, and we may have a
236 -- partial line to return.
238 -- we reached EOF. There might be a lone \r left
239 -- in the buffer, so check for that and
240 -- append it to the line if necessary.
242 let pre = if not (isEmptyBuffer buf1) then "\r" else ""
243 writeIORef haCharBuffer buf1{ bufL=0, bufR=0 }
244 let str = concat (reverse (pre:xs:xss))
249 hGetLineBufferedLoop handle_ new_buf (xs:xss)
251 maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)
252 maybeFillReadBuffer handle_ buf
254 (do buf' <- getSomeCharacters handle_ buf
257 (\e -> do if isEOFError e
262 #define CHARBUF_UTF32
263 -- #define CHARBUF_UTF16
265 -- NB. performance-critical code: eyeball the Core.
266 unpack :: RawCharBuffer -> Int -> Int -> [Char] -> IO [Char]
267 unpack !buf !r !w acc0
268 | r == w = return acc0
270 withRawBuffer buf $ \pbuf ->
276 -- reverse-order decoding of UTF-16
277 c2 <- peekElemOff pbuf i
278 if (c2 < 0xdc00 || c2 > 0xdffff)
279 then unpackRB (unsafeChr (fromIntegral c2) : acc) (i-1)
280 else do c1 <- peekElemOff pbuf (i-1)
281 let c = (fromIntegral c1 - 0xd800) * 0x400 +
282 (fromIntegral c2 - 0xdc00) + 0x10000
283 unpackRB (desurrogatifyRoundtripCharacter (unsafeChr c) : acc) (i-2)
285 c <- peekElemOff pbuf i
286 unpackRB (desurrogatifyRoundtripCharacter c:acc) (i-1)
291 -- NB. performance-critical code: eyeball the Core.
292 unpack_nl :: RawCharBuffer -> Int -> Int -> [Char] -> IO ([Char],Int)
293 unpack_nl !buf !r !w acc0
294 | r == w = return (acc0, 0)
296 withRawBuffer buf $ \pbuf ->
301 c <- peekElemOff pbuf i
302 if (c == '\n' && i > r)
304 c1 <- peekElemOff pbuf (i-1)
306 then unpackRB ('\n':acc) (i-2)
307 else unpackRB ('\n':acc) (i-1)
309 unpackRB (desurrogatifyRoundtripCharacter c:acc) (i-1)
311 c <- peekElemOff pbuf (w-1)
314 -- If the last char is a '\r', we need to know whether or
315 -- not it is followed by a '\n', so leave it in the buffer
316 -- for now and just unpack the rest.
317 str <- unpackRB acc0 (w-2)
320 str <- unpackRB acc0 (w-1)
324 -- -----------------------------------------------------------------------------
327 -- hGetContents on a DuplexHandle only affects the read side: you can
328 -- carry on writing to it afterwards.
330 -- | Computation 'hGetContents' @hdl@ returns the list of characters
331 -- corresponding to the unread portion of the channel or file managed
332 -- by @hdl@, which is put into an intermediate state, /semi-closed/.
333 -- In this state, @hdl@ is effectively closed,
334 -- but items are read from @hdl@ on demand and accumulated in a special
335 -- list returned by 'hGetContents' @hdl@.
337 -- Any operation that fails because a handle is closed,
338 -- also fails if a handle is semi-closed. The only exception is 'hClose'.
339 -- A semi-closed handle becomes closed:
341 -- * if 'hClose' is applied to it;
343 -- * if an I\/O error occurs when reading an item from the handle;
345 -- * or once the entire contents of the handle has been read.
347 -- Once a semi-closed handle becomes closed, the contents of the
348 -- associated list becomes fixed. The contents of this final list is
349 -- only partially specified: it will contain at least all the items of
350 -- the stream that were evaluated prior to the handle becoming closed.
352 -- Any I\/O errors encountered while a handle is semi-closed are simply
355 -- This operation may fail with:
357 -- * 'isEOFError' if the end of file has been reached.
359 hGetContents :: Handle -> IO String
360 hGetContents handle =
361 wantReadableHandle "hGetContents" handle $ \handle_ -> do
362 xs <- lazyRead handle
363 return (handle_{ haType=SemiClosedHandle}, xs )
365 -- Note that someone may close the semi-closed handle (or change its
366 -- buffering), so each time these lazy read functions are pulled on,
367 -- they have to check whether the handle has indeed been closed.
369 lazyRead :: Handle -> IO String
372 withHandle "hGetContents" handle $ \ handle_ -> do
373 case haType handle_ of
374 ClosedHandle -> return (handle_, "")
375 SemiClosedHandle -> lazyReadBuffered handle handle_
377 (IOError (Just handle) IllegalOperation "hGetContents"
378 "illegal handle type" Nothing Nothing)
380 lazyReadBuffered :: Handle -> Handle__ -> IO (Handle__, [Char])
381 lazyReadBuffered h handle_@Handle__{..} = do
382 buf <- readIORef haCharBuffer
385 buf'@Buffer{..} <- getSomeCharacters handle_ buf
386 lazy_rest <- lazyRead h
387 (s,r) <- if haInputNL == CRLF
388 then unpack_nl bufRaw bufL bufR lazy_rest
389 else do s <- unpack bufRaw bufL bufR lazy_rest
391 writeIORef haCharBuffer (bufferAdjustL r buf')
394 (\e -> do (handle_', _) <- hClose_help handle_
395 debugIO ("hGetContents caught: " ++ show e)
396 -- We might have a \r cached in CRLF mode. So we
397 -- need to check for that and return it:
398 let r = if isEOFError e
399 then if not (isEmptyBuffer buf)
403 throw (augmentIOError e "hGetContents" h)
408 -- ensure we have some characters in the buffer
409 getSomeCharacters :: Handle__ -> CharBuffer -> IO CharBuffer
410 getSomeCharacters handle_@Handle__{..} buf@Buffer{..} =
411 case bufferElems buf of
413 -- buffer empty: read some more
414 0 -> readTextDevice handle_ buf
416 -- if the buffer has a single '\r' in it and we're doing newline
417 -- translation: read some more
418 1 | haInputNL == CRLF -> do
419 (c,_) <- readCharBuf bufRaw bufL
421 then do -- shuffle the '\r' to the beginning. This is only safe
422 -- if we're about to call readTextDevice, otherwise it
423 -- would mess up flushCharBuffer.
424 -- See [note Buffer Flushing], GHC.IO.Handle.Types
425 _ <- writeCharBuf bufRaw 0 '\r'
426 let buf' = buf{ bufL=0, bufR=1 }
427 readTextDevice handle_ buf'
431 -- buffer has some chars in it already: just return it
435 -- ---------------------------------------------------------------------------
438 -- | Computation 'hPutChar' @hdl ch@ writes the character @ch@ to the
439 -- file or channel managed by @hdl@. Characters may be buffered if
440 -- buffering is enabled for @hdl@.
442 -- This operation may fail with:
444 -- * 'isFullError' if the device is full; or
446 -- * 'isPermissionError' if another system resource limit would be exceeded.
448 hPutChar :: Handle -> Char -> IO ()
449 hPutChar handle c = do
451 wantWritableHandle "hPutChar" handle $ \ handle_ -> do
452 hPutcBuffered handle_ c
454 hPutcBuffered :: Handle__ -> Char -> IO ()
455 hPutcBuffered handle_@Handle__{..} c = do
456 buf <- readIORef haCharBuffer
458 then do buf1 <- if haOutputNL == CRLF
460 buf1 <- putc buf '\r'
464 writeCharBuffer handle_ buf1
465 when is_line $ flushByteWriteBuffer handle_
468 writeCharBuffer handle_ buf1
471 is_line = case haBufferMode of
472 LineBuffering -> True
475 putc buf@Buffer{ bufRaw=raw, bufR=w } c = do
476 debugIO ("putc: " ++ summaryBuffer buf)
477 w' <- writeCharBuf raw w c
478 return buf{ bufR = w' }
480 -- ---------------------------------------------------------------------------
483 -- We go to some trouble to avoid keeping the handle locked while we're
484 -- evaluating the string argument to hPutStr, in case doing so triggers another
485 -- I/O operation on the same handle which would lead to deadlock. The classic
488 -- putStr (trace "hello" "world")
490 -- so the basic scheme is this:
492 -- * copy the string into a fresh buffer,
493 -- * "commit" the buffer to the handle.
495 -- Committing may involve simply copying the contents of the new
496 -- buffer into the handle's buffer, flushing one or both buffers, or
497 -- maybe just swapping the buffers over (if the handle's buffer was
498 -- empty). See commitBuffer below.
500 -- | Computation 'hPutStr' @hdl s@ writes the string
501 -- @s@ to the file or channel managed by @hdl@.
503 -- This operation may fail with:
505 -- * 'isFullError' if the device is full; or
507 -- * 'isPermissionError' if another system resource limit would be exceeded.
509 hPutStr :: Handle -> String -> IO ()
510 hPutStr handle str = hPutStr' handle str False
512 -- | The same as 'hPutStr', but adds a newline character.
513 hPutStrLn :: Handle -> String -> IO ()
514 hPutStrLn handle str = hPutStr' handle str True
515 -- An optimisation: we treat hPutStrLn specially, to avoid the
516 -- overhead of a single putChar '\n', which is quite high now that we
517 -- have to encode eagerly.
519 hPutStr' :: Handle -> String -> Bool -> IO ()
520 hPutStr' handle str add_nl =
523 wantWritableHandle "hPutStr" handle $ \h_ -> do
524 bmode <- getSpareBuffer h_
525 return (bmode, haOutputNL h_)
528 (NoBuffering, _) -> do
529 hPutChars handle str -- v. slow, but we don't care
530 when add_nl $ hPutChar handle '\n'
531 (LineBuffering, buf) -> do
532 writeBlocks handle True add_nl nl buf str
533 (BlockBuffering _, buf) -> do
534 writeBlocks handle False add_nl nl buf str
536 hPutChars :: Handle -> [Char] -> IO ()
537 hPutChars _ [] = return ()
538 hPutChars handle (c:cs) = hPutChar handle c >> hPutChars handle cs
540 getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)
541 getSpareBuffer Handle__{haCharBuffer=ref,
546 NoBuffering -> return (mode, error "no buffer!")
548 bufs <- readIORef spare_ref
551 BufferListCons b rest -> do
552 writeIORef spare_ref rest
553 return ( mode, emptyBuffer b (bufSize buf) WriteBuffer)
555 new_buf <- newCharBuffer (bufSize buf) WriteBuffer
556 return (mode, new_buf)
559 -- NB. performance-critical code: eyeball the Core.
560 writeBlocks :: Handle -> Bool -> Bool -> Newline -> Buffer CharBufElem -> String -> IO ()
561 writeBlocks hdl line_buffered add_nl nl
562 buf@Buffer{ bufRaw=raw, bufSize=len } s =
564 shoveString :: Int -> [Char] -> [Char] -> IO ()
565 shoveString !n [] [] = do
566 commitBuffer hdl raw len n False{-no flush-} True{-release-}
567 shoveString !n [] rest = do
568 shoveString n rest []
569 shoveString !n (c:cs) rest
570 -- n+1 so we have enough room to write '\r\n' if necessary
572 commitBuffer hdl raw len n False{-flush-} False
573 shoveString 0 (c:cs) rest
577 n1 <- writeCharBuf raw n '\r'
578 writeCharBuf raw n1 '\n'
583 -- end of line, so write and flush
584 commitBuffer hdl raw len n' True{-flush-} False
585 shoveString 0 cs rest
587 shoveString n' cs rest
589 n' <- writeCharBuf raw n (surrogatifyRoundtripCharacter c)
590 shoveString n' cs rest
592 shoveString 0 s (if add_nl then "\n" else "")
594 -- -----------------------------------------------------------------------------
595 -- commitBuffer handle buf sz count flush release
597 -- Write the contents of the buffer 'buf' ('sz' bytes long, containing
598 -- 'count' bytes of data) to handle (handle must be block or line buffered).
601 :: Handle -- handle to commit to
602 -> RawCharBuffer -> Int -- address and size (in bytes) of buffer
603 -> Int -- number of bytes of data in buffer
604 -> Bool -- True <=> flush the handle afterward
605 -> Bool -- release the buffer?
608 commitBuffer hdl !raw !sz !count flush release =
609 wantWritableHandle "commitBuffer" hdl $ \h_@Handle__{..} -> do
610 debugIO ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count
611 ++ ", flush=" ++ show flush ++ ", release=" ++ show release)
613 writeCharBuffer h_ Buffer{ bufRaw=raw, bufState=WriteBuffer,
614 bufL=0, bufR=count, bufSize=sz }
616 when flush $ flushByteWriteBuffer h_
618 -- release the buffer if necessary
620 -- find size of current buffer
621 old_buf@Buffer{ bufSize=size } <- readIORef haCharBuffer
622 when (sz == size) $ do
623 spare_bufs <- readIORef haBuffers
624 writeIORef haBuffers (BufferListCons raw spare_bufs)
628 -- backwards compatibility; the text package uses this
629 commitBuffer' :: RawCharBuffer -> Int -> Int -> Bool -> Bool -> Handle__
631 commitBuffer' raw sz@(I# _) count@(I# _) flush release h_@Handle__{..}
633 debugIO ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count
634 ++ ", flush=" ++ show flush ++ ", release=" ++ show release)
636 let this_buf = Buffer{ bufRaw=raw, bufState=WriteBuffer,
637 bufL=0, bufR=count, bufSize=sz }
639 writeCharBuffer h_ this_buf
641 when flush $ flushByteWriteBuffer h_
643 -- release the buffer if necessary
645 -- find size of current buffer
646 old_buf@Buffer{ bufSize=size } <- readIORef haCharBuffer
647 when (sz == size) $ do
648 spare_bufs <- readIORef haBuffers
649 writeIORef haBuffers (BufferListCons raw spare_bufs)
653 -- ---------------------------------------------------------------------------
654 -- Reading/writing sequences of bytes.
656 -- ---------------------------------------------------------------------------
659 -- | 'hPutBuf' @hdl buf count@ writes @count@ 8-bit bytes from the
660 -- buffer @buf@ to the handle @hdl@. It returns ().
662 -- 'hPutBuf' ignores any text encoding that applies to the 'Handle',
663 -- writing the bytes directly to the underlying file or device.
665 -- 'hPutBuf' ignores the prevailing 'TextEncoding' and
666 -- 'NewlineMode' on the 'Handle', and writes bytes directly.
668 -- This operation may fail with:
670 -- * 'ResourceVanished' if the handle is a pipe or socket, and the
671 -- reading end is closed. (If this is a POSIX system, and the program
672 -- has not asked to ignore SIGPIPE, then a SIGPIPE may be delivered
673 -- instead, whose default action is to terminate the program).
675 hPutBuf :: Handle -- handle to write to
676 -> Ptr a -- address of buffer
677 -> Int -- number of bytes of data in buffer
679 hPutBuf h ptr count = do _ <- hPutBuf' h ptr count True
683 :: Handle -- handle to write to
684 -> Ptr a -- address of buffer
685 -> Int -- number of bytes of data in buffer
686 -> IO Int -- returns: number of bytes written
687 hPutBufNonBlocking h ptr count = hPutBuf' h ptr count False
689 hPutBuf':: Handle -- handle to write to
690 -> Ptr a -- address of buffer
691 -> Int -- number of bytes of data in buffer
692 -> Bool -- allow blocking?
694 hPutBuf' handle ptr count can_block
695 | count == 0 = return 0
696 | count < 0 = illegalBufferSize handle "hPutBuf" count
698 wantWritableHandle "hPutBuf" handle $
699 \ h_@Handle__{..} -> do
700 debugIO ("hPutBuf count=" ++ show count)
702 r <- bufWrite h_ (castPtr ptr) count can_block
704 -- we must flush if this Handle is set to NoBuffering. If
705 -- it is set to LineBuffering, be conservative and flush
706 -- anyway (we didn't check for newlines in the data).
708 BlockBuffering _ -> do return ()
709 _line_or_no_buffering -> do flushWriteBuffer h_
712 bufWrite :: Handle__-> Ptr Word8 -> Int -> Bool -> IO Int
713 bufWrite h_@Handle__{..} ptr count can_block =
714 seq count $ do -- strictness hack
715 old_buf@Buffer{ bufRaw=old_raw, bufR=w, bufSize=size }
716 <- readIORef haByteBuffer
718 -- enough room in handle buffer?
719 if (size - w > count)
720 -- There's enough room in the buffer:
721 -- just copy the data in and update bufR.
722 then do debugIO ("hPutBuf: copying to buffer, w=" ++ show w)
723 copyToRawBuffer old_raw w ptr count
724 writeIORef haByteBuffer old_buf{ bufR = w + count }
727 -- else, we have to flush
728 else do debugIO "hPutBuf: flushing first"
729 old_buf' <- Buffered.flushWriteBuffer haDevice old_buf
730 -- TODO: we should do a non-blocking flush here
731 writeIORef haByteBuffer old_buf'
732 -- if we can fit in the buffer, then just loop
734 then bufWrite h_ ptr count can_block
736 then do writeChunk h_ (castPtr ptr) count
738 else writeChunkNonBlocking h_ (castPtr ptr) count
740 writeChunk :: Handle__ -> Ptr Word8 -> Int -> IO ()
741 writeChunk h_@Handle__{..} ptr bytes
742 | Just fd <- cast haDevice = RawIO.write (fd::FD) ptr bytes
743 | otherwise = error "Todo: hPutBuf"
745 writeChunkNonBlocking :: Handle__ -> Ptr Word8 -> Int -> IO Int
746 writeChunkNonBlocking h_@Handle__{..} ptr bytes
747 | Just fd <- cast haDevice = RawIO.writeNonBlocking (fd::FD) ptr bytes
748 | otherwise = error "Todo: hPutBuf"
750 -- ---------------------------------------------------------------------------
753 -- | 'hGetBuf' @hdl buf count@ reads data from the handle @hdl@
754 -- into the buffer @buf@ until either EOF is reached or
755 -- @count@ 8-bit bytes have been read.
756 -- It returns the number of bytes actually read. This may be zero if
757 -- EOF was reached before any data was read (or if @count@ is zero).
759 -- 'hGetBuf' never raises an EOF exception, instead it returns a value
760 -- smaller than @count@.
762 -- If the handle is a pipe or socket, and the writing end
763 -- is closed, 'hGetBuf' will behave as if EOF was reached.
765 -- 'hGetBuf' ignores the prevailing 'TextEncoding' and 'NewlineMode'
766 -- on the 'Handle', and reads bytes directly.
768 hGetBuf :: Handle -> Ptr a -> Int -> IO Int
770 | count == 0 = return 0
771 | count < 0 = illegalBufferSize h "hGetBuf" count
773 wantReadableHandle_ "hGetBuf" h $ \ h_@Handle__{..} -> do
774 flushCharReadBuffer h_
775 buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
776 <- readIORef haByteBuffer
778 then bufReadEmpty h_ buf (castPtr ptr) 0 count
779 else bufReadNonEmpty h_ buf (castPtr ptr) 0 count
781 -- small reads go through the buffer, large reads are satisfied by
782 -- taking data first from the buffer and then direct from the file
785 bufReadNonEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
786 bufReadNonEmpty h_@Handle__{..}
787 buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
793 copyFromRawBuffer ptr raw r count
794 writeIORef haByteBuffer buf{ bufL = r + count }
795 return (so_far + count)
798 copyFromRawBuffer ptr raw r avail
799 let buf' = buf{ bufR=0, bufL=0 }
800 writeIORef haByteBuffer buf'
801 let remaining = count - avail
802 so_far' = so_far + avail
803 ptr' = ptr `plusPtr` avail
807 else bufReadEmpty h_ buf' ptr' so_far' remaining
810 bufReadEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
811 bufReadEmpty h_@Handle__{..}
812 buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
814 | count > sz, Just fd <- cast haDevice = loop fd 0 count
816 (r,buf') <- Buffered.fillReadBuffer haDevice buf
819 else do writeIORef haByteBuffer buf'
820 bufReadNonEmpty h_ buf' ptr so_far count
822 loop :: FD -> Int -> Int -> IO Int
823 loop fd off bytes | bytes <= 0 = return (so_far + off)
824 loop fd off bytes = do
825 r <- RawIO.read (fd::FD) (ptr `plusPtr` off) bytes
827 then return (so_far + off)
828 else loop fd (off + r) (bytes - r)
830 -- ---------------------------------------------------------------------------
833 -- | 'hGetBufSome' @hdl buf count@ reads data from the handle @hdl@
834 -- into the buffer @buf@. If there is any data available to read,
835 -- then 'hGetBufSome' returns it immediately; it only blocks if there
836 -- is no data to be read.
838 -- It returns the number of bytes actually read. This may be zero if
839 -- EOF was reached before any data was read (or if @count@ is zero).
841 -- 'hGetBufSome' never raises an EOF exception, instead it returns a value
842 -- smaller than @count@.
844 -- If the handle is a pipe or socket, and the writing end
845 -- is closed, 'hGetBufSome' will behave as if EOF was reached.
847 -- 'hGetBufSome' ignores the prevailing 'TextEncoding' and 'NewlineMode'
848 -- on the 'Handle', and reads bytes directly.
850 hGetBufSome :: Handle -> Ptr a -> Int -> IO Int
851 hGetBufSome h ptr count
852 | count == 0 = return 0
853 | count < 0 = illegalBufferSize h "hGetBufSome" count
855 wantReadableHandle_ "hGetBufSome" h $ \ h_@Handle__{..} -> do
856 flushCharReadBuffer h_
857 buf@Buffer{ bufSize=sz } <- readIORef haByteBuffer
859 then if count > sz -- large read?
860 then do RawIO.read (haFD h_) (castPtr ptr) count
861 else do (r,buf') <- Buffered.fillReadBuffer haDevice buf
864 else do writeIORef haByteBuffer buf'
865 bufReadNBNonEmpty h_ buf' (castPtr ptr) 0 (min r count)
866 -- new count is (min r count), so
867 -- that bufReadNBNonEmpty will not
868 -- issue another read.
870 bufReadNBNonEmpty h_ buf (castPtr ptr) 0 count
872 haFD :: Handle__ -> FD
873 haFD h_@Handle__{..} =
874 case cast haDevice of
875 Nothing -> error "not an FD"
878 -- | 'hGetBufNonBlocking' @hdl buf count@ reads data from the handle @hdl@
879 -- into the buffer @buf@ until either EOF is reached, or
880 -- @count@ 8-bit bytes have been read, or there is no more data available
881 -- to read immediately.
883 -- 'hGetBufNonBlocking' is identical to 'hGetBuf', except that it will
884 -- never block waiting for data to become available, instead it returns
885 -- only whatever data is available. To wait for data to arrive before
886 -- calling 'hGetBufNonBlocking', use 'hWaitForInput'.
888 -- If the handle is a pipe or socket, and the writing end
889 -- is closed, 'hGetBufNonBlocking' will behave as if EOF was reached.
891 -- 'hGetBufNonBlocking' ignores the prevailing 'TextEncoding' and
892 -- 'NewlineMode' on the 'Handle', and reads bytes directly.
894 -- NOTE: on Windows, this function does not work correctly; it
895 -- behaves identically to 'hGetBuf'.
897 hGetBufNonBlocking :: Handle -> Ptr a -> Int -> IO Int
898 hGetBufNonBlocking h ptr count
899 | count == 0 = return 0
900 | count < 0 = illegalBufferSize h "hGetBufNonBlocking" count
902 wantReadableHandle_ "hGetBufNonBlocking" h $ \ h_@Handle__{..} -> do
903 flushCharReadBuffer h_
904 buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
905 <- readIORef haByteBuffer
907 then bufReadNBEmpty h_ buf (castPtr ptr) 0 count
908 else bufReadNBNonEmpty h_ buf (castPtr ptr) 0 count
910 bufReadNBEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
911 bufReadNBEmpty h_@Handle__{..}
912 buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
915 Just fd <- cast haDevice = do
916 m <- RawIO.readNonBlocking (fd::FD) ptr count
918 Nothing -> return so_far
919 Just n -> return (so_far + n)
922 buf <- readIORef haByteBuffer
923 (r,buf') <- Buffered.fillReadBuffer0 haDevice buf
925 Nothing -> return so_far
926 Just 0 -> return so_far
928 writeIORef haByteBuffer buf'
929 bufReadNBNonEmpty h_ buf' ptr so_far (min count r)
930 -- NOTE: new count is min count r
931 -- so we will just copy the contents of the
932 -- buffer in the recursive call, and not
936 bufReadNBNonEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
937 bufReadNBNonEmpty h_@Handle__{..}
938 buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz }
944 copyFromRawBuffer ptr raw r count
945 writeIORef haByteBuffer buf{ bufL = r + count }
946 return (so_far + count)
949 copyFromRawBuffer ptr raw r avail
950 let buf' = buf{ bufR=0, bufL=0 }
951 writeIORef haByteBuffer buf'
952 let remaining = count - avail
953 so_far' = so_far + avail
954 ptr' = ptr `plusPtr` avail
958 else bufReadNBEmpty h_ buf' ptr' so_far' remaining
960 -- ---------------------------------------------------------------------------
963 copyToRawBuffer :: RawBuffer e -> Int -> Ptr e -> Int -> IO ()
964 copyToRawBuffer raw off ptr bytes =
965 withRawBuffer raw $ \praw ->
966 do _ <- memcpy (praw `plusPtr` off) ptr (fromIntegral bytes)
969 copyFromRawBuffer :: Ptr e -> RawBuffer e -> Int -> Int -> IO ()
970 copyFromRawBuffer ptr raw off bytes =
971 withRawBuffer raw $ \praw ->
972 do _ <- memcpy ptr (praw `plusPtr` off) (fromIntegral bytes)
975 foreign import ccall unsafe "memcpy"
976 memcpy :: Ptr a -> Ptr a -> CSize -> IO (Ptr ())
978 -----------------------------------------------------------------------------
981 illegalBufferSize :: Handle -> String -> Int -> IO a
982 illegalBufferSize handle fn sz =
983 ioException (IOError (Just handle)
985 ("illegal buffer size " ++ showsPrec 9 sz [])