1 {-# OPTIONS_GHC -XNoImplicitPrelude -#include "HsBase.h" #-}
2 {-# OPTIONS_GHC -fno-warn-unused-matches #-}
3 {-# OPTIONS_GHC -fno-warn-unused-binds #-}
4 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
5 {-# OPTIONS_GHC -XRecordWildCards #-}
6 {-# OPTIONS_HADDOCK hide #-}
10 -----------------------------------------------------------------------------
12 -- Module : GHC.IO.Handle.Internals
13 -- Copyright : (c) The University of Glasgow, 1994-2001
14 -- License : see libraries/base/LICENSE
16 -- Maintainer : libraries@haskell.org
17 -- Stability : internal
18 -- Portability : non-portable
20 -- This module defines the basic operations on I\/O \"handles\". All
21 -- of the operations defined here are independent of the underlying
24 -----------------------------------------------------------------------------
27 module GHC.IO.Handle.Internals (
28 withHandle, withHandle', withHandle_,
29 withHandle__', withHandle_', withAllHandles__,
30 wantWritableHandle, wantReadableHandle, wantReadableHandle_,
33 mkHandle, mkFileHandle, mkDuplexHandle,
34 openTextEncoding, initBufferState,
35 dEFAULT_CHAR_BUFFER_SIZE,
37 flushBuffer, flushWriteBuffer, flushWriteBuffer_, flushCharReadBuffer,
38 flushCharBuffer, flushByteReadBuffer,
40 readTextDevice, writeTextDevice, readTextDeviceNonBlocking,
43 ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
44 ioe_finalizedHandle, ioe_bufsiz,
46 hClose_help, hLookAhead_,
48 HandleFinalizer, handleFinalizer,
55 import GHC.IO.Encoding
56 import GHC.IO.Handle.Types
58 import GHC.IO.BufferedIO (BufferedIO)
59 import GHC.IO.Exception
60 import GHC.IO.Device (IODevice, SeekMode(..))
61 import qualified GHC.IO.Device as IODevice
62 import qualified GHC.IO.BufferedIO as Buffered
67 import GHC.Num ( Num(..) )
75 -- import System.IO.Error
76 import System.Posix.Internals hiding (FD)
82 -- ---------------------------------------------------------------------------
83 -- Creating a new handle
85 type HandleFinalizer = FilePath -> MVar Handle__ -> IO ()
87 newFileHandle :: FilePath -> Maybe HandleFinalizer -> Handle__ -> IO Handle
88 newFileHandle filepath mb_finalizer hc = do
91 Just finalizer -> addMVarFinalizer m (finalizer filepath m)
93 return (FileHandle filepath m)
95 -- ---------------------------------------------------------------------------
96 -- Working with Handles
99 In the concurrent world, handles are locked during use. This is done
100 by wrapping an MVar around the handle which acts as a mutex over
101 operations on the handle.
103 To avoid races, we use the following bracketing operations. The idea
104 is to obtain the lock, do some operation and replace the lock again,
105 whether the operation succeeded or failed. We also want to handle the
106 case where the thread receives an exception while processing the IO
107 operation: in these cases we also want to relinquish the lock.
109 There are three versions of @withHandle@: corresponding to the three
110 possible combinations of:
112 - the operation may side-effect the handle
113 - the operation may return a result
115 If the operation generates an error or an exception is raised, the
116 original handle is always replaced.
119 {-# INLINE withHandle #-}
120 withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
121 withHandle fun h@(FileHandle _ m) act = withHandle' fun h m act
122 withHandle fun h@(DuplexHandle _ m _) act = withHandle' fun h m act
124 withHandle' :: String -> Handle -> MVar Handle__
125 -> (Handle__ -> IO (Handle__,a)) -> IO a
126 withHandle' fun h m act =
129 checkHandleInvariants h_
130 (h',v) <- (act h_ `catchAny` \err -> putMVar m h_ >> throw err)
131 `catchException` \ex -> ioError (augmentIOError ex fun h)
132 checkHandleInvariants h'
136 {-# INLINE withHandle_ #-}
137 withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
138 withHandle_ fun h@(FileHandle _ m) act = withHandle_' fun h m act
139 withHandle_ fun h@(DuplexHandle _ m _) act = withHandle_' fun h m act
141 withHandle_' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
142 withHandle_' fun h m act =
145 checkHandleInvariants h_
146 v <- (act h_ `catchAny` \err -> putMVar m h_ >> throw err)
147 `catchException` \ex -> ioError (augmentIOError ex fun h)
148 checkHandleInvariants h_
152 withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
153 withAllHandles__ fun h@(FileHandle _ m) act = withHandle__' fun h m act
154 withAllHandles__ fun h@(DuplexHandle _ r w) act = do
155 withHandle__' fun h r act
156 withHandle__' fun h w act
158 withHandle__' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__)
160 withHandle__' fun h m act =
163 checkHandleInvariants h_
164 h' <- (act h_ `catchAny` \err -> putMVar m h_ >> throw err)
165 `catchException` \ex -> ioError (augmentIOError ex fun h)
166 checkHandleInvariants h'
170 augmentIOError :: IOException -> String -> Handle -> IOException
171 augmentIOError ioe@IOError{ ioe_filename = fp } fun h
172 = ioe { ioe_handle = Just h, ioe_location = fun, ioe_filename = filepath }
175 | otherwise = case h of
176 FileHandle path _ -> Just path
177 DuplexHandle path _ _ -> Just path
179 -- ---------------------------------------------------------------------------
180 -- Wrapper for write operations.
182 wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
183 wantWritableHandle fun h@(FileHandle _ m) act
184 = wantWritableHandle' fun h m act
185 wantWritableHandle fun h@(DuplexHandle _ _ m) act
186 = withHandle_' fun h m act
189 :: String -> Handle -> MVar Handle__
190 -> (Handle__ -> IO a) -> IO a
191 wantWritableHandle' fun h m act
192 = withHandle_' fun h m (checkWritableHandle act)
194 checkWritableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
195 checkWritableHandle act h_@Handle__{..}
197 ClosedHandle -> ioe_closedHandle
198 SemiClosedHandle -> ioe_closedHandle
199 ReadHandle -> ioe_notWritable
200 ReadWriteHandle -> do
201 buf <- readIORef haCharBuffer
202 when (not (isWriteBuffer buf)) $ do
203 flushCharReadBuffer h_
204 flushByteReadBuffer h_
205 buf <- readIORef haCharBuffer
206 writeIORef haCharBuffer buf{ bufState = WriteBuffer }
207 buf <- readIORef haByteBuffer
208 buf' <- Buffered.emptyWriteBuffer haDevice buf
209 writeIORef haByteBuffer buf'
213 -- ---------------------------------------------------------------------------
214 -- Wrapper for read operations.
216 wantReadableHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
217 wantReadableHandle fun h act = withHandle fun h (checkReadableHandle act)
219 wantReadableHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
220 wantReadableHandle_ fun h@(FileHandle _ m) act
221 = wantReadableHandle' fun h m act
222 wantReadableHandle_ fun h@(DuplexHandle _ m _) act
223 = withHandle_' fun h m act
226 :: String -> Handle -> MVar Handle__
227 -> (Handle__ -> IO a) -> IO a
228 wantReadableHandle' fun h m act
229 = withHandle_' fun h m (checkReadableHandle act)
231 checkReadableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
232 checkReadableHandle act h_@Handle__{..} =
234 ClosedHandle -> ioe_closedHandle
235 SemiClosedHandle -> ioe_closedHandle
236 AppendHandle -> ioe_notReadable
237 WriteHandle -> ioe_notReadable
238 ReadWriteHandle -> do
239 -- a read/write handle and we want to read from it. We must
240 -- flush all buffered write data first.
241 cbuf <- readIORef haCharBuffer
242 when (isWriteBuffer cbuf) $ do
243 cbuf' <- flushWriteBuffer_ h_ cbuf
244 writeIORef haCharBuffer cbuf'{ bufState = ReadBuffer }
245 bbuf <- readIORef haByteBuffer
246 writeIORef haByteBuffer bbuf{ bufState = ReadBuffer }
250 -- ---------------------------------------------------------------------------
251 -- Wrapper for seek operations.
253 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
254 wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =
255 ioException (IOError (Just h) IllegalOperation fun
256 "handle is not seekable" Nothing Nothing)
257 wantSeekableHandle fun h@(FileHandle _ m) act =
258 withHandle_' fun h m (checkSeekableHandle act)
260 checkSeekableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
261 checkSeekableHandle act handle_@Handle__{haDevice=dev} =
262 case haType handle_ of
263 ClosedHandle -> ioe_closedHandle
264 SemiClosedHandle -> ioe_closedHandle
265 AppendHandle -> ioe_notSeekable
266 _ -> do b <- IODevice.isSeekable dev
267 if b then act handle_
270 -- -----------------------------------------------------------------------------
273 ioe_closedHandle, ioe_EOF,
274 ioe_notReadable, ioe_notWritable, ioe_cannotFlushTextRead,
275 ioe_notSeekable, ioe_notSeekable_notBin, ioe_invalidCharacter :: IO a
277 ioe_closedHandle = ioException
278 (IOError Nothing IllegalOperation ""
279 "handle is closed" Nothing Nothing)
280 ioe_EOF = ioException
281 (IOError Nothing EOF "" "" Nothing Nothing)
282 ioe_notReadable = ioException
283 (IOError Nothing IllegalOperation ""
284 "handle is not open for reading" Nothing Nothing)
285 ioe_notWritable = ioException
286 (IOError Nothing IllegalOperation ""
287 "handle is not open for writing" Nothing Nothing)
288 ioe_notSeekable = ioException
289 (IOError Nothing IllegalOperation ""
290 "handle is not seekable" Nothing Nothing)
291 ioe_notSeekable_notBin = ioException
292 (IOError Nothing IllegalOperation ""
293 "seek operations on text-mode handles are not allowed on this platform"
295 ioe_cannotFlushTextRead = ioException
296 (IOError Nothing IllegalOperation ""
297 "cannot flush the read buffer of a text-mode handle"
299 ioe_invalidCharacter = ioException
300 (IOError Nothing InvalidArgument ""
301 ("invalid byte sequence for this encoding") Nothing Nothing)
303 ioe_finalizedHandle :: FilePath -> Handle__
304 ioe_finalizedHandle fp = throw
305 (IOError Nothing IllegalOperation ""
306 "handle is finalized" Nothing (Just fp))
308 ioe_bufsiz :: Int -> IO a
309 ioe_bufsiz n = ioException
310 (IOError Nothing InvalidArgument "hSetBuffering"
311 ("illegal buffer size " ++ showsPrec 9 n []) Nothing Nothing)
312 -- 9 => should be parens'ified.
314 -- -----------------------------------------------------------------------------
317 -- For a duplex handle, we arrange that the read side points to the write side
318 -- (and hence keeps it alive if the read side is alive). This is done by
319 -- having the haOtherSide field of the read side point to the read side.
320 -- The finalizer is then placed on the write side, and the handle only gets
321 -- finalized once, when both sides are no longer required.
323 -- NOTE about finalized handles: It's possible that a handle can be
324 -- finalized and then we try to use it later, for example if the
325 -- handle is referenced from another finalizer, or from a thread that
326 -- has become unreferenced and then resurrected (arguably in the
327 -- latter case we shouldn't finalize the Handle...). Anyway,
328 -- we try to emit a helpful message which is better than nothing.
330 handleFinalizer :: FilePath -> MVar Handle__ -> IO ()
331 handleFinalizer fp m = do
332 handle_ <- takeMVar m
333 case haType handle_ of
334 ClosedHandle -> return ()
335 _ -> do flushWriteBuffer handle_ `catchAny` \_ -> return ()
336 -- ignore errors and async exceptions, and close the
337 -- descriptor anyway...
338 _ <- hClose_handle_ handle_
340 putMVar m (ioe_finalizedHandle fp)
342 -- ---------------------------------------------------------------------------
343 -- Allocating buffers
345 -- using an 8k char buffer instead of 32k improved performance for a
346 -- basic "cat" program by ~30% for me. --SDM
347 dEFAULT_CHAR_BUFFER_SIZE :: Int
348 dEFAULT_CHAR_BUFFER_SIZE = dEFAULT_BUFFER_SIZE `div` 4
350 getCharBuffer :: IODevice dev => dev -> BufferState
351 -> IO (IORef CharBuffer, BufferMode)
352 getCharBuffer dev state = do
353 buffer <- newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
354 ioref <- newIORef buffer
355 is_tty <- IODevice.isTerminal dev
358 | is_tty = LineBuffering
359 | otherwise = BlockBuffering Nothing
361 return (ioref, buffer_mode)
363 mkUnBuffer :: BufferState -> IO (IORef CharBuffer, BufferMode)
364 mkUnBuffer state = do
365 buffer <- case state of -- See [note Buffer Sizing], GHC.IO.Handle.Types
366 ReadBuffer -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
367 WriteBuffer -> newCharBuffer 1 state
368 ref <- newIORef buffer
369 return (ref, NoBuffering)
371 -- -----------------------------------------------------------------------------
374 -- | syncs the file with the buffer, including moving the
375 -- file pointer backwards in the case of a read buffer. This can fail
376 -- on a non-seekable read Handle.
377 flushBuffer :: Handle__ -> IO ()
378 flushBuffer h_@Handle__{..} = do
379 buf <- readIORef haCharBuffer
382 flushCharReadBuffer h_
383 flushByteReadBuffer h_
385 buf' <- flushWriteBuffer_ h_ buf
386 writeIORef haCharBuffer buf'
388 -- | flushes at least the Char buffer, and the byte buffer for a write
389 -- Handle. Works on all Handles.
390 flushCharBuffer :: Handle__ -> IO ()
391 flushCharBuffer h_@Handle__{..} = do
392 buf <- readIORef haCharBuffer
395 flushCharReadBuffer h_
397 buf' <- flushWriteBuffer_ h_ buf
398 writeIORef haCharBuffer buf'
400 -- -----------------------------------------------------------------------------
401 -- Writing data (flushing write buffers)
403 -- flushWriteBuffer flushes the buffer iff it contains pending write
404 -- data. Flushes both the Char and the byte buffer, leaving both
406 flushWriteBuffer :: Handle__ -> IO ()
407 flushWriteBuffer h_@Handle__{..} = do
408 buf <- readIORef haCharBuffer
410 then do buf' <- flushWriteBuffer_ h_ buf
411 writeIORef haCharBuffer buf'
414 flushWriteBuffer_ :: Handle__ -> CharBuffer -> IO CharBuffer
415 flushWriteBuffer_ h_@Handle__{..} cbuf = do
416 bbuf <- readIORef haByteBuffer
417 if not (isEmptyBuffer cbuf) || not (isEmptyBuffer bbuf)
418 then do writeTextDevice h_ cbuf
419 return cbuf{ bufL=0, bufR=0 }
422 -- -----------------------------------------------------------------------------
423 -- Flushing read buffers
425 -- It is always possible to flush the Char buffer back to the byte buffer.
426 flushCharReadBuffer :: Handle__ -> IO ()
427 flushCharReadBuffer Handle__{..} = do
428 cbuf <- readIORef haCharBuffer
429 if isWriteBuffer cbuf || isEmptyBuffer cbuf then return () else do
431 -- haLastDecode is the byte buffer just before we did our last batch of
432 -- decoding. We're going to re-decode the bytes up to the current char,
433 -- to find out where we should revert the byte buffer to.
434 (codec_state, bbuf0) <- readIORef haLastDecode
436 cbuf0 <- readIORef haCharBuffer
437 writeIORef haCharBuffer cbuf0{ bufL=0, bufR=0 }
439 -- if we haven't used any characters from the char buffer, then just
440 -- re-install the old byte buffer.
442 then do writeIORef haByteBuffer bbuf0
448 writeIORef haByteBuffer bbuf0 { bufL = bufL bbuf0 + bufL cbuf0 }
449 -- no decoder: the number of bytes to decode is the same as the
450 -- number of chars we have used up.
453 debugIO ("flushCharReadBuffer re-decode, bbuf=" ++ summaryBuffer bbuf0 ++
454 " cbuf=" ++ summaryBuffer cbuf0)
456 -- restore the codec state
457 setState decoder codec_state
459 (bbuf1,cbuf1) <- (encode decoder) bbuf0
460 cbuf0{ bufL=0, bufR=0, bufSize = bufL cbuf0 }
462 debugIO ("finished, bbuf=" ++ summaryBuffer bbuf1 ++
463 " cbuf=" ++ summaryBuffer cbuf1)
465 writeIORef haByteBuffer bbuf1
468 -- When flushing the byte read buffer, we seek backwards by the number
469 -- of characters in the buffer. The file descriptor must therefore be
470 -- seekable: attempting to flush the read buffer on an unseekable
471 -- handle is not allowed.
473 flushByteReadBuffer :: Handle__ -> IO ()
474 flushByteReadBuffer h_@Handle__{..} = do
475 bbuf <- readIORef haByteBuffer
477 if isEmptyBuffer bbuf then return () else do
479 seekable <- IODevice.isSeekable haDevice
480 when (not seekable) $ ioe_cannotFlushTextRead
482 let seek = negate (bufR bbuf - bufL bbuf)
484 debugIO ("flushByteReadBuffer: new file offset = " ++ show seek)
485 IODevice.seek haDevice RelativeSeek (fromIntegral seek)
487 writeIORef haByteBuffer bbuf{ bufL=0, bufR=0 }
489 -- ----------------------------------------------------------------------------
492 mkHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
496 -> Maybe TextEncoding
498 -> Maybe HandleFinalizer
499 -> Maybe (MVar Handle__)
502 mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side = do
503 openTextEncoding mb_codec ha_type $ \ mb_encoder mb_decoder -> do
505 let buf_state = initBufferState ha_type
506 bbuf <- Buffered.newBuffer dev buf_state
507 bbufref <- newIORef bbuf
508 last_decode <- newIORef (error "codec_state", bbuf)
511 if buffered then getCharBuffer dev buf_state
512 else mkUnBuffer buf_state
514 spares <- newIORef BufferListNil
515 newFileHandle filepath finalizer
516 (Handle__ { haDevice = dev,
518 haBufferMode = bmode,
519 haByteBuffer = bbufref,
520 haLastDecode = last_decode,
521 haCharBuffer = cbufref,
523 haEncoder = mb_encoder,
524 haDecoder = mb_decoder,
526 haInputNL = inputNL nl,
527 haOutputNL = outputNL nl,
528 haOtherSide = other_side
531 -- | makes a new 'Handle'
532 mkFileHandle :: (IODevice dev, BufferedIO dev, Typeable dev)
533 => dev -- ^ the underlying IO device, which must support
534 -- 'IODevice', 'BufferedIO' and 'Typeable'
536 -- ^ a string describing the 'Handle', e.g. the file
537 -- path for a file. Used in error messages.
539 -- The mode in which the 'Handle' is to be used
540 -> Maybe TextEncoding
541 -- Create the 'Handle' with no text encoding?
543 -- Translate newlines?
545 mkFileHandle dev filepath iomode mb_codec tr_newlines = do
546 mkHandle dev filepath (ioModeToHandleType iomode) True{-buffered-} mb_codec
548 (Just handleFinalizer) Nothing{-other_side-}
550 -- | like 'mkFileHandle', except that a 'Handle' is created with two
551 -- independent buffers, one for reading and one for writing. Used for
552 -- full-dupliex streams, such as network sockets.
553 mkDuplexHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
554 -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
555 mkDuplexHandle dev filepath mb_codec tr_newlines = do
557 write_side@(FileHandle _ write_m) <-
558 mkHandle dev filepath WriteHandle True mb_codec
560 (Just handleFinalizer)
561 Nothing -- no othersie
563 read_side@(FileHandle _ read_m) <-
564 mkHandle dev filepath ReadHandle True mb_codec
566 Nothing -- no finalizer
569 return (DuplexHandle filepath read_m write_m)
571 ioModeToHandleType :: IOMode -> HandleType
572 ioModeToHandleType ReadMode = ReadHandle
573 ioModeToHandleType WriteMode = WriteHandle
574 ioModeToHandleType ReadWriteMode = ReadWriteHandle
575 ioModeToHandleType AppendMode = AppendHandle
577 initBufferState :: HandleType -> BufferState
578 initBufferState ReadHandle = ReadBuffer
579 initBufferState _ = WriteBuffer
582 :: Maybe TextEncoding
584 -> (forall es ds . Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a)
587 openTextEncoding Nothing ha_type cont = cont Nothing Nothing
588 openTextEncoding (Just TextEncoding{..}) ha_type cont = do
589 mb_decoder <- if isReadableHandleType ha_type then do
590 decoder <- mkTextDecoder
591 return (Just decoder)
594 mb_encoder <- if isWritableHandleType ha_type then do
595 encoder <- mkTextEncoder
596 return (Just encoder)
599 cont mb_encoder mb_decoder
601 -- ---------------------------------------------------------------------------
604 -- hClose_help is also called by lazyRead (in GHC.IO.Handle.Text) when
605 -- EOF is read or an IO error occurs on a lazy stream. The
606 -- semi-closed Handle is then closed immediately. We have to be
607 -- careful with DuplexHandles though: we have to leave the closing to
608 -- the finalizer in that case, because the write side may still be in
610 hClose_help :: Handle__ -> IO (Handle__, Maybe SomeException)
611 hClose_help handle_ =
612 case haType handle_ of
613 ClosedHandle -> return (handle_,Nothing)
614 _ -> do mb_exc1 <- trymaybe $ flushWriteBuffer handle_ -- interruptible
615 -- it is important that hClose doesn't fail and
616 -- leave the Handle open (#3128), so we catch
617 -- exceptions when flushing the buffer.
618 (h_, mb_exc2) <- hClose_handle_ handle_
619 return (h_, if isJust mb_exc1 then mb_exc1 else mb_exc2)
622 trymaybe :: IO () -> IO (Maybe SomeException)
623 trymaybe io = (do io; return Nothing) `catchException` \e -> return (Just e)
625 hClose_handle_ :: Handle__ -> IO (Handle__, Maybe SomeException)
626 hClose_handle_ Handle__{..} = do
628 -- close the file descriptor, but not when this is the read
629 -- side of a duplex handle.
630 -- If an exception is raised by the close(), we want to continue
631 -- to close the handle and release the lock if it has one, then
632 -- we return the exception to the caller of hClose_help which can
633 -- raise it if necessary.
636 Nothing -> trymaybe $ IODevice.close haDevice
637 Just _ -> return Nothing
639 -- free the spare buffers
640 writeIORef haBuffers BufferListNil
641 writeIORef haCharBuffer noCharBuffer
642 writeIORef haByteBuffer noByteBuffer
644 -- release our encoder/decoder
645 case haDecoder of Nothing -> return (); Just d -> close d
646 case haEncoder of Nothing -> return (); Just d -> close d
648 -- we must set the fd to -1, because the finalizer is going
649 -- to run eventually and try to close/unlock it.
650 -- ToDo: necessary? the handle will be marked ClosedHandle
651 -- XXX GHC won't let us use record update here, hence wildcards
652 return (Handle__{ haType = ClosedHandle, .. }, maybe_exception)
654 {-# NOINLINE noCharBuffer #-}
655 noCharBuffer :: CharBuffer
656 noCharBuffer = unsafePerformIO $ newCharBuffer 1 ReadBuffer
658 {-# NOINLINE noByteBuffer #-}
659 noByteBuffer :: Buffer Word8
660 noByteBuffer = unsafePerformIO $ newByteBuffer 1 ReadBuffer
662 -- ---------------------------------------------------------------------------
665 hLookAhead_ :: Handle__ -> IO Char
666 hLookAhead_ handle_@Handle__{..} = do
667 buf <- readIORef haCharBuffer
669 -- fill up the read buffer if necessary
670 new_buf <- if isEmptyBuffer buf
671 then readTextDevice handle_ buf
673 writeIORef haCharBuffer new_buf
675 peekCharBuf (bufRaw buf) (bufL buf)
677 -- ---------------------------------------------------------------------------
680 debugIO :: String -> IO ()
681 #if defined(DEBUG_DUMP)
683 withCStringLen (s++"\n") $ \(p,len) -> c_write 1 p (fromIntegral len)
686 debugIO s = return ()
689 -- ----------------------------------------------------------------------------
692 -- Write the contents of the supplied Char buffer to the device, return
693 -- only when all the data has been written.
694 writeTextDevice :: Handle__ -> CharBuffer -> IO ()
695 writeTextDevice h_@Handle__{..} cbuf = do
697 bbuf <- readIORef haByteBuffer
699 debugIO ("writeTextDevice: cbuf=" ++ summaryBuffer cbuf ++
700 " bbuf=" ++ summaryBuffer bbuf)
702 (cbuf',bbuf') <- case haEncoder of
703 Nothing -> latin1_encode cbuf bbuf
704 Just encoder -> (encode encoder) cbuf bbuf
706 debugIO ("writeTextDevice after encoding: cbuf=" ++ summaryBuffer cbuf' ++
707 " bbuf=" ++ summaryBuffer bbuf')
709 bbuf' <- Buffered.flushWriteBuffer haDevice bbuf'
710 writeIORef haByteBuffer bbuf'
711 if not (isEmptyBuffer cbuf')
712 then writeTextDevice h_ cbuf'
715 -- Read characters into the provided buffer. Return when any
716 -- characters are available; raise an exception if the end of
718 readTextDevice :: Handle__ -> CharBuffer -> IO CharBuffer
719 readTextDevice h_@Handle__{..} cbuf = do
721 bbuf0 <- readIORef haByteBuffer
723 debugIO ("readTextDevice: cbuf=" ++ summaryBuffer cbuf ++
724 " bbuf=" ++ summaryBuffer bbuf0)
726 bbuf1 <- if not (isEmptyBuffer bbuf0)
729 (r,bbuf1) <- Buffered.fillReadBuffer haDevice bbuf0
730 if r == 0 then ioe_EOF else do -- raise EOF
733 debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf1)
738 writeIORef haLastDecode (error "codec_state", bbuf1)
739 latin1_decode bbuf1 cbuf
741 state <- getState decoder
742 writeIORef haLastDecode (state, bbuf1)
743 (encode decoder) bbuf1 cbuf
745 debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++
746 " bbuf=" ++ summaryBuffer bbuf2)
748 writeIORef haByteBuffer bbuf2
749 if bufR cbuf' == bufR cbuf -- no new characters
750 then readTextDevice' h_ bbuf2 cbuf -- we need more bytes to make a Char
753 -- we have an incomplete byte sequence at the end of the buffer: try to
755 readTextDevice' :: Handle__ -> Buffer Word8 -> CharBuffer -> IO CharBuffer
756 readTextDevice' h_@Handle__{..} bbuf0 cbuf = do
758 -- copy the partial sequence to the beginning of the buffer, so we have
759 -- room to read more bytes.
760 bbuf1 <- slideContents bbuf0
762 bbuf2 <- do (r,bbuf2) <- Buffered.fillReadBuffer haDevice bbuf1
764 then ioe_invalidCharacter
767 debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf2)
772 writeIORef haLastDecode (error "codec_state", bbuf2)
773 latin1_decode bbuf2 cbuf
775 state <- getState decoder
776 writeIORef haLastDecode (state, bbuf2)
777 (encode decoder) bbuf2 cbuf
779 debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++
780 " bbuf=" ++ summaryBuffer bbuf3)
782 writeIORef haByteBuffer bbuf3
783 if bufR cbuf == bufR cbuf'
784 then readTextDevice' h_ bbuf3 cbuf'
787 -- Read characters into the provided buffer. Do not block;
788 -- return zero characters instead. Raises an exception on end-of-file.
789 readTextDeviceNonBlocking :: Handle__ -> CharBuffer -> IO CharBuffer
790 readTextDeviceNonBlocking h_@Handle__{..} cbuf = do
792 bbuf0 <- readIORef haByteBuffer
793 bbuf1 <- if not (isEmptyBuffer bbuf0)
796 (r,bbuf1) <- Buffered.fillReadBuffer haDevice bbuf0
797 if r == 0 then ioe_EOF else do -- raise EOF
800 (bbuf2,cbuf') <- case haDecoder of
801 Nothing -> latin1_decode bbuf1 cbuf
802 Just decoder -> (encode decoder) bbuf1 cbuf
804 writeIORef haByteBuffer bbuf2