From 43f92d00e4a6952a3137a283cb2d92a73d332a49 Mon Sep 17 00:00:00 2001 From: FintanH Date: Wed, 17 Apr 2019 22:19:10 +0100 Subject: [PATCH 1/4] Add labels to json object and list parsing --- Data/Aeson/Parser/Internal.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Data/Aeson/Parser/Internal.hs b/Data/Aeson/Parser/Internal.hs index 31886f934..8a0fc362f 100644 --- a/Data/Aeson/Parser/Internal.hs +++ b/Data/Aeson/Parser/Internal.hs @@ -123,9 +123,9 @@ objectValues str val = do -- Why use acc pattern here, you may ask? because 'H.fromList' use 'unsafeInsert' -- and it's much faster because it's doing in place update to the 'HashMap'! loop acc = do - k <- str <* skipSpace <* char ':' - v <- val <* skipSpace - ch <- A.satisfy $ \w -> w == COMMA || w == CLOSE_CURLY + k <- (str A. "expected object key") <* skipSpace <* (char ':' A. "expecting ':'") + v <- (val A. "expected object value") <* skipSpace + ch <- (A.satisfy $ \w -> w == COMMA || w == CLOSE_CURLY) A. "expecting ',' or '}'" let acc' = (k, v) : acc if ch == COMMA then skipSpace >> loop acc' @@ -149,8 +149,8 @@ arrayValues val = do else loop [] 1 where loop acc !len = do - v <- val <* skipSpace - ch <- A.satisfy $ \w -> w == COMMA || w == CLOSE_SQUARE + v <- (val A. "expected json list value") <* skipSpace + ch <- (A.satisfy $ \w -> w == COMMA || w == CLOSE_SQUARE) A. "expecting ',' or ']'" if ch == COMMA then skipSpace >> loop (v:acc) (len+1) else return (Vector.reverse (Vector.fromListN len (v:acc))) From 8549d9041c5510bf30705f7256dffbb20bd64cde Mon Sep 17 00:00:00 2001 From: FintanH Date: Wed, 24 Apr 2019 11:40:51 +0100 Subject: [PATCH 2/4] Fix error messages in parser. Add tests for error messages. --- Data/Aeson/Parser/Internal.hs | 16 ++++++++++------ tests/ErrorMessages.hs | 5 +++++ tests/golden/generic.expected | 5 +++++ 3 files changed, 20 insertions(+), 6 deletions(-) diff --git a/Data/Aeson/Parser/Internal.hs b/Data/Aeson/Parser/Internal.hs index 8a0fc362f..061eceac4 100644 --- a/Data/Aeson/Parser/Internal.hs +++ b/Data/Aeson/Parser/Internal.hs @@ -123,9 +123,9 @@ objectValues str val = do -- Why use acc pattern here, you may ask? because 'H.fromList' use 'unsafeInsert' -- and it's much faster because it's doing in place update to the 'HashMap'! loop acc = do - k <- (str A. "expected object key") <* skipSpace <* (char ':' A. "expecting ':'") - v <- (val A. "expected object value") <* skipSpace - ch <- (A.satisfy $ \w -> w == COMMA || w == CLOSE_CURLY) A. "expecting ',' or '}'" + k <- (str A. "object key") <* skipSpace <* (char ':' A. "':'") + v <- (val A. "object value") <* skipSpace + ch <- A.satisfy (\w -> w == COMMA || w == CLOSE_CURLY) A. "',' or '}'" let acc' = (k, v) : acc if ch == COMMA then skipSpace >> loop acc' @@ -149,8 +149,8 @@ arrayValues val = do else loop [] 1 where loop acc !len = do - v <- (val A. "expected json list value") <* skipSpace - ch <- (A.satisfy $ \w -> w == COMMA || w == CLOSE_SQUARE) A. "expecting ',' or ']'" + v <- (val A. "json list value") <* skipSpace + ch <- A.satisfy (\w -> w == COMMA || w == CLOSE_SQUARE) A. "',' or ']'" if ch == COMMA then skipSpace >> loop (v:acc) (len+1) else return (Vector.reverse (Vector.fromListN len (v:acc))) @@ -275,7 +275,11 @@ eitherDecodeWith p to s = L.Done _ v -> case to v of ISuccess a -> Right a IError path msg -> Left (path, msg) - L.Fail _ _ msg -> Left ([], msg) + L.Fail _ ctx msg -> Left ([], buildMsg ctx msg) + where + buildMsg [] msg = msg + buildMsg (expectation:_) msg = + msg <> ". Expecting " <> expectation {-# INLINE eitherDecodeWith #-} eitherDecodeStrictWith :: Parser Value -> (Value -> IResult a) -> B.ByteString diff --git a/tests/ErrorMessages.hs b/tests/ErrorMessages.hs index a0c273143..faf5291ec 100644 --- a/tests/ErrorMessages.hs +++ b/tests/ErrorMessages.hs @@ -117,6 +117,9 @@ outputGeneric choice = concat , "{\"record\": {}, \"W\":{}}" , "{}" , "[]" + , "{\"unary\"" + , "{\"unary\":" + , "{\"unary\":1" ] , testWithSomeType "SomeType (two-element array)" @@ -129,6 +132,8 @@ outputGeneric choice = concat , "[null, 0]" , "[]" , "{}" + , "[1" + , "[1," ] , testWith "EitherTextInt" diff --git a/tests/golden/generic.expected b/tests/golden/generic.expected index 05503d840..ce7f1e5c6 100644 --- a/tests/golden/generic.expected +++ b/tests/golden/generic.expected @@ -19,6 +19,9 @@ Error in $: parsing Types.SomeType failed, expected an Object with a single pair Error in $: parsing Types.SomeType failed, expected an Object with a single pair, but found 2 pairs Error in $: parsing Types.SomeType failed, expected an Object with a single pair, but found 0 pairs Error in $: parsing Types.SomeType failed, expected Object, but encountered Array +Error in $: not enough input. Expecting ':' +Error in $: not enough input. Expecting object value +Error in $: not enough input. Expecting ',' or '}' SomeType (two-element array) Error in $[1]: parsing Int failed, expected Number, but encountered Boolean Error in $[1]: parsing Types.SomeType(Record) failed, expected Object, but encountered Null @@ -26,6 +29,8 @@ Error in $[0]: parsing Types.SomeType failed, expected tag of the 2-element Arra Error in $[0]: parsing Types.SomeType failed, tag element is not a String Error in $: parsing Types.SomeType failed, expected a 2-element Array, but encountered an Array of length 0 Error in $: parsing Types.SomeType failed, expected Array, but encountered Object +Error in $: not enough input. Expecting ',' or ']' +Error in $: not enough input. Expecting json list value EitherTextInt Error in $: parsing Types.EitherTextInt(NoneNullary) failed, expected tag "nonenullary", but found tag "X" Error in $: parsing Types.EitherTextInt(NoneNullary) failed, expected String, but encountered Array From 10ee4b033379037436a6224263b5d449c1891010 Mon Sep 17 00:00:00 2001 From: FintanH Date: Wed, 24 Apr 2019 13:41:08 +0100 Subject: [PATCH 3/4] Use string concat --- Data/Aeson/Parser/Internal.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Data/Aeson/Parser/Internal.hs b/Data/Aeson/Parser/Internal.hs index 061eceac4..e900d7bef 100644 --- a/Data/Aeson/Parser/Internal.hs +++ b/Data/Aeson/Parser/Internal.hs @@ -279,7 +279,7 @@ eitherDecodeWith p to s = where buildMsg [] msg = msg buildMsg (expectation:_) msg = - msg <> ". Expecting " <> expectation + msg ++ ". Expecting " ++ expectation {-# INLINE eitherDecodeWith #-} eitherDecodeStrictWith :: Parser Value -> (Value -> IResult a) -> B.ByteString From d1364e482118c5317b8ad06ef1fcce3e87cb9931 Mon Sep 17 00:00:00 2001 From: Adam Bergmark Date: Wed, 24 Apr 2019 16:36:14 +0200 Subject: [PATCH 4/4] Fix ambiguous type error only manifesting on GHC 7.10.x --- Data/Aeson/Parser/Internal.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/Data/Aeson/Parser/Internal.hs b/Data/Aeson/Parser/Internal.hs index e900d7bef..c7e97b002 100644 --- a/Data/Aeson/Parser/Internal.hs +++ b/Data/Aeson/Parser/Internal.hs @@ -277,6 +277,7 @@ eitherDecodeWith p to s = IError path msg -> Left (path, msg) L.Fail _ ctx msg -> Left ([], buildMsg ctx msg) where + buildMsg :: [String] -> String -> String buildMsg [] msg = msg buildMsg (expectation:_) msg = msg ++ ". Expecting " ++ expectation