@@ -165,6 +165,9 @@ class GToJSON' enc arity f where
165
165
-- and 'liftToEncoding' (if the @arity@ is 'One').
166
166
gToJSON :: Options -> ToArgs enc arity a -> f a -> enc
167
167
168
+ class GOmitToJSON enc arity f where
169
+ gOmitField :: ToArgs enc arity a -> f a -> Bool
170
+
168
171
-- | A 'ToArgs' value either stores nothing (for 'ToJSON') or it stores the three
169
172
-- function arguments that encode occurrences of the type parameter (for
170
173
-- 'ToJSON1').
@@ -817,6 +820,22 @@ instance ( AllNullary (a :+: b) allNullary
817
820
. sumToJSON opts targs
818
821
{-# INLINE gToJSON #-}
819
822
823
+ instance ToJSON a => GOmitToJSON enc arity (K1 i a ) where
824
+ gOmitField _ = omitField . unK1
825
+ {-# INLINE gOmitField #-}
826
+
827
+ instance GOmitToJSON enc One Par1 where
828
+ gOmitField (To1Args o _ _) = o . unPar1
829
+ {-# INLINE gOmitField #-}
830
+
831
+ instance ToJSON1 f => GOmitToJSON enc One (Rec1 f ) where
832
+ gOmitField (To1Args o _ _) = liftOmitField o . unRec1
833
+ {-# INLINE gOmitField #-}
834
+
835
+ instance (ToJSON1 f , GOmitToJSON enc One g ) => GOmitToJSON enc One (f :.: g ) where
836
+ gOmitField targs = liftOmitField (gOmitField targs) . unComp1
837
+ {-# INLINE gOmitField #-}
838
+
820
839
--------------------------------------------------------------------------------
821
840
-- Generic toJSON
822
841
@@ -1170,47 +1189,14 @@ instance ( Monoid pairs
1170
1189
{-# INLINE recordToPairs #-}
1171
1190
1172
1191
instance ( Selector s
1173
- , GToJSON' enc arity (K1 i t )
1192
+ , GToJSON' enc arity a
1193
+ , GOmitToJSON enc arity a
1174
1194
, KeyValuePair enc pairs
1175
- , ToJSON t
1176
- ) => RecordToPairs enc pairs arity (S1 s (K1 i t ))
1195
+ ) => RecordToPairs enc pairs arity (S1 s a )
1177
1196
where
1178
1197
recordToPairs opts targs m1
1179
1198
| omitNothingFields opts
1180
- , omitField (unK1 $ unM1 m1 :: t )
1181
- = mempty
1182
-
1183
- | otherwise =
1184
- let key = Key. fromString $ fieldLabelModifier opts (selName m1)
1185
- value = gToJSON opts targs (unM1 m1)
1186
- in key `pair` value
1187
- {-# INLINE recordToPairs #-}
1188
-
1189
- instance ( Selector s
1190
- , GToJSON' enc One (Rec1 f )
1191
- , KeyValuePair enc pairs
1192
- , ToJSON1 f
1193
- ) => RecordToPairs enc pairs One (S1 s (Rec1 f ))
1194
- where
1195
- recordToPairs opts targs@ (To1Args o _ _) m1
1196
- | omitNothingFields opts
1197
- , liftOmitField o $ unRec1 $ unM1 m1
1198
- = mempty
1199
-
1200
- | otherwise =
1201
- let key = Key. fromString $ fieldLabelModifier opts (selName m1)
1202
- value = gToJSON opts targs (unM1 m1)
1203
- in key `pair` value
1204
- {-# INLINE recordToPairs #-}
1205
-
1206
- instance ( Selector s
1207
- , GToJSON' enc One Par1
1208
- , KeyValuePair enc pairs
1209
- ) => RecordToPairs enc pairs One (S1 s Par1 )
1210
- where
1211
- recordToPairs opts targs@ (To1Args o _ _) m1
1212
- | omitNothingFields opts
1213
- , o (unPar1 (unM1 m1))
1199
+ , gOmitField targs $ unM1 m1
1214
1200
= mempty
1215
1201
1216
1202
| otherwise =
0 commit comments