@@ -31,6 +31,7 @@ import Data.Text.Encoding (decodeUtf8)
3131import Data.Vector as Vector hiding ((++))
3232import Data.Word (Word8)
3333import qualified Data.Attoparsec as A
34+import qualified Data.Attoparsec.Zepto as Z
3435import qualified Data.ByteString.Unsafe as B
3536
3637-- | Parse a top-level JSON value. This must be either an object or
@@ -44,7 +45,7 @@ json = do
4445 _ -> fail "root value is not an object or array"
4546
4647object_ :: Parser Value
47−object_ = do
48+object_ = {-# SCC "object_" #-} do
4849 skipSpace
4950 let pair = do
5051 a <- jstring <* skipSpace
@@ -54,7 +55,7 @@ object_ = do
5455 return . Object $ Map.fromList vals
5556
5657array_ :: Parser Value
57−array_ = do
58+array_ = {-# SCC "array_" #-} do
5859 skipSpace
5960 vals <- ((value <* skipSpace) `sepBy` (char ',' *> skipSpace)) <* char ']'
6061 return . Array $ Vector.fromList vals
@@ -84,7 +85,7 @@ jstring = A.word8 doubleQuote *> jstring_
8485
8586-- | Parse a string without a leading quote.
8687jstring_ :: Parser Text
87−jstring_ = do
88+jstring_ = {-# SCC "jstring_" #-} do
8889 s <- A.scan False $ \s c -> if s then Just False
8990 else if c == doubleQuote
9091 then Nothing
@@ -95,18 +96,17 @@ jstring_ = do
9596 else return (decodeUtf8 s)
9697{-# INLINE jstring_ #-}
9798
98−reparse :: Parser a -> ByteString -> Parser a
99−reparse p s = case parse p s `feed` "" of
100− Done "" r -> return r
101− Fail _ _ msg -> fail msg
102− _ -> fail "unexpected failure"
99+reparse :: Z.Parser a -> ByteString -> Parser a
100+reparse p s = case Z.parse p s of
101+ Right r -> return r
102+ Left err -> fail err
103103
104−unescape :: Parser ByteString
104+unescape :: Z.Parser ByteString
105105unescape = toByteString <$> go mempty where
106106 go acc = do
107− h <- A.takeWhile (/=backslash)
107+ h <- Z.takeWhile (/=backslash)
108108 let rest = do
109− start <- A.take 2
109+ start <- Z.take 2
110110 let !slash = B.unsafeHead start
111111 !t = B.unsafeIndex start 1
112112 escape = case B.findIndex (==t) "\"\\/ntbrfu" of
@@ -124,21 +124,21 @@ unescape = toByteString <$> go mempty where
124124 if a < 0xd800 || a > 0xdfff
125125 then cont (fromChar (chr a))
126126 else do
127− b <- string "\\u" *> hexQuad
127+ b <- Z.string "\\u" *> hexQuad
128128 if a <= 0xdbff && b >= 0xdc00 && b <= 0xdfff
129129 then let !c = ((a - 0xd800) `shiftL` 10) +
130130 (b - 0xdc00) + 0x10000
131131 in cont (fromChar (chr c))
132132 else fail "invalid UTF-16 surrogates"
133− done <- atEnd
133+ done <- Z.atEnd
134134 if done
135135 then return (acc `mappend` fromByteString h)
136136 else rest
137137 mapping = "\"\\/\n\t\b\r\f"
138138
139−hexQuad :: Parser Int
139+hexQuad :: Z.Parser Int
140140hexQuad = do
141− s <- A.take 4
141+ s <- Z.take 4
142142 let hex n | w >= 48 && w <= 57 = w - 48
143143 | w >= 97 && w <= 122 = w - 87
144144 | w >= 65 && w <= 90 = w - 55