@@ -2,12 +2,9 @@
2{-# LANGUAGE CPP #-}
2{-# LANGUAGE CPP #-}
3{-# LANGUAGE NoImplicitPrelude #-}
3{-# LANGUAGE NoImplicitPrelude #-}
4{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE OverloadedStrings #-}
5−#if MIN_VERSION_ghc_prim(0,3,1)
6−{-# LANGUAGE MagicHash #-}
8#if __GLASGOW_HASKELL__ <= 710 && __GLASGOW_HASKELL__ >= 706
5#if __GLASGOW_HASKELL__ <= 710 && __GLASGOW_HASKELL__ >= 706
9-- Work around a compiler bug
6-- Work around a compiler bug
10−{-# OPTIONS_GHC -fsimpl-tick-factor=200 #-}
7+{-# OPTIONS_GHC -fsimpl-tick-factor=300 #-}
13-- Module: Data.Aeson.Parser.Internal
10-- Module: Data.Aeson.Parser.Internal
@@ -58,8 +55,10 @@ import Data.Aeson.Types.Internal (IResult(..), JSONPath, Object, Result(..), Val
58import Data.Attoparsec.ByteString.Char8 (Parser, char, decimal, endOfInput, isDigit_w8, signed, string)
55import Data.Attoparsec.ByteString.Char8 (Parser, char, decimal, endOfInput, isDigit_w8, signed, string)
59import Data.Function (fix)
56import Data.Function (fix)
60import Data.Functor.Compat (($>))
57import Data.Functor.Compat (($>))
58+import Data.Bits (testBit)
61import Data.Scientific (Scientific)
59import Data.Scientific (Scientific)
62import Data.Text (Text)
60import Data.Text (Text)
61+import qualified Data.Text.Encoding as TE
63import Data.Vector (Vector)
62import Data.Vector (Vector)
64import qualified Data.Vector as Vector (empty, fromList, fromListN, reverse)
63import qualified Data.Vector as Vector (empty, fromList, fromListN, reverse)
65import qualified Data.Attoparsec.ByteString as A
64import qualified Data.Attoparsec.ByteString as A
@@ -67,16 +66,13 @@ import qualified Data.Attoparsec.Lazy as L
67import qualified Data.ByteString as B
66import qualified Data.ByteString as B
68import qualified Data.ByteString.Unsafe as B
67import qualified Data.ByteString.Unsafe as B
69import qualified Data.ByteString.Lazy as L
68import 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
70import qualified Data.HashMap.Strict as H
72import qualified Data.HashMap.Strict as H
71import qualified Data.Scientific as Sci
73import qualified Data.Scientific as Sci
72import Data.Aeson.Parser.Unescape (unescapeText)
74import Data.Aeson.Parser.Unescape (unescapeText)
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
80#define BACKSLASH 92
76#define BACKSLASH 92
81#define CLOSE_CURLY 125
77#define CLOSE_CURLY 125
82#define CLOSE_SQUARE 93
78#define CLOSE_SQUARE 93
@@ -323,37 +319,20 @@ jstring = A.word8 DOUBLE_QUOTE *> jstring_
323-- | Parse a string without a leading quote.
319-- | Parse a string without a leading quote.
324jstring_ :: Parser Text
320jstring_ :: Parser Text
325{-# INLINE jstring_ #-}
321{-# INLINE jstring_ #-}
326−jstring_ = {-# SCC "jstring_" #-} do
322+jstring_ = do
327−#if MIN_VERSION_ghc_prim(0,3,1)
323+ s <- A.takeWhile (\w -> w /= DOUBLE_QUOTE && w /= BACKSLASH && not (testBit w 7))
328− (s, S _ escaped) <- A.runScanner startState go <* A.anyWord8
324+ let txt = TE.decodeUtf8 s
329− -- We escape only if there are
325+ w <- A.peekWord8
330− -- non-ascii (over 7bit) characters or backslash present.
332− -- Note: if/when text will have fast ascii -> text conversion
333− -- (e.g. uses utf8 encoding) we can have further speedup.
335− then case unescapeText s of
326+ case w of
336− Right r -> return r
327+ Nothing -> fail "string without end"
337− Left err -> fail $ show err
328+ Just DOUBLE_QUOTE -> A.anyWord8 $> txt
338− else return (TE.decodeUtf8 s)
329+ _ -> jstringSlow s
340− startState = S 0# 0#
331+jstringSlow :: B.ByteString -> Parser Text
341− go (S skip escaped) (W8# c)
332+{-# INLINE jstringSlow #-}
342− | isTrue# skip = Just (S 0# escaped')
333+jstringSlow s' = {-# SCC "jstringSlow" #-} do
343− | isTrue# (w ==# 34#) = Nothing -- double quote
344− | otherwise = Just (S skip' escaped')
347− skip' = w ==# 92# -- backslash
349− `orI#` (w `andI#` 0x80# ==# 0x80#) -- c >= 0x80
351− `orI#` (w `andI#` 0x1f# ==# w) -- c < 0x20
355 s <- A.scan startState go <* A.anyWord8
334 s <- A.scan startState go <* A.anyWord8
356− case unescapeText s of
335+ case unescapeText (B.append s' s) of
357 Right r -> return r
336 Right r -> return r
358 Left err -> fail $ show err
337 Left err -> fail $ show err
@@ -364,7 +343,6 @@ data S = S Int# Int#
364 | otherwise = let a' = c == backslash
343 | otherwise = let a' = c == backslash
365 in Just a'
344 in Just a'
366 where backslash = BACKSLASH
345 where backslash = BACKSLASH
369decodeWith :: Parser Value -> (Value -> Result a) -> L.ByteString -> Maybe a
347decodeWith :: Parser Value -> (Value -> Result a) -> L.ByteString -> Maybe a
370decodeWith p to s =
348decodeWith p to s =
@@ -390,14 +368,35 @@ eitherDecodeWith p to s =
390 L.Done _ v -> case to v of
368 L.Done _ v -> case to v of
391 ISuccess a -> Right a
369 ISuccess a -> Right a
392 IError path msg -> Left (path, msg)
370 IError path msg -> Left (path, msg)
393− L.Fail _ ctx msg -> Left ([], buildMsg ctx msg)
371+ L.Fail notparsed ctx msg -> Left ([], buildMsg notparsed ctx msg)
395− buildMsg :: [String] -> String -> String
373+ buildMsg :: L.ByteString -> [String] -> String -> String
396− buildMsg [] msg = msg
374+ buildMsg notYetParsed [] msg = msg ++ formatErrorLine notYetParsed
397− buildMsg (expectation:_) msg =
375+ buildMsg notYetParsed (expectation:_) msg =
398− msg ++ ". Expecting " ++ expectation
376+ msg ++ ". Expecting " ++ expectation ++ formatErrorLine notYetParsed
399{-# INLINE eitherDecodeWith #-}
377{-# INLINE eitherDecodeWith #-}
379+-- | Grab the first 100 bytes from the non parsed portion and
380+-- format to get nicer error messages
381+formatErrorLine :: L.ByteString -> String
384+ -- if formatting results in empty ByteString just return that
385+ -- otherwise construct the error message with the bytestring builder
390+ B.toLazyByteString $
391+ B.stringUtf8 " at '" <> B.lazyByteString bs' <> B.stringUtf8 "'"
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]) .
401eitherDecodeStrictWith :: Parser Value -> (Value -> IResult a) -> B.ByteString
400eitherDecodeStrictWith :: Parser Value -> (Value -> IResult a) -> B.ByteString
402 -> Either (JSONPath, String) a
401 -> Either (JSONPath, String) a
403eitherDecodeStrictWith p to s =
402eitherDecodeStrictWith p to s =