@@ -57,7 +57,8 @@ import Data.Bits ((.&.))
5757import Data.ByteString as B
5858import Data.ByteString.Internal as B
5959import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
60−import Data.Text.Internal (Text(..), textP)
60+import Data.Text.Internal (Text(..))
61+import Data.Text.Private (runText)
6162import Data.Text.UnsafeChar (ord, unsafeWrite)
6263import Data.Text.UnsafeShift (shiftL, shiftR)
6364import Data.Word (Word8)
@@ -96,30 +97,30 @@ decodeASCII = decodeUtf8
9697
9798-- | Decode a 'ByteString' containing UTF-8 encoded text.
9899decodeUtf8With :: OnDecodeError -> ByteString -> Text
99−decodeUtf8With onErr (PS fp off len) = textP (fst a) 0 (snd a)
100+decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
101+ let go dest = withForeignPtr fp $ \ptr ->
102+ with (0::CSize) $ \destOffPtr -> do
103+ let end = ptr `plusPtr` (off + len)
104+ loop curPtr = do
105+ curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end
106+ if curPtr' == end
107+ then do
108+ n <- peek destOffPtr
109+ unsafeSTToIO (done dest (fromIntegral n))
110+ else do
111+ x <- peek curPtr'
112+ case onErr desc (Just x) of
113+ Nothing -> loop $ curPtr' `plusPtr` 1
114+ Just c -> do
115+ destOff <- peek destOffPtr
116+ w <- unsafeSTToIO $
117+ unsafeWrite dest (fromIntegral destOff) c
118+ poke destOffPtr (destOff + fromIntegral w)
119+ loop $ curPtr' `plusPtr` 1
120+ loop (ptr `plusPtr` off)
121+ (unsafeIOToST . go) =<< A.new len
100122 where
101− a = A.run2 (A.new len >>= unsafeIOToST . go)
102123 desc = "Data.Text.Encoding.decodeUtf8: Invalid UTF-8 stream"
103− go dest = withForeignPtr fp $ \ptr ->
104− with (0::CSize) $ \destOffPtr -> do
105− let end = ptr `plusPtr` (off + len)
106− loop curPtr = do
107− curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end
108− if curPtr' == end
109− then do
110− n <- peek destOffPtr
111− return (dest,fromIntegral n)
112− else do
113− x <- peek curPtr'
114− case onErr desc (Just x) of
115− Nothing -> loop $ curPtr' `plusPtr` 1
116− Just c -> do
117− destOff <- peek destOffPtr
118− w <- unsafeSTToIO $
119− unsafeWrite dest (fromIntegral destOff) c
120− poke destOffPtr (destOff + fromIntegral w)
121− loop $ curPtr' `plusPtr` 1
122− loop (ptr `plusPtr` off)
123124{- INLINE[0] decodeUtf8With #-}
124125
125126-- | Decode a 'ByteString' containing UTF-8 encoded text that is known