X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIO%2FHandle%2FInternals.hs;h=2c0523f9019e5c7b49d1b5e119e28fea4171046d;hb=b5c54282dc54cc861277ae532224775076a4818e;hp=d1b5ab6f3dbabbcabab55f7d6af82c2dd1236565;hpb=e79405706953d969676526d751426f260efacac1;p=ghc-base.git diff --git a/GHC/IO/Handle/Internals.hs b/GHC/IO/Handle/Internals.hs index d1b5ab6..2c0523f 100644 --- a/GHC/IO/Handle/Internals.hs +++ b/GHC/IO/Handle/Internals.hs @@ -28,13 +28,14 @@ module GHC.IO.Handle.Internals ( wantSeekableHandle, mkHandle, mkFileHandle, mkDuplexHandle, - openTextEncoding, initBufferState, + openTextEncoding, closeTextCodecs, initBufferState, dEFAULT_CHAR_BUFFER_SIZE, flushBuffer, flushWriteBuffer, flushWriteBuffer_, flushCharReadBuffer, flushCharBuffer, flushByteReadBuffer, readTextDevice, writeTextDevice, readTextDeviceNonBlocking, + decodeByteBuf, augmentIOError, ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable, @@ -49,7 +50,7 @@ module GHC.IO.Handle.Internals ( import GHC.IO import GHC.IO.IOMode -import GHC.IO.Encoding +import GHC.IO.Encoding as Encoding import GHC.IO.Handle.Types import GHC.IO.Buffer import GHC.IO.BufferedIO (BufferedIO) @@ -631,6 +632,11 @@ openTextEncoding (Just TextEncoding{..}) ha_type cont = do 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 + -- --------------------------------------------------------------------------- -- closing Handles @@ -656,7 +662,7 @@ 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 +hClose_handle_ h_@Handle__{..} = do -- close the file descriptor, but not when this is the read -- side of a duplex handle. @@ -675,8 +681,7 @@ hClose_handle_ Handle__{..} = do writeIORef haByteBuffer noByteBuffer -- release our encoder/decoder - case haDecoder of Nothing -> return (); Just d -> close d - case haEncoder of Nothing -> return (); Just d -> close d + closeTextCodecs h_ -- we must set the fd to -1, because the finalizer is going -- to run eventually and try to close/unlock it. @@ -822,22 +827,28 @@ readTextDeviceNonBlocking :: Handle__ -> CharBuffer -> IO CharBuffer readTextDeviceNonBlocking h_@Handle__{..} cbuf = do -- bbuf0 <- readIORef haByteBuffer - bbuf1 <- if not (isEmptyBuffer bbuf0) - then return bbuf0 - else do - (r,bbuf1) <- Buffered.fillReadBuffer0 haDevice bbuf0 - if isNothing r then ioe_EOF else do -- raise EOF - return bbuf1 + when (isEmptyBuffer bbuf0) $ do + (r,bbuf1) <- Buffered.fillReadBuffer0 haDevice bbuf0 + if isNothing r then ioe_EOF else do -- raise EOF + writeIORef haByteBuffer bbuf1 + + decodeByteBuf h_ cbuf + +-- Decode bytes from the byte buffer into the supplied CharBuffer. +decodeByteBuf :: Handle__ -> CharBuffer -> IO CharBuffer +decodeByteBuf h_@Handle__{..} cbuf = do + -- + bbuf0 <- readIORef haByteBuffer (bbuf2,cbuf') <- case haDecoder of Nothing -> do - writeIORef haLastDecode (error "codec_state", bbuf1) - latin1_decode bbuf1 cbuf + writeIORef haLastDecode (error "codec_state", bbuf0) + latin1_decode bbuf0 cbuf Just decoder -> do state <- getState decoder - writeIORef haLastDecode (state, bbuf1) - (encode decoder) bbuf1 cbuf + writeIORef haLastDecode (state, bbuf0) + (encode decoder) bbuf0 cbuf writeIORef haByteBuffer bbuf2 return cbuf'