@@ -2,9 +2,12 @@
22{-# LANGUAGE CPP #-}
33{-# LANGUAGE NoImplicitPrelude #-}
44{-# LANGUAGE OverloadedStrings #-}
5+#if MIN_VERSION_ghc_prim(0,3,1)
6+{-# LANGUAGE MagicHash #-}
7+#endif
58#if __GLASGOW_HASKELL__ <= 710 && __GLASGOW_HASKELL__ >= 706
69-- Work around a compiler bug
7−{-# OPTIONS_GHC -fsimpl-tick-factor=300 #-}
10+{-# OPTIONS_GHC -fsimpl-tick-factor=200 #-}
811#endif
912-- |
1013-- Module: Data.Aeson.Parser.Internal
@@ -55,10 +58,8 @@ import Data.Aeson.Types.Internal (IResult(..), JSONPath, Object, Result(..), Val
5558import Data.Attoparsec.ByteString.Char8 (Parser, char, decimal, endOfInput, isDigit_w8, signed, string)
5659import Data.Function (fix)
5760import Data.Functor.Compat (($>))
58−import Data.Bits (testBit)
5961import Data.Scientific (Scientific)
6062import Data.Text (Text)
61−import qualified Data.Text.Encoding as TE
6263import Data.Vector (Vector)
6364import qualified Data.Vector as Vector (empty, fromList, fromListN, reverse)
6465import qualified Data.Attoparsec.ByteString as A
@@ -66,13 +67,16 @@ import qualified Data.Attoparsec.Lazy as L
6667import qualified Data.ByteString as B
6768import qualified Data.ByteString.Unsafe as B
6869import qualified Data.ByteString.Lazy as L
69−import qualified Data.ByteString.Lazy as BSL
70−import qualified Data.ByteString.Lazy.Char8 as C
71−import qualified Data.ByteString.Builder as B
7270import qualified Data.HashMap.Strict as H
7371import qualified Data.Scientific as Sci
7472import Data.Aeson.Parser.Unescape (unescapeText)
7573
74+#if MIN_VERSION_ghc_prim(0,3,1)
75+import GHC.Base (Int#, (==#), isTrue#, word2Int#, orI#, andI#)
76+import GHC.Word (Word8(W8#))
77+import qualified Data.Text.Encoding as TE
78+#endif
79+
7680#define BACKSLASH 92
7781#define CLOSE_CURLY 125
7882#define CLOSE_SQUARE 93
@@ -319,20 +323,37 @@ jstring = A.word8 DOUBLE_QUOTE *> jstring_
319323-- | Parse a string without a leading quote.
320324jstring_ :: Parser Text
321325{-# INLINE jstring_ #-}
322−jstring_ = do
323− s <- A.takeWhile (\w -> w /= DOUBLE_QUOTE && w /= BACKSLASH && not (testBit w 7))
324− let txt = TE.decodeUtf8 s
325− w <- A.peekWord8
326− case w of
327− Nothing -> fail "string without end"
328− Just DOUBLE_QUOTE -> A.anyWord8 $> txt
329− _ -> jstringSlow s
330−
331−jstringSlow :: B.ByteString -> Parser Text
332−{-# INLINE jstringSlow #-}
333−jstringSlow s' = {-# SCC "jstringSlow" #-} do
326+jstring_ = {-# SCC "jstring_" #-} do
327+#if MIN_VERSION_ghc_prim(0,3,1)
328+ (s, S _ escaped) <- A.runScanner startState go <* A.anyWord8
329+ -- We escape only if there are
330+ -- non-ascii (over 7bit) characters or backslash present.
331+ --
332+ -- Note: if/when text will have fast ascii -> text conversion
333+ -- (e.g. uses utf8 encoding) we can have further speedup.
334+ if isTrue# escaped
335+ then case unescapeText s of
336+ Right r -> return r
337+ Left err -> fail $ show err
338+ else return (TE.decodeUtf8 s)
339+ where
340+ startState = S 0# 0#
341+ go (S skip escaped) (W8# c)
342+ | isTrue# skip = Just (S 0# escaped')
343+ | isTrue# (w ==# 34#) = Nothing -- double quote
344+ | otherwise = Just (S skip' escaped')
345+ where
346+ w = word2Int# c
347+ skip' = w ==# 92# -- backslash
348+ escaped' = escaped
349+ `orI#` (w `andI#` 0x80# ==# 0x80#) -- c >= 0x80
350+ `orI#` skip'
351+ `orI#` (w `andI#` 0x1f# ==# w) -- c < 0x20
352+
353+data S = S Int# Int#
354+#else
334355 s <- A.scan startState go <* A.anyWord8
335− case unescapeText (B.append s' s) of
356+ case unescapeText s of
336357 Right r -> return r
337358 Left err -> fail $ show err
338359 where
@@ -343,6 +364,7 @@ jstringSlow s' = {-# SCC "jstringSlow" #-} do
343364 | otherwise = let a' = c == backslash
344365 in Just a'
345366 where backslash = BACKSLASH
367+#endif
346368
347369decodeWith :: Parser Value -> (Value -> Result a) -> L.ByteString -> Maybe a
348370decodeWith p to s =
@@ -368,35 +390,14 @@ eitherDecodeWith p to s =
368390 L.Done _ v -> case to v of
369391 ISuccess a -> Right a
370392 IError path msg -> Left (path, msg)
371− L.Fail notparsed ctx msg -> Left ([], buildMsg notparsed ctx msg)
393+ L.Fail _ ctx msg -> Left ([], buildMsg ctx msg)
372394 where
373− buildMsg :: L.ByteString -> [String] -> String -> String
374− buildMsg notYetParsed [] msg = msg ++ formatErrorLine notYetParsed
375− buildMsg notYetParsed (expectation:_) msg =
376− msg ++ ". Expecting " ++ expectation ++ formatErrorLine notYetParsed
395+ buildMsg :: [String] -> String -> String
396+ buildMsg [] msg = msg
397+ buildMsg (expectation:_) msg =
398+ msg ++ ". Expecting " ++ expectation
377399{-# INLINE eitherDecodeWith #-}
378400
379−-- | Grab the first 100 bytes from the non parsed portion and
380−-- format to get nicer error messages
381−formatErrorLine :: L.ByteString -> String
382−formatErrorLine bs =
383− C.unpack .
384− -- if formatting results in empty ByteString just return that
385− -- otherwise construct the error message with the bytestring builder
386− (\bs' ->
387− if BSL.null bs'
388− then BSL.empty
389− else
390− B.toLazyByteString $
391− B.stringUtf8 " at '" <> B.lazyByteString bs' <> B.stringUtf8 "'"
392− ) .
393− -- if newline is present cut at that position
394− BSL.takeWhile (10 /=) .
395− -- remove spaces, CR's, tabs, backslashes and quotes characters
396− BSL.filter (`notElem` [9, 13, 32, 34, 47, 92]) .
397− -- take 100 bytes
398− BSL.take 100 $ bs
399−
400401eitherDecodeStrictWith :: Parser Value -> (Value -> IResult a) -> B.ByteString
401402 -> Either (JSONPath, String) a
402403eitherDecodeStrictWith p to s =