Skip to content
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.

Commit c56cfc1

Browse files
committedDec 19, 2024
class-based composition for printing side
1 parent 6350e9a commit c56cfc1

File tree

1 file changed

+23
-37
lines changed

1 file changed

+23
-37
lines changed
 

‎src/Data/Aeson/Types/ToJSON.hs

+23-37
Original file line numberDiff line numberDiff line change
@@ -165,6 +165,9 @@ class GToJSON' enc arity f where
165165
-- and 'liftToEncoding' (if the @arity@ is 'One').
166166
gToJSON :: Options -> ToArgs enc arity a -> f a -> enc
167167

168+
class GOmitToJSON enc arity f where
169+
gOmitField :: ToArgs enc arity a -> f a -> Bool
170+
168171
-- | A 'ToArgs' value either stores nothing (for 'ToJSON') or it stores the three
169172
-- function arguments that encode occurrences of the type parameter (for
170173
-- 'ToJSON1').
@@ -817,6 +820,22 @@ instance ( AllNullary (a :+: b) allNullary
817820
. sumToJSON opts targs
818821
{-# INLINE gToJSON #-}
819822

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+
820839
--------------------------------------------------------------------------------
821840
-- Generic toJSON
822841

@@ -1170,47 +1189,14 @@ instance ( Monoid pairs
11701189
{-# INLINE recordToPairs #-}
11711190

11721191
instance ( Selector s
1173-
, GToJSON' enc arity (K1 i t)
1192+
, GToJSON' enc arity a
1193+
, GOmitToJSON enc arity a
11741194
, KeyValuePair enc pairs
1175-
, ToJSON t
1176-
) => RecordToPairs enc pairs arity (S1 s (K1 i t))
1195+
) => RecordToPairs enc pairs arity (S1 s a)
11771196
where
11781197
recordToPairs opts targs m1
11791198
| 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
12141200
= mempty
12151201

12161202
| otherwise =

0 commit comments

Comments
 (0)
Please sign in to comment.