on master help sign in
Provide a clearer message when the required tagKey is missing, #719
67772c7grdvnl
Data/Aeson/Types/FromJSON.hs+19−8
@@ -911,11 +911,18 @@ type ConName = String
911contextType :: TypeName -> Parser a -> Parser a
911contextType :: TypeName -> Parser a -> Parser a
912contextType = prependContext
912contextType = prependContext
913
913
914+
915+
914-- | Add the tagKey that will be looked up while building an ADT
916-- | Add the tagKey that will be looked up while building an ADT
917+-- | Produce the error equivalent to
918+-- | Left "Error in $: parsing T failed, expected an object with keys "tag" and
919+-- | "contents", where "tag" i-- |s associated to one of ["Foo", "Bar"],
920+-- | The parser returned error was: could not find key "tag"
915−contextTag :: Text -> Parser a -> Parser a
921+contextTag :: Text -> [String] -> Parser a -> Parser a
916−contextTag tagKey = prependFailure
922+contextTag tagKey cnames = prependFailure
917− ("Missing required tagKey \"" ++ unpack tagKey ++
923+ ("expected an object with key \"" ++ unpack tagKey ++
924+ "\" where \"tag\" is associated to one of " ++ show cnames ++
918− "\". The parser returned error was: ")
925+ ". The parser returned error was: ")
919
926
920-- | Add the name of the constructor being parsed to a parser's error messages.
927-- | Add the name of the constructor being parsed to a parser's error messages.
921contextCons :: ConName -> TypeName -> Parser a -> Parser a
928contextCons :: ConName -> TypeName -> Parser a -> Parser a
@@ -1082,9 +1089,10 @@ instance Constructor c => ConstructorNames (C1 c a) where
1082 where
1089 where
1083 cname = conName (undefined :: M1 _i c _f _p)
1090 cname = conName (undefined :: M1 _i c _f _p)
1084
1091
1085−--------------------------------------------------------------------------------
1086
1092
1093+--------------------------------------------------------------------------------
1087−parseNonAllNullarySum :: ( FromPair arity f
1094+parseNonAllNullarySum :: forall f c arity.
1095+ ( FromPair arity f
1088 , FromTaggedObject arity f
1096 , FromTaggedObject arity f
1089 , FromUntaggedValue arity f
1097 , FromUntaggedValue arity f
1090 , ConstructorNames f
1098 , ConstructorNames f
@@ -1094,14 +1102,17 @@ parseNonAllNullarySum p@(tname :* opts :* _) =
1094 case sumEncoding opts of
1102 case sumEncoding opts of
1095 TaggedObject{..} ->
1103 TaggedObject{..} ->
1096 withObject tname $ \obj -> do
1104 withObject tname $ \obj -> do
1097− tag <- (contextType tname) . (contextTag tagKey) $ obj .: tagKey
1105+ tag <- (contextType tname) . (contextTag tagKey cnames_) $ obj .: tagKey
1098 fromMaybe (badTag tag <?> Key tagKey) $
1106 fromMaybe (badTag tag <?> Key tagKey) $
1099− parseFromTaggedObject (tag :* contentsFieldName :* p) obj
1107+ parseFromTaggedObject (tag :* contentsFieldName :* p) obj
1100 where
1108 where
1101 tagKey = pack tagFieldName
1109 tagKey = pack tagFieldName
1102 badTag tag = failWith_ $ \cnames ->
1110 badTag tag = failWith_ $ \cnames ->
1103 "expected tag field to be one of " ++ show cnames ++
1111 "expected tag field to be one of " ++ show cnames ++
1104 ", but found tag " ++ show tag
1112 ", but found tag " ++ show tag
1113+ cnames_ = unTagged2 (constructorTags opts :: Tagged2 f [String])
1114+ --cname_ = conName (undefined :: M1 _i c _f _p)
1115+ -- forall f a. ConstructorNames f
1105
1116
1106 ObjectWithSingleField ->
1117 ObjectWithSingleField ->
1107 withObject tname $ \obj -> case H.toList obj of
1118 withObject tname $ \obj -> case H.toList obj of