module GHC.IO.Handle.Internals (
withHandle, withHandle', withHandle_,
withHandle__', withHandle_', withAllHandles__,
wantWritableHandle, wantReadableHandle, wantReadableHandle_,
wantSeekableHandle,
mkHandle, mkFileHandle, mkDuplexHandle,
openTextEncoding, closeTextCodecs, initBufferState,
dEFAULT_CHAR_BUFFER_SIZE,
flushBuffer, flushWriteBuffer, flushCharReadBuffer,
flushCharBuffer, flushByteReadBuffer, flushByteWriteBuffer,
readTextDevice, writeCharBuffer, readTextDeviceNonBlocking,
decodeByteBuf,
augmentIOError,
ioe_closedHandle, ioe_semiclosedHandle,
ioe_EOF, ioe_notReadable, ioe_notWritable,
ioe_finalizedHandle, ioe_bufsiz,
hClose_help, hLookAhead_,
HandleFinalizer, handleFinalizer,
debugIO, traceIO
) where
import GHC.IO
import GHC.IO.IOMode
import GHC.IO.Encoding as Encoding
import GHC.IO.Encoding.Types (CodeBuffer)
import GHC.IO.Handle.Types
import GHC.IO.Buffer
import GHC.IO.BufferedIO (BufferedIO)
import GHC.IO.Exception
import GHC.IO.Device (IODevice, RawIO, SeekMode(..))
import GHC.IO.SubSystem ((<!>), isWindowsNativeIO)
import qualified GHC.IO.Device as IODevice
import qualified GHC.IO.BufferedIO as Buffered
import GHC.Conc.Sync
import GHC.Real
import GHC.Base
import GHC.Exception
import GHC.Num ( Num(..) )
import GHC.Show
import GHC.IORef
import GHC.MVar
import Data.Typeable
import Data.Maybe
import Foreign
import System.Posix.Internals hiding (FD)
import Foreign.C
c_DEBUG_DUMP :: Bool
c_DEBUG_DUMP = False
type HandleFinalizer = FilePath -> MVar Handle__ -> IO ()
newFileHandle :: FilePath -> Maybe HandleFinalizer -> Handle__ -> IO Handle
newFileHandle filepath mb_finalizer hc = do
m <- newMVar hc
case mb_finalizer of
Just finalizer -> do debugIO $ "Registering finalizer: " ++ show filepath
addMVarFinalizer m (finalizer filepath m)
Nothing -> do debugIO $ "No finalizer: " ++ show filepath
return ()
return (FileHandle filepath m)
withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
withHandle fun h@(FileHandle _ m) act = withHandle' fun h m act
withHandle fun h@(DuplexHandle _ m _) act = withHandle' fun h m act
withHandle' :: String -> Handle -> MVar Handle__
-> (Handle__ -> IO (Handle__,a)) -> IO a
withHandle' fun h m act =
mask_ $ do
(h',v) <- do_operation fun h act m
checkHandleInvariants h'
putMVar m h'
return v
withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ fun h@(FileHandle _ m) act = withHandle_' fun h m act
withHandle_ fun h@(DuplexHandle _ m _) act = withHandle_' fun h m act
withHandle_' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' fun h m act = withHandle' fun h m $ \h_ -> do
a <- act h_
return (h_,a)
withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
withAllHandles__ fun h@(FileHandle _ m) act = withHandle__' fun h m act
withAllHandles__ fun h@(DuplexHandle _ r w) act = do
withHandle__' fun h r act
withHandle__' fun h w act
withHandle__' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__)
-> IO ()
withHandle__' fun h m act =
mask_ $ do
h' <- do_operation fun h act m
checkHandleInvariants h'
putMVar m h'
return ()
do_operation :: String -> Handle -> (Handle__ -> IO a) -> MVar Handle__ -> IO a
do_operation fun h act m = do
h_ <- takeMVar m
checkHandleInvariants h_
act h_ `catchException` handler h_
where
handler h_ e = do
putMVar m h_
case () of
_ | Just ioe <- fromException e ->
ioError (augmentIOError ioe fun h)
_ | Just async_ex <- fromException e -> do
let _ = async_ex :: SomeAsyncException
t <- myThreadId
throwTo t e
do_operation fun h act m
_otherwise ->
throwIO e
augmentIOError :: IOException -> String -> Handle -> IOException
augmentIOError ioe@IOError{ ioe_filename = fp } fun h
= ioe { ioe_handle = Just h, ioe_location = fun, ioe_filename = filepath }
where filepath
| Just _ <- fp = fp
| otherwise = case h of
FileHandle path _ -> Just path
DuplexHandle path _ _ -> Just path
wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
wantWritableHandle fun h@(FileHandle _ m) act
= wantWritableHandle' fun h m act
wantWritableHandle fun h@(DuplexHandle _ _ m) act
= wantWritableHandle' fun h m act
wantWritableHandle'
:: String -> Handle -> MVar Handle__
-> (Handle__ -> IO a) -> IO a
wantWritableHandle' fun h m act
= withHandle_' fun h m (checkWritableHandle act)
checkWritableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
checkWritableHandle act h_@Handle__{..}
= case haType of
ClosedHandle -> ioe_closedHandle
SemiClosedHandle -> ioe_semiclosedHandle
ReadHandle -> ioe_notWritable
ReadWriteHandle -> do
buf <- readIORef haCharBuffer
when (not (isWriteBuffer buf)) $ do
flushCharReadBuffer h_
flushByteReadBuffer h_
buf <- readIORef haCharBuffer
writeIORef haCharBuffer buf{ bufState = WriteBuffer }
buf <- readIORef haByteBuffer
buf' <- Buffered.emptyWriteBuffer haDevice buf
writeIORef haByteBuffer buf'
act h_
AppendHandle -> act h_
WriteHandle -> act h_
wantReadableHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
wantReadableHandle fun h act =
withHandle fun h (checkReadableHandle act)
wantReadableHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
wantReadableHandle_ fun h@(FileHandle _ m) act
= wantReadableHandle' fun h m act
wantReadableHandle_ fun h@(DuplexHandle _ m _) act
= wantReadableHandle' fun h m act
wantReadableHandle'
:: String -> Handle -> MVar Handle__
-> (Handle__ -> IO a) -> IO a
wantReadableHandle' fun h m act
= withHandle_' fun h m (checkReadableHandle act)
checkReadableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
checkReadableHandle act h_@Handle__{..} =
case haType of
ClosedHandle -> ioe_closedHandle
SemiClosedHandle -> ioe_semiclosedHandle
AppendHandle -> ioe_notReadable
WriteHandle -> ioe_notReadable
ReadWriteHandle -> do
bbuf <- readIORef haByteBuffer
when (isWriteBuffer bbuf) $ do
when (not (isEmptyBuffer bbuf)) $ flushByteWriteBuffer h_
cbuf' <- readIORef haCharBuffer
writeIORef haCharBuffer cbuf'{ bufState = ReadBuffer }
bbuf <- readIORef haByteBuffer
writeIORef haByteBuffer bbuf{ bufState = ReadBuffer }
act h_
_other -> act h_
wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =
ioException (IOError (Just h) IllegalOperation fun
"handle is not seekable" Nothing Nothing)
wantSeekableHandle fun h@(FileHandle _ m) act =
withHandle_' fun h m (checkSeekableHandle act)
checkSeekableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
checkSeekableHandle act handle_@Handle__{haDevice=dev} =
case haType handle_ of
ClosedHandle -> ioe_closedHandle
SemiClosedHandle -> ioe_semiclosedHandle
AppendHandle -> ioe_notSeekable
_ -> do b <- IODevice.isSeekable dev
if b then act handle_
else ioe_notSeekable
ioe_closedHandle, ioe_semiclosedHandle, ioe_EOF,
ioe_notReadable, ioe_notWritable, ioe_cannotFlushNotSeekable,
ioe_notSeekable :: IO a
ioe_closedHandle = ioException
(IOError Nothing IllegalOperation ""
"handle is closed" Nothing Nothing)
ioe_semiclosedHandle = ioException
(IOError Nothing IllegalOperation ""
"handle is semi-closed" Nothing Nothing)
ioe_EOF = ioException
(IOError Nothing EOF "" "" Nothing Nothing)
ioe_notReadable = ioException
(IOError Nothing IllegalOperation ""
"handle is not open for reading" Nothing Nothing)
ioe_notWritable = ioException
(IOError Nothing IllegalOperation ""
"handle is not open for writing" Nothing Nothing)
ioe_notSeekable = ioException
(IOError Nothing IllegalOperation ""
"handle is not seekable" Nothing Nothing)
ioe_cannotFlushNotSeekable = ioException
(IOError Nothing IllegalOperation ""
"cannot flush the read buffer: underlying device is not seekable"
Nothing Nothing)
ioe_finalizedHandle :: FilePath -> Handle__
ioe_finalizedHandle fp = throw
(IOError Nothing IllegalOperation ""
"handle is finalized" Nothing (Just fp))
ioe_bufsiz :: Int -> IO a
ioe_bufsiz n = ioException
(IOError Nothing InvalidArgument "hSetBuffering"
("illegal buffer size " ++ showsPrec 9 n []) Nothing Nothing)
streamEncode :: BufferCodec from to state
-> Buffer from -> Buffer to
-> IO (Buffer from, Buffer to)
streamEncode codec from to = fmap (\(_, from', to') -> (from', to')) $ recoveringEncode codec from to
recoveringEncode :: BufferCodec from to state -> CodeBuffer from to
recoveringEncode codec from to = go from to
where
go from to = do
(why, from', to') <- encode codec from to
case why of
InvalidSequence | bufL from == bufL from' -> do
(from', to') <- recover codec from' to'
go from' to'
_ -> return (why, from', to')
handleFinalizer :: FilePath -> MVar Handle__ -> IO ()
handleFinalizer fp m = do
handle_ <- takeMVar m
(handle_', _) <- hClose_help handle_
putMVar m handle_'
return ()
dEFAULT_CHAR_BUFFER_SIZE :: Int
dEFAULT_CHAR_BUFFER_SIZE = 2048
getCharBuffer :: IODevice dev => dev -> BufferState
-> IO (IORef CharBuffer, BufferMode)
getCharBuffer dev state = do
buffer <- newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
ioref <- newIORef buffer
is_tty <- IODevice.isTerminal dev
let buffer_mode
| is_tty = LineBuffering
| otherwise = BlockBuffering Nothing
return (ioref, buffer_mode)
mkUnBuffer :: BufferState -> IO (IORef CharBuffer, BufferMode)
mkUnBuffer state = do
buffer <- newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
ref <- newIORef buffer
return (ref, NoBuffering)
flushBuffer :: Handle__ -> IO ()
flushBuffer h_@Handle__{..} = do
buf <- readIORef haCharBuffer
case bufState buf of
ReadBuffer -> do
flushCharReadBuffer h_
flushByteReadBuffer h_
WriteBuffer -> do
flushByteWriteBuffer h_
flushCharBuffer :: Handle__ -> IO ()
flushCharBuffer h_@Handle__{..} = do
cbuf <- readIORef haCharBuffer
case bufState cbuf of
ReadBuffer -> do
flushCharReadBuffer h_
WriteBuffer ->
when (not (isEmptyBuffer cbuf)) $
error "internal IO library error: Char buffer non-empty"
flushWriteBuffer :: Handle__ -> IO ()
flushWriteBuffer h_@Handle__{..} = do
buf <- readIORef haByteBuffer
when (isWriteBuffer buf) $ flushByteWriteBuffer h_
flushByteWriteBuffer :: Handle__ -> IO ()
flushByteWriteBuffer h_@Handle__{..} = do
bbuf <- readIORef haByteBuffer
when (not (isEmptyBuffer bbuf)) $ do
bbuf' <- Buffered.flushWriteBuffer haDevice bbuf
debugIO ("flushByteWriteBuffer: bbuf=" ++ summaryBuffer bbuf')
writeIORef haByteBuffer bbuf'
writeCharBuffer :: Handle__ -> CharBuffer -> IO ()
writeCharBuffer h_@Handle__{..} !cbuf = do
bbuf <- readIORef haByteBuffer
debugIO ("writeCharBuffer: cbuf=" ++ summaryBuffer cbuf ++
" bbuf=" ++ summaryBuffer bbuf)
(cbuf',bbuf') <- case haEncoder of
Nothing -> latin1_encode cbuf bbuf
Just encoder -> (streamEncode encoder) cbuf bbuf
debugIO ("writeCharBuffer after encoding: cbuf=" ++ summaryBuffer cbuf' ++
" bbuf=" ++ summaryBuffer bbuf')
if isFullBuffer bbuf'
|| not (isEmptyBuffer cbuf') && bufL cbuf' == bufL cbuf
|| (case haBufferMode of
BlockBuffering (Just s) -> bufferElems bbuf' >= s
NoBuffering -> True
_other -> False)
then do
bbuf'' <- Buffered.flushWriteBuffer haDevice bbuf'
writeIORef haByteBuffer bbuf''
debugIO ("writeCharBuffer after flushing: cbuf=" ++ summaryBuffer bbuf'')
else
writeIORef haByteBuffer bbuf'
if not (isEmptyBuffer cbuf')
then writeCharBuffer h_ cbuf'
else return ()
flushCharReadBuffer :: Handle__ -> IO ()
flushCharReadBuffer Handle__{..} = do
cbuf <- readIORef haCharBuffer
if isWriteBuffer cbuf || isEmptyBuffer cbuf then return () else do
(codec_state, bbuf0) <- readIORef haLastDecode
cbuf0 <- readIORef haCharBuffer
writeIORef haCharBuffer cbuf0{ bufL=0, bufR=0 }
if bufL cbuf0 == 0
then do writeIORef haByteBuffer bbuf0
return ()
else do
case haDecoder of
Nothing -> do
writeIORef haByteBuffer bbuf0 { bufL = bufL bbuf0 + bufL cbuf0 }
Just decoder -> do
debugIO ("flushCharReadBuffer re-decode, bbuf=" ++ summaryBuffer bbuf0 ++
" cbuf=" ++ summaryBuffer cbuf0)
setState decoder codec_state
(bbuf1,cbuf1) <- (streamEncode decoder) bbuf0
cbuf0{ bufL=0, bufR=0, bufSize = bufL cbuf0 }
writeIORef haByteBuffer bbuf1
flushByteReadBuffer :: Handle__ -> IO ()
flushByteReadBuffer h_@Handle__{..} = do
bbuf <- readIORef haByteBuffer
if isEmptyBuffer bbuf then return () else do
seekable <- IODevice.isSeekable haDevice
when (not seekable) $ ioe_cannotFlushNotSeekable
let seek = negate (bufR bbuf bufL bbuf)
let offset = bufOffset bbuf fromIntegral (bufR bbuf bufL bbuf)
debugIO ("flushByteReadBuffer: new file offset = " ++ show seek)
debugIO ("flushByteReadBuffer: " ++ summaryBuffer bbuf)
let mIOSeek = IODevice.seek haDevice RelativeSeek (fromIntegral seek)
let winIOSeek = IODevice.seek haDevice AbsoluteSeek (fromIntegral offset)
_ <- mIOSeek <!> winIOSeek
writeIORef haByteBuffer bbuf{ bufL=0, bufR=0, bufOffset=offset }
mkHandle :: (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) => dev
-> FilePath
-> HandleType
-> Bool
-> Maybe TextEncoding
-> NewlineMode
-> Maybe HandleFinalizer
-> Maybe (MVar Handle__)
-> IO Handle
mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side =
openTextEncoding mb_codec ha_type $ \ mb_encoder mb_decoder -> do
let !buf_state = initBufferState ha_type
!bbuf_no_offset <- (Buffered.newBuffer dev buf_state)
!buf_offset <- initHandleOffset
let !bbuf = bbuf_no_offset { bufOffset = buf_offset}
bbufref <- newIORef bbuf
last_decode <- newIORef (errorWithoutStackTrace "codec_state", bbuf)
(cbufref,bmode) <-
if buffered then getCharBuffer dev buf_state
else mkUnBuffer buf_state
spares <- newIORef BufferListNil
debugIO $ "making handle for " ++ filepath
newFileHandle filepath finalizer
(Handle__ { haDevice = dev,
haType = ha_type,
haBufferMode = bmode,
haByteBuffer = bbufref,
haLastDecode = last_decode,
haCharBuffer = cbufref,
haBuffers = spares,
haEncoder = mb_encoder,
haDecoder = mb_decoder,
haCodec = mb_codec,
haInputNL = inputNL nl,
haOutputNL = outputNL nl,
haOtherSide = other_side
})
where
initHandleOffset
| isAppendHandleType ha_type
, isWindowsNativeIO = do
size <- IODevice.getSize dev
return (fromIntegral size :: Word64)
| otherwise = return 0
mkFileHandle :: (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev)
=> dev
-> FilePath
-> IOMode
-> Maybe TextEncoding
-> NewlineMode
-> IO Handle
mkFileHandle dev filepath iomode mb_codec tr_newlines = do
mkHandle dev filepath (ioModeToHandleType iomode) True mb_codec
tr_newlines
(Just handleFinalizer) Nothing
mkDuplexHandle :: (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) => dev
-> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
mkDuplexHandle dev filepath mb_codec tr_newlines = do
write_side@(FileHandle _ write_m) <-
mkHandle dev filepath WriteHandle True mb_codec
tr_newlines
(Just handleFinalizer)
Nothing
read_side@(FileHandle _ read_m) <-
mkHandle dev filepath ReadHandle True mb_codec
tr_newlines
Nothing
(Just write_m)
return (DuplexHandle filepath read_m write_m)
ioModeToHandleType :: IOMode -> HandleType
ioModeToHandleType ReadMode = ReadHandle
ioModeToHandleType WriteMode = WriteHandle
ioModeToHandleType ReadWriteMode = ReadWriteHandle
ioModeToHandleType AppendMode = AppendHandle
initBufferState :: HandleType -> BufferState
initBufferState ReadHandle = ReadBuffer
initBufferState _ = WriteBuffer
openTextEncoding
:: Maybe TextEncoding
-> HandleType
-> (forall es ds . Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a)
-> IO a
openTextEncoding Nothing ha_type cont = cont Nothing Nothing
openTextEncoding (Just TextEncoding{..}) ha_type cont = do
mb_decoder <- if isReadableHandleType ha_type then do
decoder <- mkTextDecoder
return (Just decoder)
else
return Nothing
mb_encoder <- if isWritableHandleType ha_type then do
encoder <- mkTextEncoder
return (Just encoder)
else
return Nothing
cont mb_encoder mb_decoder
closeTextCodecs :: Handle__ -> IO ()
closeTextCodecs Handle__{..} = do
case haDecoder of Nothing -> return (); Just d -> Encoding.close d
case haEncoder of Nothing -> return (); Just d -> Encoding.close d
hClose_help :: Handle__ -> IO (Handle__, Maybe SomeException)
hClose_help handle_ =
case haType handle_ of
ClosedHandle -> return (handle_,Nothing)
_ -> do mb_exc1 <- trymaybe $ flushWriteBuffer handle_
(h_, mb_exc2) <- hClose_handle_ handle_
return (h_, if isJust mb_exc1 then mb_exc1 else mb_exc2)
trymaybe :: IO () -> IO (Maybe SomeException)
trymaybe io = (do io; return Nothing) `catchException` \e -> return (Just e)
hClose_handle_ :: Handle__ -> IO (Handle__, Maybe SomeException)
hClose_handle_ h_@Handle__{..} = do
maybe_exception <-
case haOtherSide of
Nothing -> trymaybe $ IODevice.close haDevice
Just _ -> return Nothing
writeIORef haBuffers BufferListNil
writeIORef haCharBuffer noCharBuffer
writeIORef haByteBuffer noByteBuffer
closeTextCodecs h_
return (Handle__{ haType = ClosedHandle, .. }, maybe_exception)
noCharBuffer :: CharBuffer
noCharBuffer = unsafePerformIO $ newCharBuffer 1 ReadBuffer
noByteBuffer :: Buffer Word8
noByteBuffer = unsafePerformIO $ newByteBuffer 1 ReadBuffer
hLookAhead_ :: Handle__ -> IO Char
hLookAhead_ handle_@Handle__{..} = do
buf <- readIORef haCharBuffer
new_buf <- if isEmptyBuffer buf
then readTextDevice handle_ buf
else return buf
writeIORef haCharBuffer new_buf
peekCharBuf (bufRaw buf) (bufL buf)
debugIO :: String -> IO ()
debugIO s
| c_DEBUG_DUMP
= do _ <- withCStringLen (s ++ "\n") $
\(p, len) -> c_write 1 (castPtr p) (fromIntegral len)
return ()
| otherwise = return ()
traceIO :: String -> IO ()
traceIO s = do
_ <- withCStringLen (s ++ "\n") $
\(p, len) -> c_write 1 (castPtr p) (fromIntegral len)
return ()
readTextDevice :: Handle__ -> CharBuffer -> IO CharBuffer
readTextDevice h_@Handle__{..} cbuf = do
bbuf0 <- readIORef haByteBuffer
debugIO ("readTextDevice: cbuf=" ++ summaryBuffer cbuf ++
" bbuf=" ++ summaryBuffer bbuf0)
bbuf1 <- if not (isEmptyBuffer bbuf0)
then return bbuf0
else do
debugIO $ "readBuf at " ++ show (bufferOffset bbuf0)
(r,bbuf1) <- Buffered.fillReadBuffer haDevice bbuf0
debugIO $ "readBuf after " ++ show (bufferOffset bbuf1)
if r == 0 then ioe_EOF else do
return bbuf1
debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf1)
(bbuf2,cbuf') <-
case haDecoder of
Nothing -> do
writeIORef haLastDecode (errorWithoutStackTrace "codec_state", bbuf1)
latin1_decode bbuf1 cbuf
Just decoder -> do
state <- getState decoder
writeIORef haLastDecode (state, bbuf1)
(streamEncode decoder) bbuf1 cbuf
debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++
" bbuf=" ++ summaryBuffer bbuf2)
writeIORef haByteBuffer bbuf2
if bufR cbuf' == bufR cbuf
then readTextDevice' h_ bbuf2 cbuf
else return cbuf'
readTextDevice' :: Handle__ -> Buffer Word8 -> CharBuffer -> IO CharBuffer
readTextDevice' h_@Handle__{..} bbuf0 cbuf0 = do
bbuf1 <- slideContents bbuf0
let Just decoder = haDecoder
(r,bbuf2) <- Buffered.fillReadBuffer haDevice bbuf1
if r == 0
then do
if isEmptyBuffer bbuf2 then ioe_EOF else do
(bbuf3, cbuf1) <- recover decoder bbuf2 cbuf0
debugIO ("readTextDevice' after recovery: bbuf=" ++ summaryBuffer bbuf3 ++ ", cbuf=" ++ summaryBuffer cbuf1)
writeIORef haByteBuffer bbuf3
if bufR cbuf1 == bufR cbuf0
then readTextDevice h_ cbuf1
else return cbuf1
else do
debugIO ("readTextDevice' after reading: bbuf=" ++ summaryBuffer bbuf2)
(bbuf3,cbuf1) <- do
state <- getState decoder
writeIORef haLastDecode (state, bbuf2)
(streamEncode decoder) bbuf2 cbuf0
debugIO ("readTextDevice' after decoding: cbuf=" ++ summaryBuffer cbuf1 ++
" bbuf=" ++ summaryBuffer bbuf3)
writeIORef haByteBuffer bbuf3
if bufR cbuf0 == bufR cbuf1
then readTextDevice' h_ bbuf3 cbuf1
else return cbuf1
readTextDeviceNonBlocking :: Handle__ -> CharBuffer -> IO CharBuffer
readTextDeviceNonBlocking h_@Handle__{..} cbuf = do
bbuf0 <- readIORef haByteBuffer
when (isEmptyBuffer bbuf0) $ do
(r,bbuf1) <- Buffered.fillReadBuffer0 haDevice bbuf0
if isNothing r then ioe_EOF else do
writeIORef haByteBuffer bbuf1
decodeByteBuf h_ cbuf
decodeByteBuf :: Handle__ -> CharBuffer -> IO CharBuffer
decodeByteBuf h_@Handle__{..} cbuf = do
bbuf0 <- readIORef haByteBuffer
(bbuf2,cbuf') <-
case haDecoder of
Nothing -> do
writeIORef haLastDecode (errorWithoutStackTrace "codec_state", bbuf0)
latin1_decode bbuf0 cbuf
Just decoder -> do
state <- getState decoder
writeIORef haLastDecode (state, bbuf0)
(streamEncode decoder) bbuf0 cbuf
writeIORef haByteBuffer bbuf2
return cbuf'