@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, OverloadedStrings #-}
1+{-# LANGUAGE BangPatterns, CPP, OverloadedStrings #-}
22
33-- |
44-- Module: Data.Aeson.Encoding.Builder
@@ -52,9 +52,22 @@ import Data.Time.LocalTime
5252import Data.Word (Word8)
5353import qualified Data.HashMap.Strict as HMS
5454import qualified Data.Text as T
55−import qualified Data.Text.Encoding as TE
5655import qualified Data.Vector as V
5756
57+#if MIN_VERSION_bytestring(0,10,4)
58+import Data.Text.Encoding (encodeUtf8BuilderEscaped)
59+#else
60+import Data.Bits ((.&.))
61+import Data.Text.Internal (Text(..))
62+import Data.Text.Internal.Unsafe.Shift (shiftR)
63+import Foreign.Ptr (minusPtr, plusPtr)
64+import Foreign.Storable (poke)
65+import qualified Data.ByteString.Builder.Internal as B
66+import qualified Data.ByteString.Builder.Prim.Internal as BP
67+import qualified Data.Text.Array as A
68+import qualified Data.Text.Internal.Encoding.Utf16 as U16
69+#endif
70+
5871-- | Encode a JSON value to a "Data.ByteString" 'B.Builder'.
5972--
6073-- Use this function if you are encoding over the wire, or need to
@@ -101,7 +114,7 @@ text t = B.char8 '"' <> unquoted t <> B.char8 '"'
101114
102115-- | Encode a JSON string, without enclosing quotes.
103116unquoted :: T.Text -> Builder
104−unquoted = TE.encodeUtf8BuilderEscaped escapeAscii
117+unquoted = encodeUtf8BuilderEscaped escapeAscii
105118
106119-- | Add quotes surrounding a builder
107120quote :: Builder -> Builder
@@ -254,3 +267,62 @@ twoDigits a = T (digit hi) (digit lo)
254267
255268digit :: Int -> Char
256269digit x = chr (x + 48)
270+
271+#if !(MIN_VERSION_bytestring(0,10,4))
272+-- | Encode text using UTF-8 encoding and escape the ASCII characters using
273+-- a 'BP.BoundedPrim'.
274+--
275+-- Use this function is to implement efficient encoders for text-based formats
276+-- like JSON or HTML.
277+{-# INLINE encodeUtf8BuilderEscaped #-}
278+-- TODO: Extend documentation with references to source code in @blaze-html@
279+-- or @aeson@ that uses this function.
280+encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
281+encodeUtf8BuilderEscaped be =
282+ -- manual eta-expansion to ensure inlining works as expected
283+ \txt -> B.builder (mkBuildstep txt)
284+ where
285+ bound = max 4 $ BP.sizeBound be
286+
287+ mkBuildstep (Text arr off len) !k =
288+ outerLoop off
289+ where
290+ iend = off + len
291+
292+ outerLoop !i0 !br@(B.BufferRange op0 ope)
293+ | i0 >= iend = k br
294+ | outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining)
295+ -- TODO: Use a loop with an integrated bound's check if outRemaining
296+ -- is smaller than 8, as this will save on divisions.
297+ | otherwise = return $ B.bufferFull bound op0 (outerLoop i0)
298+ where
299+ outRemaining = (ope `minusPtr` op0) `div` bound
300+ inpRemaining = iend - i0
301+
302+ goPartial !iendTmp = go i0 op0
303+ where
304+ go !i !op
305+ | i < iendTmp = case A.unsafeIndex arr i of
306+ w | w <= 0x7F -> do
307+ BP.runB be (fromIntegral w) op >>= go (i + 1)
308+ | w <= 0x7FF -> do
309+ poke8 0 $ (w `shiftR` 6) + 0xC0
310+ poke8 1 $ (w .&. 0x3f) + 0x80
311+ go (i + 1) (op `plusPtr` 2)
312+ | 0xD800 <= w && w <= 0xDBFF -> do
313+ let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))
314+ poke8 0 $ (c `shiftR` 18) + 0xF0
315+ poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80
316+ poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80
317+ poke8 3 $ (c .&. 0x3F) + 0x80
318+ go (i + 2) (op `plusPtr` 4)
319+ | otherwise -> do
320+ poke8 0 $ (w `shiftR` 12) + 0xE0
321+ poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80
322+ poke8 2 $ (w .&. 0x3F) + 0x80
323+ go (i + 1) (op `plusPtr` 3)
324+ | otherwise =
325+ outerLoop i (B.BufferRange op ope)
326+ where
327+ poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)
328+#endif