git.iko.soy/text
on master help sign in
implemented 'Text -> Builder' UTF-8 encoders
b8c8f11Simon Meier
Data/Text/Encoding.hs+98−1
compare with master
unifiedsplit
@@ -49,6 +49,8 @@ module Data.Text.Encoding
49 -- * Generic encoding of Text
49 -- * Generic encoding of Text
50 , encodeStreamWithB
50 , encodeStreamWithB
51 , encodeTextWithB
51 , encodeTextWithB
52+ , encodeUtf8Builder
53+ , encodeUtf8Escaped
52 ) where
54 ) where
53
55
54import Control.Exception (evaluate, try)
56import Control.Exception (evaluate, try)
@@ -61,7 +63,7 @@ import Data.Bits ((.&.))
61import Data.ByteString as B
63import Data.ByteString as B
62import Data.ByteString.Internal as B
64import Data.ByteString.Internal as B
63import Data.ByteString.Lazy.Builder.Internal as B
65import Data.ByteString.Lazy.Builder.Internal as B
64−import Data.ByteString.Lazy.Builder.BasicEncoding.Internal as B
66+import qualified Data.ByteString.Lazy.Builder.BasicEncoding.Internal as B
65import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
67import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
66import Data.Text.Internal (Text(..), textP)
68import Data.Text.Internal (Text(..), textP)
67import Data.Text.UnsafeChar (ord, unsafeWrite)
69import Data.Text.UnsafeChar (ord, unsafeWrite)
@@ -310,3 +312,98 @@ encodeStreamWithB be =
310{-# INLINE encodeTextWithB #-}
312{-# INLINE encodeTextWithB #-}
311encodeTextWithB :: B.BoundedEncoding Char -> Text -> B.Builder
313encodeTextWithB :: B.BoundedEncoding Char -> Text -> B.Builder
312encodeTextWithB be = encodeStreamWithB be . F.stream
314encodeTextWithB be = encodeStreamWithB be . F.stream
315+
316+-- | Encode text using UTF-8 encoding.
317+encodeUtf8Builder :: Text -> B.Builder
318+encodeUtf8Builder (Text arr off len) =
319+ B.builder step
320+ where
321+ bound = 4
322+ iend = off + len
323+ step !k =
324+ outerLoop off
325+ where
326+ outerLoop !i0 !br@(BufferRange op0 ope)
327+ | i0 >= iend = k br
328+ | op0 `plusPtr` bound < ope =
329+ goPartial (i0 + min outRemaining inpRemaining)
330+ | otherwise = return $ bufferFull bound op0 (outerLoop i0)
331+ where
332+ outRemaining = (ope `minusPtr` op0) `div` bound
333+ inpRemaining = iend - i0
334+
335+ goPartial !iendTmp = go i0 op0
336+ where
337+ go !i !op
338+ | i < iendTmp = case A.unsafeIndex arr i of
339+ w | w <= 0x7F -> do
340+ poke8 0 w
341+ go (i + 1) (op `plusPtr` 1)
342+ | w <= 0x7FF -> do
343+ poke8 0 $ (w `shiftR` 6) + 0xC0
344+ poke8 1 $ (w .&. 0x3f) + 0x80
345+ go (i + 1) (op `plusPtr` 2)
346+ | 0xD800 <= w && w <= 0xDBFF -> do
347+ let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))
348+ poke8 0 $ (c `shiftR` 18) + 0xF0
349+ poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80
350+ poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80
351+ poke8 3 $ (c .&. 0x3F) + 0x80
352+ go (i + 2) (op `plusPtr` 4)
353+ | otherwise -> do
354+ poke8 0 $ (w `shiftR` 12) + 0xE0
355+ poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80
356+ poke8 2 $ (w .&. 0x3F) + 0x80
357+ go (i + 1) (op `plusPtr` 3)
358+ | otherwise =
359+ outerLoop i (BufferRange op ope)
360+ where
361+ poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)
362+
363+-- | Encode text using UTF-8 encoding and escape the ASCII characters using
364+-- a 'BoundedEncoding'.
365+encodeUtf8Escaped :: B.BoundedEncoding Word8 -> Text -> B.Builder
366+encodeUtf8Escaped be (Text arr off len) =
367+ B.builder step
368+ where
369+ bound = max 4 $ B.sizeBound be
370+ iend = off + len
371+ step !k =
372+ outerLoop off
373+ where
374+ outerLoop !i0 !br@(BufferRange op0 ope)
375+ | i0 >= iend = k br
376+ | op0 `plusPtr` bound < ope =
377+ goPartial (i0 + min outRemaining inpRemaining)
378+ | otherwise = return $ bufferFull bound op0 (outerLoop i0)
379+ where
380+ outRemaining = (ope `minusPtr` op0) `div` bound
381+ inpRemaining = iend - i0
382+
383+ goPartial !iendTmp = go i0 op0
384+ where
385+ go !i !op
386+ | i < iendTmp = case A.unsafeIndex arr i of
387+ w | w <= 0x7F -> do
388+ B.runB be (fromIntegral w) op >>= go (i + 1)
389+ | w <= 0x7FF -> do
390+ poke8 0 $ (w `shiftR` 6) + 0xC0
391+ poke8 1 $ (w .&. 0x3f) + 0x80
392+ go (i + 1) (op `plusPtr` 2)
393+ | 0xD800 <= w && w <= 0xDBFF -> do
394+ let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))
395+ poke8 0 $ (c `shiftR` 18) + 0xF0
396+ poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80
397+ poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80
398+ poke8 3 $ (c .&. 0x3F) + 0x80
399+ go (i + 2) (op `plusPtr` 4)
400+ | otherwise -> do
401+ poke8 0 $ (w `shiftR` 12) + 0xE0
402+ poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80
403+ poke8 2 $ (w .&. 0x3F) + 0x80
404+ go (i + 1) (op `plusPtr` 3)
405+ | otherwise =
406+ outerLoop i (BufferRange op ope)
407+ where
408+ poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)
409+