@@ -31,6 +31,7 @@ import Data.Text.Encoding (decodeUtf8)
31import Data.Vector as Vector hiding ((++))
31import Data.Vector as Vector hiding ((++))
32import Data.Word (Word8)
32import Data.Word (Word8)
33import qualified Data.Attoparsec as A
33import qualified Data.Attoparsec as A
34+import qualified Data.Attoparsec.Zepto as Z
34import qualified Data.ByteString.Unsafe as B
35import qualified Data.ByteString.Unsafe as B
36-- | Parse a top-level JSON value. This must be either an object or
37-- | Parse a top-level JSON value. This must be either an object or
@@ -44,7 +45,7 @@ json = do
44 _ -> fail "root value is not an object or array"
45 _ -> fail "root value is not an object or array"
46object_ :: Parser Value
47object_ :: Parser Value
47−object_ = do
48+object_ = {-# SCC "object_" #-} do
49 let pair = do
50 let pair = do
50 a <- jstring <* skipSpace
51 a <- jstring <* skipSpace
@@ -54,7 +55,7 @@ object_ = do
54 return . Object $ Map.fromList vals
55 return . Object $ Map.fromList vals
56array_ :: Parser Value
57array_ :: Parser Value
57−array_ = do
58+array_ = {-# SCC "array_" #-} do
59 vals <- ((value <* skipSpace) `sepBy` (char ',' *> skipSpace)) <* char ']'
60 vals <- ((value <* skipSpace) `sepBy` (char ',' *> skipSpace)) <* char ']'
60 return . Array $ Vector.fromList vals
61 return . Array $ Vector.fromList vals
@@ -84,7 +85,7 @@ jstring = A.word8 doubleQuote *> jstring_
85-- | Parse a string without a leading quote.
86-- | Parse a string without a leading quote.
86jstring_ :: Parser Text
87jstring_ :: Parser Text
87−jstring_ = do
88+jstring_ = {-# SCC "jstring_" #-} do
88 s <- A.scan False $ \s c -> if s then Just False
89 s <- A.scan False $ \s c -> if s then Just False
89 else if c == doubleQuote
90 else if c == doubleQuote
90 then Nothing
91 then Nothing
@@ -95,18 +96,17 @@ jstring_ = do
95 else return (decodeUtf8 s)
96 else return (decodeUtf8 s)
96{-# INLINE jstring_ #-}
97{-# INLINE jstring_ #-}
98−reparse :: Parser a -> ByteString -> Parser a
99+reparse :: Z.Parser a -> ByteString -> Parser a
99−reparse p s = case parse p s `feed` "" of
100+reparse p s = case Z.parse p s of
100− Done "" r -> return r
101+ Right r -> return r
101− Fail _ _ msg -> fail msg
102+ Left err -> fail err
102− _ -> fail "unexpected failure"
104−unescape :: Parser ByteString
104+unescape :: Z.Parser ByteString
105unescape = toByteString <$> go mempty where
105unescape = toByteString <$> go mempty where
106 go acc = do
106 go acc = do
107− h <- A.takeWhile (/=backslash)
107+ h <- Z.takeWhile (/=backslash)
108 let rest = do
108 let rest = do
109− start <- A.take 2
109+ start <- Z.take 2
110 let !slash = B.unsafeHead start
110 let !slash = B.unsafeHead start
111 !t = B.unsafeIndex start 1
111 !t = B.unsafeIndex start 1
112 escape = case B.findIndex (==t) "\"\\/ntbrfu" of
112 escape = case B.findIndex (==t) "\"\\/ntbrfu" of
@@ -124,21 +124,21 @@ unescape = toByteString <$> go mempty where
124 if a < 0xd800 || a > 0xdfff
124 if a < 0xd800 || a > 0xdfff
125 then cont (fromChar (chr a))
125 then cont (fromChar (chr a))
127− b <- string "\\u" *> hexQuad
127+ b <- Z.string "\\u" *> hexQuad
128 if a <= 0xdbff && b >= 0xdc00 && b <= 0xdfff
128 if a <= 0xdbff && b >= 0xdc00 && b <= 0xdfff
129 then let !c = ((a - 0xd800) `shiftL` 10) +
129 then let !c = ((a - 0xd800) `shiftL` 10) +
130 (b - 0xdc00) + 0x10000
130 (b - 0xdc00) + 0x10000
131 in cont (fromChar (chr c))
131 in cont (fromChar (chr c))
132 else fail "invalid UTF-16 surrogates"
132 else fail "invalid UTF-16 surrogates"
133− done <- atEnd
133+ done <- Z.atEnd
135 then return (acc `mappend` fromByteString h)
135 then return (acc `mappend` fromByteString h)
136 else rest
136 else rest
137 mapping = "\"\\/\n\t\b\r\f"
137 mapping = "\"\\/\n\t\b\r\f"
139−hexQuad :: Parser Int
139+hexQuad :: Z.Parser Int
140hexQuad = do
140hexQuad = do
141− s <- A.take 4
141+ s <- Z.take 4
142 let hex n | w >= 48 && w <= 57 = w - 48
142 let hex n | w >= 48 && w <= 57 = w - 48
143 | w >= 97 && w <= 122 = w - 87
143 | w >= 97 && w <= 122 = w - 87
144 | w >= 65 && w <= 90 = w - 55
144 | w >= 65 && w <= 90 = w - 55