git.iko.soy/typeable/aeson
on master help sign in
Numerous improvements to string parsing performance.
a8ea7aeBryan O'Sullivan
Data/Aeson/Parser.hs+36−10
compare with master
unifiedsplit
@@ -16,9 +16,10 @@ module Data.Aeson.Parser
16 ) where
16 ) where
17
17
18import Control.Applicative as A
18import Control.Applicative as A
19+import Control.Monad (when)
19import Data.Aeson.Types (Value(..))
20import Data.Aeson.Types (Value(..))
20import Data.Attoparsec.Char8
21import Data.Attoparsec.Char8
21−import Data.Bits (shiftL)
22+import Data.Bits ((.|.), shiftL)
22import Data.ByteString as B
23import Data.ByteString as B
23import Data.Char (chr)
24import Data.Char (chr)
24import Data.Map as Map
25import Data.Map as Map
@@ -27,6 +28,7 @@ import Data.Text.Encoding (decodeUtf8, encodeUtf8)
27import Data.Vector as Vector hiding ((++))
28import Data.Vector as Vector hiding ((++))
28import Data.Word (Word8)
29import Data.Word (Word8)
29import qualified Data.Attoparsec as A
30import qualified Data.Attoparsec as A
31+import qualified Data.ByteString.Unsafe as B
30
32
31-- | Parse a top-level JSON value. This must be either an object or
33-- | Parse a top-level JSON value. This must be either an object or
32-- an array.
34-- an array.
@@ -96,18 +98,42 @@ unescape = Prelude.reverse <$> go [] where
96 let backslash = 92
98 let backslash = 92
97 h <- A.takeWhile (/=backslash)
99 h <- A.takeWhile (/=backslash)
98 let rest = do
100 let rest = do
99− w <- A.word8 backslash *> A.satisfy (`B.elem` "\"\\/ntbrfu")
101+ start <- A.take 2
102+ let !slash = B.unsafeHead start
103+ !t = B.unsafeIndex start 1
100− case B.findIndex (==w) "\"\\/ntbrf" of
104+ escape = case B.findIndex (==t) "\"\\/ntbrfu" of
105+ Just i -> i
106+ _ -> 255
107+ when (slash /= backslash || escape == 255) $
108+ fail "bad escape sequence"
109+ if t /= 117 -- 'u'
101− Just i -> go (B.singleton (B.index "\"\\/\n\t\b\r\f" i):h:acc)
110+ then go (B.singleton (B.unsafeIndex mapping escape):h:acc)
102− Nothing -> do
111+ else do
103− a <- reparse hexadecimal =<< A.take 4
112+ a <- hexQuad
104 if a < 0xd800 || a > 0xdfff
113 if a < 0xd800 || a > 0xdfff
105 then go (encodeUtf8 (T.singleton . chr $ a):h:acc)
114 then go (encodeUtf8 (T.singleton . chr $ a):h:acc)
106 else do
115 else do
107− b <- string "\\u" *> (reparse hexadecimal =<< A.take 4)
116+ b <- string "\\u" *> hexQuad
108 if a <= 0xdbff && b >= 0xdc00 && b <= 0xdfff
117 if a <= 0xdbff && b >= 0xdc00 && b <= 0xdfff
109− then let c = ((a - 0xd800) `shiftL` 10) + (b - 0xdc00) +
118+ then let !c = ((a - 0xd800) `shiftL` 10) + (b - 0xdc00) +
110− 0x10000
119+ 0x10000
111− in go (encodeUtf8 (T.singleton . chr $ c):h:acc)
120+ in go (encodeUtf8 (T.singleton (chr c)):h:acc)
112 else fail "invalid UTF-16 surrogates"
121 else fail "invalid UTF-16 surrogates"
113 rest <|> return (h:acc)
122 rest <|> return (h:acc)
123+ mapping = "\"\\/\n\t\b\r\f"
124+
125+hexQuad :: Parser Int
126+hexQuad = do
127+ s <- A.take 4
128+ let hex n | w >= 48 && w <= 57 = w - 48
129+ | w >= 97 && w <= 122 = w - 87
130+ | w >= 65 && w <= 90 = w - 55
131+ | otherwise = 255
132+ where w = fromIntegral $ B.unsafeIndex s n
133+ a = hex 0
134+ b = hex 1
135+ c = hex 2
136+ d = hex 3
137+ if (a .|. b .|. c .|. d) /= 255
138+ then return $! d .|. (c `shiftL` 4) .|. (b `shiftL` 8) .|. (a `shiftL` 12)
139+ else fail "invalid hex escape"