@@ -2,12 +2,9 @@
22{-# LANGUAGE CPP #-}
33{-# LANGUAGE NoImplicitPrelude #-}
44{-# LANGUAGE OverloadedStrings #-}
5−#if MIN_VERSION_ghc_prim(0,3,1)
6−{-# LANGUAGE MagicHash #-}
7−#endif
85#if __GLASGOW_HASKELL__ <= 710 && __GLASGOW_HASKELL__ >= 706
96-- Work around a compiler bug
10−{-# OPTIONS_GHC -fsimpl-tick-factor=200 #-}
7+{-# OPTIONS_GHC -fsimpl-tick-factor=300 #-}
118#endif
129-- |
1310-- Module: Data.Aeson.Parser.Internal
@@ -58,8 +55,10 @@ import Data.Aeson.Types.Internal (IResult(..), JSONPath, Object, Result(..), Val
5855import Data.Attoparsec.ByteString.Char8 (Parser, char, decimal, endOfInput, isDigit_w8, signed, string)
5956import Data.Function (fix)
6057import Data.Functor.Compat (($>))
58+import Data.Bits (testBit)
6159import Data.Scientific (Scientific)
6260import Data.Text (Text)
61+import qualified Data.Text.Encoding as TE
6362import Data.Vector (Vector)
6463import qualified Data.Vector as Vector (empty, fromList, fromListN, reverse)
6564import qualified Data.Attoparsec.ByteString as A
@@ -67,16 +66,13 @@ import qualified Data.Attoparsec.Lazy as L
6766import qualified Data.ByteString as B
6867import qualified Data.ByteString.Unsafe as B
6968import 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
7072import qualified Data.HashMap.Strict as H
7173import qualified Data.Scientific as Sci
7274import Data.Aeson.Parser.Unescape (unescapeText)
7375
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−
8076#define BACKSLASH 92
8177#define CLOSE_CURLY 125
8278#define CLOSE_SQUARE 93
@@ -323,37 +319,20 @@ jstring = A.word8 DOUBLE_QUOTE *> jstring_
323319-- | Parse a string without a leading quote.
324320jstring_ :: Parser Text
325321{-# INLINE jstring_ #-}
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
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
355334 s <- A.scan startState go <* A.anyWord8
356− case unescapeText s of
335+ case unescapeText (B.append s' s) of
357336 Right r -> return r
358337 Left err -> fail $ show err
359338 where
@@ -364,7 +343,6 @@ data S = S Int# Int#
364343 | otherwise = let a' = c == backslash
365344 in Just a'
366345 where backslash = BACKSLASH
367−#endif
368346
369347decodeWith :: Parser Value -> (Value -> Result a) -> L.ByteString -> Maybe a
370348decodeWith p to s =
@@ -390,14 +368,35 @@ eitherDecodeWith p to s =
390368 L.Done _ v -> case to v of
391369 ISuccess a -> Right a
392370 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)
394372 where
395− buildMsg :: [String] -> String -> String
396− buildMsg [] msg = msg
397− buildMsg (expectation:_) msg =
398− msg ++ ". Expecting " ++ expectation
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
399377{-# INLINE eitherDecodeWith #-}
400378
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+
401400eitherDecodeStrictWith :: Parser Value -> (Value -> IResult a) -> B.ByteString
402401 -> Either (JSONPath, String) a
403402eitherDecodeStrictWith p to s =