@@ -22,12 +22,14 @@ module Data.Text.Encoding
2222 -- * Decoding ByteStrings to Text
2323 decodeASCII
2424 , decodeUtf8
25+ , decodeUtf8'
2526 , decodeUtf16LE
2627 , decodeUtf16BE
2728 , decodeUtf32LE
2829 , decodeUtf32BE
2930 -- ** Controllable error handling
3031 , decodeUtf8With
32+ , decodeUtf8With'
3133 , decodeUtf16LEWith
3234 , decodeUtf16BEWith
3335 , decodeUtf32LEWith
@@ -44,10 +46,10 @@ module Data.Text.Encoding
4446import Data.Bits ((.&.))
4547import Data.ByteString as B
4648import Data.ByteString.Internal as B
49+import Data.ByteString.Unsafe as B
4750import Data.Text.Encoding.Error (OnDecodeError, strictDecode)
48−import Data.Text.Encoding.Utf16 (chr2)
49−import Data.Text.Internal (Text(..))
50−import Data.Text.UnsafeChar (ord)
51+import Data.Text.Internal (Text(..), textP)
52+import Data.Text.UnsafeChar (ord, unsafeWrite)
5153import Data.Text.UnsafeShift (shiftL, shiftR)
5254import Data.Word (Word8)
5355import Foreign.ForeignPtr (withForeignPtr)
@@ -56,6 +58,8 @@ import Foreign.Storable (poke)
5658import System.IO.Unsafe (unsafePerformIO)
5759import qualified Data.Text.Array as A
5860import qualified Data.Text.Encoding.Fusion as E
61+import qualified Data.Text.Encoding.Utf16 as U16
62+import qualified Data.Text.Encoding.Utf8 as U8
5963import qualified Data.Text.Fusion as F
6064
6165-- | Decode a 'ByteString' containing 7-bit ASCII encoded text.
@@ -73,6 +77,46 @@ decodeUtf8 :: ByteString -> Text
7377decodeUtf8 = decodeUtf8With strictDecode
7478{-# INLINE decodeUtf8 #-}
7579
80+decodeUtf8With' :: OnDecodeError -> ByteString -> Text
81+decodeUtf8With' onErr bs = textP (fst a) 0 (snd a)
82+ where
83+ a = A.run2 (A.new len >>= outer 0 0)
84+ len = B.length bs
85+ outer n0 m0 arr = go n0 m0
86+ where
87+ go !n !m = do
88+ let x1 = idx m
89+ x2 = idx (m + 1)
90+ x3 = idx (m + 2)
91+ x4 = idx (m + 3)
92+ idx = B.unsafeIndex bs
93+ case undefined of
94+ _| m >= len -> return (arr,n)
95+ | U8.validate1 x1 -> do
96+ A.unsafeWrite arr n (fromIntegral x1)
97+ go (n+1) (m+1)
98+ | m+1 < len && U8.validate2 x1 x2 -> do
99+ w <- unsafeWrite arr n (U8.chr2 x1 x2)
100+ go (n+w) (m+2)
101+ | m+2 < len && U8.validate3 x1 x2 x3 -> do
102+ w <- unsafeWrite arr n (U8.chr3 x1 x2 x3)
103+ go (n+w) (m+3)
104+ | m+3 < len && U8.validate4 x1 x2 x3 x4 -> do
105+ w <- unsafeWrite arr n (U8.chr4 x1 x2 x3 x4)
106+ go (n+w) (m+4)
107+ | otherwise -> case onErr desc (Just x1) of
108+ Nothing -> go n (m+1)
109+ Just c -> do
110+ w <- unsafeWrite arr n c
111+ go (n+w) (m+1)
112+ desc = "Data.Text.Encoding.encodeUtf8: Invalid UTF-8 stream"
113+{-# INLINE decodeUtf8With' #-}
114+
115+-- | Decode a 'ByteString' containing UTF-8 encoded text.
116+decodeUtf8' :: ByteString -> Text
117+decodeUtf8' = decodeUtf8With' strictDecode
118+{-# INLINE decodeUtf8' #-}
119+
76120-- | Encode text using UTF-8 encoding.
77121encodeUtf8 :: Text -> ByteString
78122encodeUtf8 (Text arr off len) = unsafePerformIO $ do
@@ -102,7 +146,7 @@ encodeUtf8 (Text arr off len) = unsafePerformIO $ do
102146 poke8 (m+1) $ (w .&. 0x3f) + 0x80
103147 go (n+1) (m+2)
104148 | 0xD800 <= w && w <= 0xDBFF -> do
105− let c = ord $ chr2 w (A.unsafeIndex arr (n+1))
149+ let c = ord $ U16.chr2 w (A.unsafeIndex arr (n+1))
106150 poke8 m $ (c `shiftR` 18) + 0xF0
107151 poke8 (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80
108152 poke8 (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80