wantSeekableHandle,
mkHandle, mkFileHandle, mkDuplexHandle,
- getEncoding, initBufferState,
+ openTextEncoding, initBufferState,
dEFAULT_CHAR_BUFFER_SIZE,
flushBuffer, flushWriteBuffer, flushWriteBuffer_, flushCharReadBuffer,
import GHC.Real
import GHC.Base
-import GHC.List
import GHC.Exception
import GHC.Num ( Num(..) )
import GHC.Show
import Control.Monad
import Data.Maybe
import Foreign
-import System.IO.Error
+-- import System.IO.Error
import System.Posix.Internals hiding (FD)
-import qualified System.Posix.Internals as Posix
#ifdef DEBUG_DUMP
import Foreign.C
_ -> do flushWriteBuffer handle_ `catchAny` \_ -> return ()
-- ignore errors and async exceptions, and close the
-- descriptor anyway...
- hClose_handle_ handle_
+ _ <- hClose_handle_ handle_
return ()
putMVar m (ioe_finalizedHandle fp)
-- haLastDecode is the byte buffer just before we did our last batch of
-- decoding. We're going to re-decode the bytes up to the current char,
-- to find out where we should revert the byte buffer to.
- bbuf0 <- readIORef haLastDecode
+ (codec_state, bbuf0) <- readIORef haLastDecode
cbuf0 <- readIORef haCharBuffer
writeIORef haCharBuffer cbuf0{ bufL=0, bufR=0 }
Just decoder -> do
debugIO ("flushCharReadBuffer re-decode, bbuf=" ++ summaryBuffer bbuf0 ++
" cbuf=" ++ summaryBuffer cbuf0)
+
+ -- restore the codec state
+ setState decoder codec_state
(bbuf1,cbuf1) <- (encode decoder) bbuf0
cbuf0{ bufL=0, bufR=0, bufSize = bufL cbuf0 }
- -- tricky case: if the decoded string starts with e BOM, then it was
- -- probably ignored last time we decoded these bytes, and we should
- -- therefore decode another char.
- (c,_) <- readCharBuf (bufRaw cbuf1) (bufL cbuf1)
- (bbuf2,_) <- if (c == '\xfeff')
- then do debugIO "found BOM, decoding another char"
- (encode decoder) bbuf1
- cbuf0{ bufL=0, bufR=0, bufSize = 1 }
- else return (bbuf1,cbuf1)
-
debugIO ("finished, bbuf=" ++ summaryBuffer bbuf1 ++
" cbuf=" ++ summaryBuffer cbuf1)
- writeIORef haByteBuffer bbuf2
+ writeIORef haByteBuffer bbuf1
-- When flushing the byte read buffer, we seek backwards by the number
-> Bool -- buffered?
-> Maybe TextEncoding
-> NewlineMode
- -> (Maybe HandleFinalizer)
+ -> Maybe HandleFinalizer
-> Maybe (MVar Handle__)
-> IO Handle
mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side = do
+ openTextEncoding mb_codec ha_type $ \ mb_encoder mb_decoder -> do
+
let buf_state = initBufferState ha_type
bbuf <- Buffered.newBuffer dev buf_state
bbufref <- newIORef bbuf
- last_decode <- newIORef bbuf
-
- (mb_encoder, mb_decoder) <- getEncoding mb_codec ha_type
+ last_decode <- newIORef (error "codec_state", bbuf)
(cbufref,bmode) <-
if buffered then getCharBuffer dev buf_state
initBufferState ReadHandle = ReadBuffer
initBufferState _ = WriteBuffer
-getEncoding :: Maybe TextEncoding -> HandleType
- -> IO (Maybe TextEncoder,
- Maybe TextDecoder)
+openTextEncoding
+ :: Maybe TextEncoding
+ -> HandleType
+ -> (forall es ds . Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a)
+ -> IO a
-getEncoding Nothing ha_type = return (Nothing, Nothing)
-getEncoding (Just te) ha_type = do
+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 te
+ decoder <- mkTextDecoder
return (Just decoder)
else
return Nothing
mb_encoder <- if isWritableHandleType ha_type then do
- encoder <- mkTextEncoder te
+ encoder <- mkTextEncoder
return (Just encoder)
else
return Nothing
- return (mb_encoder, mb_decoder)
+ cont mb_encoder mb_decoder
-- ---------------------------------------------------------------------------
-- closing Handles
--- hClose_help is also called by lazyRead (in PrelIO) when EOF is read
--- or an IO error occurs on a lazy stream. The semi-closed Handle is
--- then closed immediately. We have to be careful with DuplexHandles
--- though: we have to leave the closing to the finalizer in that case,
--- because the write side may still be in use.
+-- hClose_help is also called by lazyRead (in GHC.IO.Handle.Text) when
+-- EOF is read or an IO error occurs on a lazy stream. The
+-- semi-closed Handle is then closed immediately. We have to be
+-- careful with DuplexHandles though: we have to leave the closing to
+-- the finalizer in that case, because the write side may still be in
+-- use.
hClose_help :: Handle__ -> IO (Handle__, Maybe SomeException)
hClose_help handle_ =
case haType handle_ of
ClosedHandle -> return (handle_,Nothing)
- _ -> do flushWriteBuffer handle_ -- interruptible
- hClose_handle_ handle_
+ _ -> do mb_exc1 <- trymaybe $ flushWriteBuffer handle_ -- interruptible
+ -- it is important that hClose doesn't fail and
+ -- leave the Handle open (#3128), so we catch
+ -- exceptions when flushing the buffer.
+ (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_ Handle__{..} = do
-- raise it if necessary.
maybe_exception <-
case haOtherSide of
- Nothing -> (do IODevice.close haDevice; return Nothing)
- `catchException` \e -> return (Just e)
-
+ Nothing -> trymaybe $ IODevice.close haDevice
Just _ -> return Nothing
-- free the spare buffers
debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf1)
- writeIORef haLastDecode bbuf1
- (bbuf2,cbuf') <- case haDecoder of
- Nothing -> latin1_decode bbuf1 cbuf
- Just decoder -> (encode decoder) bbuf1 cbuf
+ (bbuf2,cbuf') <-
+ case haDecoder of
+ Nothing -> do
+ writeIORef haLastDecode (error "codec_state", bbuf1)
+ latin1_decode bbuf1 cbuf
+ Just decoder -> do
+ state <- getState decoder
+ writeIORef haLastDecode (state, bbuf1)
+ (encode decoder) bbuf1 cbuf
debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++
" bbuf=" ++ summaryBuffer bbuf2)
debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf2)
- writeIORef haLastDecode bbuf2
- (bbuf3,cbuf') <- case haDecoder of
- Nothing -> latin1_decode bbuf2 cbuf
- Just decoder -> (encode decoder) bbuf2 cbuf
+ (bbuf3,cbuf') <-
+ case haDecoder of
+ Nothing -> do
+ writeIORef haLastDecode (error "codec_state", bbuf2)
+ latin1_decode bbuf2 cbuf
+ Just decoder -> do
+ state <- getState decoder
+ writeIORef haLastDecode (state, bbuf2)
+ (encode decoder) bbuf2 cbuf
debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++
" bbuf=" ++ summaryBuffer bbuf3)
projects / ghc-base.git / blobdiff