on master help sign in
Fix handling of unwrapUnaryRecords in GFromJSON

Removed the dummy unwrapping, instead determining whether the record is unary at the type level.

commitb8283bca20b4d199253b015af978e302033cc1e9 authorLysxia <lysxia@gmail.com> dateTue 27 Mar 2018, 11:32 (9 years ago) parente3dbf90
1 file changed+21−26
Data/Aeson/Types/FromJSON.hs+21−26
Data/Aeson/Types/FromJSON.hs+21−26
@@ -976,7 +976,7 @@ instance ( IsRecord f isRecord
976976
977977instance (FromRecord arity f) => FromTaggedObject'' arity f True where
978978 parseFromTaggedObject'' opts fargs _ =
979− Tagged . parseRecord opts fargs Nothing
979+ Tagged . parseRecord opts fargs
980980
981981instance (GFromJSON arity f) => FromTaggedObject'' arity f False where
982982 parseFromTaggedObject'' opts fargs contentsFieldName = Tagged .
@@ -993,57 +993,52 @@ class ConsFromJSON arity f where
993993
994994class ConsFromJSON' arity f isRecord where
995995 consParseJSON' :: Options -> FromArgs arity a
996− -> Maybe Text -- ^ A dummy label
997− -- (Nothing to use proper label)
998996 -> Value -> Tagged isRecord (Parser (f a))
999997
1000998instance ( IsRecord f isRecord
1001999 , ConsFromJSON' arity f isRecord
10021000 ) => ConsFromJSON arity f where
1003− consParseJSON opts fargs v = let
1004− (v2,lab) = case (unwrapUnaryRecords opts,isUnary (undefined :: f a)) of
1005− -- use a dummy object with a dummy label
1006− (True,True) -> (object [(pack "dummy",v)], Just $ pack "dummy")
1007− _ ->(v,Nothing)
1008− in (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a))
1009− $ consParseJSON' opts fargs lab v2
1001+ consParseJSON opts fargs =
1002+ (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a))
1003+ . consParseJSON' opts fargs
10101004
1005+instance OVERLAPPING_
1006+ ( GFromJSON arity a, FromRecord arity (S1 s a)
1007+ ) => ConsFromJSON' arity (S1 s a) 'True where
1008+ consParseJSON' opts fargs
1009+ | unwrapUnaryRecords opts = Tagged . gParseJSON opts fargs
1010+ | otherwise = Tagged . withObject "unary record" (parseRecord opts fargs)
10111011
1012−instance (FromRecord arity f) => ConsFromJSON' arity f True where
1013− consParseJSON' opts fargs mlab = Tagged . withObject "record (:*:)"
1014− (parseRecord opts fargs mlab)
1012+instance FromRecord arity f => ConsFromJSON' arity f True where
1013+ consParseJSON' opts fargs =
1014+ Tagged . withObject "record (:*:)" (parseRecord opts fargs)
10151015
10161016instance (GFromJSON arity f) => ConsFromJSON' arity f False where
1017− consParseJSON' opts fargs _ = Tagged . gParseJSON opts fargs
1017+ consParseJSON' opts fargs = Tagged . gParseJSON opts fargs
10181018
10191019--------------------------------------------------------------------------------
10201020
10211021class FromRecord arity f where
10221022 parseRecord :: Options -> FromArgs arity a
1023− -> Maybe Text -- ^ A dummy label
1024− -- (Nothing to use proper label)
10251023 -> Object -> Parser (f a)
10261024
10271025instance ( FromRecord arity a
10281026 , FromRecord arity b
10291027 ) => FromRecord arity (a :*: b) where
1030− parseRecord opts fargs _ obj =
1031− (:*:) <$> parseRecord opts fargs Nothing obj
1032− <*> parseRecord opts fargs Nothing obj
1028+ parseRecord opts fargs obj =
1029+ (:*:) <$> parseRecord opts fargs obj
1030+ <*> parseRecord opts fargs obj
10331031
10341032instance OVERLAPPABLE_ (Selector s, GFromJSON arity a) =>
10351033 FromRecord arity (S1 s a) where
1036− parseRecord opts fargs lab =
1034+ parseRecord opts fargs =
10371035 (<?> Key label) . gParseJSON opts fargs <=< (.: label)
10381036 where
1039− label = fromMaybe defLabel lab
1040− defLabel = pack . fieldLabelModifier opts $
1041− selName (undefined :: t s a p)
1037+ label = pack . fieldLabelModifier opts $ selName (undefined :: t s a p)
10421038
10431039instance INCOHERENT_ (Selector s, FromJSON a) =>
10441040 FromRecord arity (S1 s (K1 i (Maybe a))) where
1045− parseRecord _ _ (Just lab) obj = M1 . K1 <$> obj .:? lab
1046− parseRecord opts _ Nothing obj = M1 . K1 <$> obj .:? pack label
1041+ parseRecord opts _ obj = M1 . K1 <$> obj .:? pack label
10471042 where
10481043 label = fieldLabelModifier opts $
10491044 selName (undefined :: t s (K1 i (Maybe a)) p)
@@ -1051,7 +1046,7 @@ instance INCOHERENT_ (Selector s, FromJSON a) =>
10511046-- Parse an Option like a Maybe.
10521047instance INCOHERENT_ (Selector s, FromJSON a) =>
10531048 FromRecord arity (S1 s (K1 i (Semigroup.Option a))) where
1054− parseRecord opts fargs lab obj = wrap <$> parseRecord opts fargs lab obj
1049+ parseRecord opts fargs obj = wrap <$> parseRecord opts fargs obj
10551050 where
10561051 wrap :: S1 s (K1 i (Maybe a)) p -> S1 s (K1 i (Semigroup.Option a)) p
10571052 wrap (M1 (K1 a)) = M1 (K1 (Semigroup.Option a))