@@ -59,6 +59,7 @@ import Data.Attoparsec.ByteString.Char8 (Parser, char, decimal, endOfInput, isDi
5959import Data.Function (fix)
6060import Data.Functor.Compat (($>))
6161import Data.Scientific (Scientific)
62+import Data.Semigroup ((<>))
6263import Data.Text (Text)
6364import Data.Vector (Vector)
6465import qualified Data.Vector as Vector (empty, fromList, fromListN, reverse)
@@ -67,6 +68,9 @@ import qualified Data.Attoparsec.Lazy as L
6768import qualified Data.ByteString as B
6869import qualified Data.ByteString.Unsafe as B
6970import qualified Data.ByteString.Lazy as L
71+import qualified Data.ByteString.Lazy as BSL
72+import qualified Data.ByteString.Lazy.Char8 as C
73+import qualified Data.ByteString.Builder as B
7074import qualified Data.HashMap.Strict as H
7175import qualified Data.Scientific as Sci
7276import Data.Aeson.Parser.Unescape (unescapeText)
@@ -390,14 +394,35 @@ eitherDecodeWith p to s =
390394 L.Done _ v -> case to v of
391395 ISuccess a -> Right a
392396 IError path msg -> Left (path, msg)
393− L.Fail _ ctx msg -> Left ([], buildMsg ctx msg)
397+ L.Fail notparsed ctx msg -> Left ([], buildMsg notparsed ctx msg)
394398 where
395− buildMsg :: [String] -> String -> String
396− buildMsg [] msg = msg
397− buildMsg (expectation:_) msg =
398− msg ++ ". Expecting " ++ expectation
399+ buildMsg :: L.ByteString -> [String] -> String -> String
400+ buildMsg notYetParsed [] msg = msg ++ formatErrorLine notYetParsed
401+ buildMsg notYetParsed (expectation:_) msg =
402+ msg ++ ". Expecting " ++ expectation ++ formatErrorLine notYetParsed
399403{-# INLINE eitherDecodeWith #-}
400404
405+-- | Grab the first 100 bytes from the non parsed portion and
406+-- format to get nicer error messages
407+formatErrorLine :: L.ByteString -> String
408+formatErrorLine bs =
409+ C.unpack .
410+ -- if formatting results in empty ByteString just return that
411+ -- otherwise construct the error message with the bytestring builder
412+ (\bs' ->
413+ if BSL.null bs'
414+ then BSL.empty
415+ else
416+ B.toLazyByteString $
417+ B.stringUtf8 " at '" <> B.lazyByteString bs' <> B.stringUtf8 "'"
418+ ) .
419+ -- if newline is present cut at that position
420+ BSL.takeWhile (10 /=) .
421+ -- remove spaces, CR's, tabs, backslashes and quotes characters
422+ BSL.filter (`notElem` [9, 13, 32, 34, 47, 92]) .
423+ -- take 100 bytes
424+ BSL.take 100 $ bs
425+
401426eitherDecodeStrictWith :: Parser Value -> (Value -> IResult a) -> B.ByteString
402427 -> Either (JSONPath, String) a
403428eitherDecodeStrictWith p to s =