@@ -6,15 +6,19 @@ module Data.Aeson.Parser
9+import Blaze.ByteString.Builder
10+import Blaze.ByteString.Builder.Char.Utf8
11+import Data.Monoid (Monoid(..))
9import Control.Applicative as A
12import Control.Applicative as A
10import Data.Aeson.Types (Value(..))
13import Data.Aeson.Types (Value(..))
11import Data.Attoparsec.Char8
14import Data.Attoparsec.Char8
12import Data.Bits (shiftL)
15import Data.Bits (shiftL)
13import Data.ByteString as B
16import Data.ByteString as B
17+import Data.ByteString.Unsafe as B
14import Data.Char (chr)
18import Data.Char (chr)
15import Data.Map as Map
19import Data.Map as Map
16import Data.Text as T
20import Data.Text as T
17−import Data.Text.Encoding (decodeUtf8, encodeUtf8)
21+import Data.Text.Encoding (decodeUtf8)
18import Data.Vector as Vector hiding ((++))
22import Data.Vector as Vector hiding ((++))
19import Data.Word (Word8)
23import Data.Word (Word8)
20import qualified Data.Attoparsec as A
24import qualified Data.Attoparsec as A
@@ -67,7 +71,7 @@ jstring_ = do
67 then Nothing
71 then Nothing
68 else Just (c == backslash)
72 else Just (c == backslash)
69 _ <- A.word8 doubleQuote
73 _ <- A.word8 doubleQuote
70− (decodeUtf8 . B.concat) <$> reparse unescape s
74+ decodeUtf8 <$> reparse unescape s
72reparse :: Parser a -> ByteString -> Parser a
76reparse :: Parser a -> ByteString -> Parser a
73reparse p s = case (case parse p s of {Partial k -> k ""; r -> r}) of
77reparse 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
75 Fail _ _ msg -> fail msg
79 Fail _ _ msg -> fail msg
76 _ -> fail "unexpected failure"
80 _ -> fail "unexpected failure"
78−unescape :: Parser [ByteString]
82+unescape :: Parser ByteString
79−unescape = Prelude.reverse <$> go [] where
83+unescape = toByteString <$> go mempty where
80− go acc = do
84+ go bld = do
81 let backslash = 92
85 let backslash = 92
82 h <- A.takeWhile (/=backslash)
86 h <- A.takeWhile (/=backslash)
83 let rest = do
87 let rest = do
84 w <- A.word8 backslash *> A.satisfy (`B.elem` "\"\\/ntbrfu")
88 w <- A.word8 backslash *> A.satisfy (`B.elem` "\"\\/ntbrfu")
85 case B.findIndex (==w) "\"\\/ntbrf" of
89 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))
87 Nothing -> do
91 Nothing -> do
88 a <- reparse hexadecimal =<< A.take 4
92 a <- reparse hexadecimal =<< A.take 4
89 if a < 0xd800 || a > 0xdfff
93 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))
92 b <- string "\\u" *> (reparse hexadecimal =<< A.take 4)
96 b <- string "\\u" *> (reparse hexadecimal =<< A.take 4)
93 if a <= 0xdbff && b >= 0xdc00 && b <= 0xdfff
97 if a <= 0xdbff && b >= 0xdc00 && b <= 0xdfff
94 then let c = ((a - 0xd800) `shiftL` 10) + (b - 0xdc00) +
98 then let c = ((a - 0xd800) `shiftL` 10) + (b - 0xdc00) +
96− in go (encodeUtf8 (T.singleton . chr $ c):h:acc)
100+ in go (bld `mappend` fromByteString h `mappend` fromChar (chr c))
97 else fail "invalid UTF-16 surrogates"
101 else fail "invalid UTF-16 surrogates"
98− rest <|> return (h:acc)
102+ rest <|> return (bld `mappend` fromByteString h)