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
68 import GHC.Num ( Num(..) )
76 import System.IO.Error
77 import System.Posix.Internals hiding (FD)
78 import qualified System.Posix.Internals as Posix
84 -- ---------------------------------------------------------------------------
85 -- Creating a new handle
87 type HandleFinalizer = FilePath -> MVar Handle__ -> IO ()
89 newFileHandle :: FilePath -> Maybe HandleFinalizer -> Handle__ -> IO Handle
90 newFileHandle filepath mb_finalizer hc = do
93 Just finalizer -> addMVarFinalizer m (finalizer filepath m)
95 return (FileHandle filepath m)
97 -- ---------------------------------------------------------------------------
98 -- Working with Handles
101 In the concurrent world, handles are locked during use. This is done
102 by wrapping an MVar around the handle which acts as a mutex over
103 operations on the handle.
105 To avoid races, we use the following bracketing operations. The idea
106 is to obtain the lock, do some operation and replace the lock again,
107 whether the operation succeeded or failed. We also want to handle the
108 case where the thread receives an exception while processing the IO
109 operation: in these cases we also want to relinquish the lock.
111 There are three versions of @withHandle@: corresponding to the three
112 possible combinations of:
114 - the operation may side-effect the handle
115 - the operation may return a result
117 If the operation generates an error or an exception is raised, the
118 original handle is always replaced.
121 {-# INLINE withHandle #-}
122 withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
123 withHandle fun h@(FileHandle _ m) act = withHandle' fun h m act
124 withHandle fun h@(DuplexHandle _ m _) act = withHandle' fun h m act
126 withHandle' :: String -> Handle -> MVar Handle__
127 -> (Handle__ -> IO (Handle__,a)) -> IO a
128 withHandle' fun h m act =
131 checkHandleInvariants h_
132 (h',v) <- (act h_ `catchAny` \err -> putMVar m h_ >> throw err)
133 `catchException` \ex -> ioError (augmentIOError ex fun h)
134 checkHandleInvariants h'
138 {-# INLINE withHandle_ #-}
139 withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
140 withHandle_ fun h@(FileHandle _ m) act = withHandle_' fun h m act
141 withHandle_ fun h@(DuplexHandle _ m _) act = withHandle_' fun h m act
143 withHandle_' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
144 withHandle_' fun h m act =
147 checkHandleInvariants h_
148 v <- (act h_ `catchAny` \err -> putMVar m h_ >> throw err)
149 `catchException` \ex -> ioError (augmentIOError ex fun h)
150 checkHandleInvariants h_
154 withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
155 withAllHandles__ fun h@(FileHandle _ m) act = withHandle__' fun h m act
156 withAllHandles__ fun h@(DuplexHandle _ r w) act = do
157 withHandle__' fun h r act
158 withHandle__' fun h w act
160 withHandle__' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__)
162 withHandle__' fun h m act =
165 checkHandleInvariants h_
166 h' <- (act h_ `catchAny` \err -> putMVar m h_ >> throw err)
167 `catchException` \ex -> ioError (augmentIOError ex fun h)
168 checkHandleInvariants h'
172 augmentIOError :: IOException -> String -> Handle -> IOException
173 augmentIOError ioe@IOError{ ioe_filename = fp } fun h
174 = ioe { ioe_handle = Just h, ioe_location = fun, ioe_filename = filepath }
177 | otherwise = case h of
178 FileHandle path _ -> Just path
179 DuplexHandle path _ _ -> Just path
181 -- ---------------------------------------------------------------------------
182 -- Wrapper for write operations.
184 wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
185 wantWritableHandle fun h@(FileHandle _ m) act
186 = wantWritableHandle' fun h m act
187 wantWritableHandle fun h@(DuplexHandle _ _ m) act
188 = withHandle_' fun h m act
191 :: String -> Handle -> MVar Handle__
192 -> (Handle__ -> IO a) -> IO a
193 wantWritableHandle' fun h m act
194 = withHandle_' fun h m (checkWritableHandle act)
196 checkWritableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
197 checkWritableHandle act h_@Handle__{..}
199 ClosedHandle -> ioe_closedHandle
200 SemiClosedHandle -> ioe_closedHandle
201 ReadHandle -> ioe_notWritable
202 ReadWriteHandle -> do
203 buf <- readIORef haCharBuffer
204 when (not (isWriteBuffer buf)) $ do
205 flushCharReadBuffer h_
206 flushByteReadBuffer h_
207 buf <- readIORef haCharBuffer
208 writeIORef haCharBuffer buf{ bufState = WriteBuffer }
209 buf <- readIORef haByteBuffer
210 writeIORef haByteBuffer buf{ bufState = WriteBuffer }
214 -- ---------------------------------------------------------------------------
215 -- Wrapper for read operations.
217 wantReadableHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
218 wantReadableHandle fun h act = withHandle fun h (checkReadableHandle act)
220 wantReadableHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
221 wantReadableHandle_ fun h@(FileHandle _ m) act
222 = wantReadableHandle' fun h m act
223 wantReadableHandle_ fun h@(DuplexHandle _ m _) act
224 = withHandle_' fun h m act
227 :: String -> Handle -> MVar Handle__
228 -> (Handle__ -> IO a) -> IO a
229 wantReadableHandle' fun h m act
230 = withHandle_' fun h m (checkReadableHandle act)
232 checkReadableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
233 checkReadableHandle act h_@Handle__{..} =
235 ClosedHandle -> ioe_closedHandle
236 SemiClosedHandle -> ioe_closedHandle
237 AppendHandle -> ioe_notReadable
238 WriteHandle -> ioe_notReadable
239 ReadWriteHandle -> do
240 -- a read/write handle and we want to read from it. We must
241 -- flush all buffered write data first.
242 cbuf <- readIORef haCharBuffer
243 when (isWriteBuffer cbuf) $ do
244 cbuf' <- flushWriteBuffer_ h_ cbuf
245 writeIORef haCharBuffer cbuf'{ bufState = ReadBuffer }
246 bbuf <- readIORef haByteBuffer
247 writeIORef haByteBuffer bbuf{ bufState = ReadBuffer }
251 -- ---------------------------------------------------------------------------
252 -- Wrapper for seek operations.
254 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
255 wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =
256 ioException (IOError (Just h) IllegalOperation fun
257 "handle is not seekable" Nothing Nothing)
258 wantSeekableHandle fun h@(FileHandle _ m) act =
259 withHandle_' fun h m (checkSeekableHandle act)
261 checkSeekableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
262 checkSeekableHandle act handle_@Handle__{haDevice=dev} =
263 case haType handle_ of
264 ClosedHandle -> ioe_closedHandle
265 SemiClosedHandle -> ioe_closedHandle
266 AppendHandle -> ioe_notSeekable
267 _ -> do b <- IODevice.isSeekable dev
268 if b then act handle_
271 -- -----------------------------------------------------------------------------
274 ioe_closedHandle, ioe_EOF,
275 ioe_notReadable, ioe_notWritable, ioe_cannotFlushTextRead,
276 ioe_notSeekable, ioe_notSeekable_notBin, ioe_invalidCharacter :: IO a
278 ioe_closedHandle = ioException
279 (IOError Nothing IllegalOperation ""
280 "handle is closed" Nothing Nothing)
281 ioe_EOF = ioException
282 (IOError Nothing EOF "" "" Nothing Nothing)
283 ioe_notReadable = ioException
284 (IOError Nothing IllegalOperation ""
285 "handle is not open for reading" Nothing Nothing)
286 ioe_notWritable = ioException
287 (IOError Nothing IllegalOperation ""
288 "handle is not open for writing" Nothing Nothing)
289 ioe_notSeekable = ioException
290 (IOError Nothing IllegalOperation ""
291 "handle is not seekable" Nothing Nothing)
292 ioe_notSeekable_notBin = ioException
293 (IOError Nothing IllegalOperation ""
294 "seek operations on text-mode handles are not allowed on this platform"
296 ioe_cannotFlushTextRead = ioException
297 (IOError Nothing IllegalOperation ""
298 "cannot flush the read buffer of a text-mode handle"
300 ioe_invalidCharacter = ioException
301 (IOError Nothing InvalidArgument ""
302 ("invalid byte sequence for this encoding") Nothing Nothing)
304 ioe_finalizedHandle :: FilePath -> Handle__
305 ioe_finalizedHandle fp = throw
306 (IOError Nothing IllegalOperation ""
307 "handle is finalized" Nothing (Just fp))
309 ioe_bufsiz :: Int -> IO a
310 ioe_bufsiz n = ioException
311 (IOError Nothing InvalidArgument "hSetBuffering"
312 ("illegal buffer size " ++ showsPrec 9 n []) Nothing Nothing)
313 -- 9 => should be parens'ified.
315 -- -----------------------------------------------------------------------------
318 -- For a duplex handle, we arrange that the read side points to the write side
319 -- (and hence keeps it alive if the read side is alive). This is done by
320 -- having the haOtherSide field of the read side point to the read side.
321 -- The finalizer is then placed on the write side, and the handle only gets
322 -- finalized once, when both sides are no longer required.
324 -- NOTE about finalized handles: It's possible that a handle can be
325 -- finalized and then we try to use it later, for example if the
326 -- handle is referenced from another finalizer, or from a thread that
327 -- has become unreferenced and then resurrected (arguably in the
328 -- latter case we shouldn't finalize the Handle...). Anyway,
329 -- we try to emit a helpful message which is better than nothing.
331 handleFinalizer :: FilePath -> MVar Handle__ -> IO ()
332 handleFinalizer fp m = do
333 handle_ <- takeMVar m
334 case haType handle_ of
335 ClosedHandle -> return ()
336 _ -> do flushWriteBuffer handle_ `catchAny` \_ -> return ()
337 -- ignore errors and async exceptions, and close the
338 -- descriptor anyway...
339 hClose_handle_ handle_
341 putMVar m (ioe_finalizedHandle fp)
343 -- ---------------------------------------------------------------------------
344 -- Allocating buffers
346 -- using an 8k char buffer instead of 32k improved performance for a
347 -- basic "cat" program by ~30% for me. --SDM
348 dEFAULT_CHAR_BUFFER_SIZE :: Int
349 dEFAULT_CHAR_BUFFER_SIZE = dEFAULT_BUFFER_SIZE `div` 4
351 getCharBuffer :: IODevice dev => dev -> BufferState
352 -> IO (IORef CharBuffer, BufferMode)
353 getCharBuffer dev state = do
354 buffer <- newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
355 ioref <- newIORef buffer
356 is_tty <- IODevice.isTerminal dev
359 | is_tty = LineBuffering
360 | otherwise = BlockBuffering Nothing
362 return (ioref, buffer_mode)
364 mkUnBuffer :: BufferState -> IO (IORef CharBuffer, BufferMode)
365 mkUnBuffer state = do
366 buffer <- case state of -- See [note Buffer Sizing], GHC.IO.Handle.Types
367 ReadBuffer -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
368 WriteBuffer -> newCharBuffer 1 state
369 ref <- newIORef buffer
370 return (ref, NoBuffering)
372 -- -----------------------------------------------------------------------------
375 -- | syncs the file with the buffer, including moving the
376 -- file pointer backwards in the case of a read buffer. This can fail
377 -- on a non-seekable read Handle.
378 flushBuffer :: Handle__ -> IO ()
379 flushBuffer h_@Handle__{..} = do
380 buf <- readIORef haCharBuffer
383 flushCharReadBuffer h_
384 flushByteReadBuffer h_
386 buf' <- flushWriteBuffer_ h_ buf
387 writeIORef haCharBuffer buf'
389 -- | flushes at least the Char buffer, and the byte buffer for a write
390 -- Handle. Works on all Handles.
391 flushCharBuffer :: Handle__ -> IO ()
392 flushCharBuffer h_@Handle__{..} = do
393 buf <- readIORef haCharBuffer
396 flushCharReadBuffer h_
398 buf' <- flushWriteBuffer_ h_ buf
399 writeIORef haCharBuffer buf'
401 -- -----------------------------------------------------------------------------
402 -- Writing data (flushing write buffers)
404 -- flushWriteBuffer flushes the buffer iff it contains pending write
405 -- data. Flushes both the Char and the byte buffer, leaving both
407 flushWriteBuffer :: Handle__ -> IO ()
408 flushWriteBuffer h_@Handle__{..} = do
409 buf <- readIORef haCharBuffer
411 then do buf' <- flushWriteBuffer_ h_ buf
412 writeIORef haCharBuffer buf'
415 flushWriteBuffer_ :: Handle__ -> CharBuffer -> IO CharBuffer
416 flushWriteBuffer_ h_@Handle__{..} cbuf = do
417 bbuf <- readIORef haByteBuffer
418 if not (isEmptyBuffer cbuf) || not (isEmptyBuffer bbuf)
419 then do writeTextDevice h_ cbuf
420 return cbuf{ bufL=0, bufR=0 }
423 -- -----------------------------------------------------------------------------
424 -- Flushing read buffers
426 -- It is always possible to flush the Char buffer back to the byte buffer.
427 flushCharReadBuffer :: Handle__ -> IO ()
428 flushCharReadBuffer Handle__{..} = do
429 cbuf <- readIORef haCharBuffer
430 if isWriteBuffer cbuf || isEmptyBuffer cbuf then return () else do
432 -- haLastDecode is the byte buffer just before we did our last batch of
433 -- decoding. We're going to re-decode the bytes up to the current char,
434 -- to find out where we should revert the byte buffer to.
435 (codec_state, bbuf0) <- readIORef haLastDecode
437 cbuf0 <- readIORef haCharBuffer
438 writeIORef haCharBuffer cbuf0{ bufL=0, bufR=0 }
440 -- if we haven't used any characters from the char buffer, then just
441 -- re-install the old byte buffer.
443 then do writeIORef haByteBuffer bbuf0
449 writeIORef haByteBuffer bbuf0 { bufL = bufL bbuf0 + bufL cbuf0 }
450 -- no decoder: the number of bytes to decode is the same as the
451 -- number of chars we have used up.
454 debugIO ("flushCharReadBuffer re-decode, bbuf=" ++ summaryBuffer bbuf0 ++
455 " cbuf=" ++ summaryBuffer cbuf0)
457 -- restore the codec state
458 setState decoder codec_state
460 (bbuf1,cbuf1) <- (encode decoder) bbuf0
461 cbuf0{ bufL=0, bufR=0, bufSize = bufL cbuf0 }
463 debugIO ("finished, bbuf=" ++ summaryBuffer bbuf1 ++
464 " cbuf=" ++ summaryBuffer cbuf1)
466 writeIORef haByteBuffer bbuf1
469 -- When flushing the byte read buffer, we seek backwards by the number
470 -- of characters in the buffer. The file descriptor must therefore be
471 -- seekable: attempting to flush the read buffer on an unseekable
472 -- handle is not allowed.
474 flushByteReadBuffer :: Handle__ -> IO ()
475 flushByteReadBuffer h_@Handle__{..} = do
476 bbuf <- readIORef haByteBuffer
478 if isEmptyBuffer bbuf then return () else do
480 seekable <- IODevice.isSeekable haDevice
481 when (not seekable) $ ioe_cannotFlushTextRead
483 let seek = negate (bufR bbuf - bufL bbuf)
485 debugIO ("flushByteReadBuffer: new file offset = " ++ show seek)
486 IODevice.seek haDevice RelativeSeek (fromIntegral seek)
488 writeIORef haByteBuffer bbuf{ bufL=0, bufR=0 }
490 -- ----------------------------------------------------------------------------
493 mkHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
497 -> Maybe TextEncoding
499 -> Maybe HandleFinalizer
500 -> Maybe (MVar Handle__)
503 mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side = do
504 openTextEncoding mb_codec ha_type $ \ mb_encoder mb_decoder -> do
506 let buf_state = initBufferState ha_type
507 bbuf <- Buffered.newBuffer dev buf_state
508 bbufref <- newIORef bbuf
509 last_decode <- newIORef (error "codec_state", bbuf)
512 if buffered then getCharBuffer dev buf_state
513 else mkUnBuffer buf_state
515 spares <- newIORef BufferListNil
516 newFileHandle filepath finalizer
517 (Handle__ { haDevice = dev,
519 haBufferMode = bmode,
520 haByteBuffer = bbufref,
521 haLastDecode = last_decode,
522 haCharBuffer = cbufref,
524 haEncoder = mb_encoder,
525 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 Buffered.flushWriteBuffer haDevice bbuf'
710 writeIORef haByteBuffer bbuf{bufL=0,bufR=0}
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