@@ -6,15 +6,19 @@ module Data.Aeson.Parser
66 , value
77 ) where
88
9+import Blaze.ByteString.Builder
10+import Blaze.ByteString.Builder.Char.Utf8
11+import Data.Monoid (Monoid(..))
912import Control.Applicative as A
1013import Data.Aeson.Types (Value(..))
1114import Data.Attoparsec.Char8
1215import Data.Bits (shiftL)
1316import Data.ByteString as B
17+import Data.ByteString.Unsafe as B
1418import Data.Char (chr)
1519import Data.Map as Map
1620import Data.Text as T
17−import Data.Text.Encoding (decodeUtf8, encodeUtf8)
21+import Data.Text.Encoding (decodeUtf8)
1822import Data.Vector as Vector hiding ((++))
1923import Data.Word (Word8)
2024import qualified Data.Attoparsec as A
@@ -67,7 +71,7 @@ jstring_ = do
6771 then Nothing
6872 else Just (c == backslash)
6973 _ <- A.word8 doubleQuote
70− (decodeUtf8 . B.concat) <$> reparse unescape s
74+ decodeUtf8 <$> reparse unescape s
7175
7276reparse :: Parser a -> ByteString -> Parser a
7377reparse p s = case (case parse p s of {Partial k -> k ""; r -> r}) of
@@ -75,24 +79,24 @@ reparse p s = case (case parse p s of {Partial k -> k ""; r -> r}) of
7579 Fail _ _ msg -> fail msg
7680 _ -> fail "unexpected failure"
7781
78−unescape :: Parser [ByteString]
79−unescape = Prelude.reverse <$> go [] where
80− go acc = do
82+unescape :: Parser ByteString
83+unescape = toByteString <$> go mempty where
84+ go bld = do
8185 let backslash = 92
8286 h <- A.takeWhile (/=backslash)
8387 let rest = do
8488 w <- A.word8 backslash *> A.satisfy (`B.elem` "\"\\/ntbrfu")
8589 case B.findIndex (==w) "\"\\/ntbrf" of
86− Just i -> go (B.singleton (B.index "\"\\/\n\t\b\r\f" i):h:acc)
90+ Just i -> go (bld `mappend` fromByteString h `mappend` fromWord8 (B.unsafeIndex "\"\\/\n\t\b\r\f" i))
8791 Nothing -> do
8892 a <- reparse hexadecimal =<< A.take 4
8993 if a < 0xd800 || a > 0xdfff
90− then go (encodeUtf8 (T.singleton . chr $ a):h:acc)
94+ then go (bld `mappend` fromByteString h `mappend` fromChar (chr a))
9195 else do
9296 b <- string "\\u" *> (reparse hexadecimal =<< A.take 4)
9397 if a <= 0xdbff && b >= 0xdc00 && b <= 0xdfff
9498 then let c = ((a - 0xd800) `shiftL` 10) + (b - 0xdc00) +
9599 0x10000
96− in go (encodeUtf8 (T.singleton . chr $ c):h:acc)
100+ in go (bld `mappend` fromByteString h `mappend` fromChar (chr c))
97101 else fail "invalid UTF-16 surrogates"
98− rest <|> return (h:acc)
102+ rest <|> return (bld `mappend` fromByteString h)