@@ -50,35 +50,19 @@ import Data.Monoid (mempty)
5050instance OVERLAPPABLE_ (GToJSON a) => GToJSON (M1 i c a) where
5151 -- Meta-information, which is not handled elsewhere, is ignored:
5252 gToJSON opts = gToJSON opts . unM1
53− {-# INLINE gToJSON #-}
54−
55− gToEncoding opts = gToEncoding opts . unM1
56− {-# INLINE gToEncoding #-}
5753
5854instance (ToJSON a) => GToJSON (K1 i a) where
5955 -- Constant values are encoded using their ToJSON instance:
6056 gToJSON _opts = toJSON . unK1
61− {-# INLINE gToJSON #-}
62−
63− gToEncoding _opts = toEncoding . unK1
64− {-# INLINE gToEncoding #-}
6557
6658instance GToJSON U1 where
6759 -- Empty constructors are encoded to an empty array:
6860 gToJSON _opts _ = emptyArray
69− {-# INLINE gToJSON #-}
70−
71− gToEncoding _opts _ = emptyArray_
72− {-# INLINE gToEncoding #-}
7361
7462instance (ConsToJSON a) => GToJSON (C1 c a) where
7563 -- Constructors need to be encoded differently depending on whether they're
7664 -- a record or not. This distinction is made by 'consToJSON':
7765 gToJSON opts = consToJSON opts . unM1
78− {-# INLINE gToJSON #-}
79−
80− gToEncoding opts = Encoding . consToEncoding opts . unM1
81− {-# INLINE gToEncoding #-}
8266
8367instance ( WriteProduct a, WriteProduct b
8468 , ProductSize a, ProductSize b ) => GToJSON (a :*: b) where
@@ -93,10 +77,6 @@ instance ( WriteProduct a, WriteProduct b
9377 where
9478 lenProduct = (unTagged2 :: Tagged2 (a :*: b) Int -> Int)
9579 productSize
96− {-# INLINE gToJSON #-}
97−
98− gToEncoding opts p = Encoding $
99− B.char7 '[' <> encodeProduct opts p <> B.char7 ']'
10080
10181instance ( AllNullary (a :+: b) allNullary
10282 , SumToJSON (a :+: b) allNullary ) => GToJSON (a :+: b) where
@@ -105,46 +85,65 @@ instance ( AllNullary (a :+: b) allNullary
10585 -- strings. This distinction is made by 'sumToJSON':
10686 gToJSON opts = (unTagged :: Tagged allNullary Value -> Value)
10787 . sumToJSON opts
108− {-# INLINE gToJSON #-}
10988
89+--------------------------------------------------------------------------------
90+-- Generic toEncoding
91+
92+instance OVERLAPPABLE_ (GToEncoding a) => GToEncoding (M1 i c a) where
93+ -- Meta-information, which is not handled elsewhere, is ignored:
94+ gToEncoding opts = gToEncoding opts . unM1
95+
96+instance (ToJSON a) => GToEncoding (K1 i a) where
97+ -- Constant values are encoded using their ToJSON instance:
98+ gToEncoding _opts = toEncoding . unK1
99+
100+instance GToEncoding U1 where
101+ -- Empty constructors are encoded to an empty array:
102+ gToEncoding _opts _ = emptyArray_
103+
104+instance (ConsToEncoding a) => GToEncoding (C1 c a) where
105+ -- Constructors need to be encoded differently depending on whether they're
106+ -- a record or not. This distinction is made by 'consToEncoding':
107+ gToEncoding opts = Encoding . consToEncoding opts . unM1
108+
109+instance ( EncodeProduct a, EncodeProduct b ) => GToEncoding (a :*: b) where
110+ -- Products are encoded to an array. Here we allocate a mutable vector of
111+ -- the same size as the product and write the product's elements to it using
112+ -- 'encodeProduct':
113+ gToEncoding opts p = Encoding $
114+ B.char7 '[' <> encodeProduct opts p <> B.char7 ']'
115+
116+instance ( AllNullary (a :+: b) allNullary
117+ , SumToEncoding (a :+: b) allNullary ) => GToEncoding (a :+: b) where
118+ -- If all constructors of a sum datatype are nullary and the
119+ -- 'allNullaryToStringTag' option is set they are encoded to
120+ -- strings. This distinction is made by 'sumToEncoding':
110121 gToEncoding opts = Encoding .
111122 (unTagged :: Tagged allNullary B.Builder -> B.Builder) .
112123 sumToEncoding opts
113− {-# INLINE gToEncoding #-}
114124
115125--------------------------------------------------------------------------------
116126
117127class SumToJSON f allNullary where
118128 sumToJSON :: Options -> f a -> Tagged allNullary Value
119− sumToEncoding :: Options -> f a -> Tagged allNullary B.Builder
120129
121−instance ( GetConName f
122− , TaggedObject f
123− , ObjectWithSingleField f
124− , TwoElemArray f ) => SumToJSON f True where
130+instance ( GetConName f
131+ , TaggedObjectPairs f
132+ , ObjectWithSingleFieldObj f
133+ , TwoElemArrayObj f ) => SumToJSON f True where
125134 sumToJSON opts
126135 | allNullaryToStringTag opts = Tagged . String . pack
127136 . constructorTagModifier opts . getConName
128137 | otherwise = Tagged . nonAllNullarySumToJSON opts
129− {-# INLINE sumToJSON #-}
130−
131− sumToEncoding opts
132− | allNullaryToStringTag opts = Tagged . builder .
133− constructorTagModifier opts . getConName
134− | otherwise = Tagged . nonAllNullarySumToEncoding opts
135− {-# INLINE sumToEncoding #-}
136138
137−instance ( TwoElemArray f
138− , TaggedObject f
139− , ObjectWithSingleField f ) => SumToJSON f False where
139+instance ( TwoElemArrayObj f
140+ , TaggedObjectPairs f
141+ , ObjectWithSingleFieldObj f ) => SumToJSON f False where
140142 sumToJSON opts = Tagged . nonAllNullarySumToJSON opts
141− {-# INLINE sumToJSON #-}
142− sumToEncoding opts = Tagged . nonAllNullarySumToEncoding opts
143− {-# INLINE sumToEncoding #-}
144143
145−nonAllNullarySumToJSON :: ( TwoElemArray f
146− , TaggedObject f
147− , ObjectWithSingleField f
144+nonAllNullarySumToJSON :: ( TwoElemArrayObj f
145+ , TaggedObjectPairs f
146+ , ObjectWithSingleFieldObj f
148147 ) => Options -> f a -> Value
149148nonAllNullarySumToJSON opts =
150149 case sumEncoding opts of
@@ -152,50 +151,83 @@ nonAllNullarySumToJSON opts =
152151 object . taggedObjectPairs opts tagFieldName contentsFieldName
153152 ObjectWithSingleField -> Object . objectWithSingleFieldObj opts
154153 TwoElemArray -> Array . twoElemArrayObj opts
155−{-# INLINE nonAllNullarySumToJSON #-}
156154
157−nonAllNullarySumToEncoding :: ( TwoElemArray f
158− , TaggedObject f
159− , ObjectWithSingleField f
160− ) => Options -> f a -> B.Builder
155+--------------------------------------------------------------------------------
156+
157+class SumToEncoding f allNullary where
158+ sumToEncoding :: Options -> f a -> Tagged allNullary B.Builder
159+
160+instance ( GetConName f
161+ , TaggedObjectEnc f
162+ , ObjectWithSingleFieldEnc f
163+ , TwoElemArrayEnc f ) => SumToEncoding f True where
164+ sumToEncoding opts
165+ | allNullaryToStringTag opts = Tagged . builder .
166+ constructorTagModifier opts . getConName
167+ | otherwise = Tagged . nonAllNullarySumToEncoding opts
168+
169+instance ( TwoElemArrayEnc f
170+ , TaggedObjectEnc f
171+ , ObjectWithSingleFieldEnc f ) => SumToEncoding f False where
172+ sumToEncoding opts = Tagged . nonAllNullarySumToEncoding opts
173+
174+nonAllNullarySumToEncoding :: ( TwoElemArrayEnc f
175+ , TaggedObjectEnc f
176+ , ObjectWithSingleFieldEnc f
177+ ) => Options -> f a -> B.Builder
161178nonAllNullarySumToEncoding opts =
162179 case sumEncoding opts of
163180 TaggedObject{..} ->
164181 taggedObjectEnc opts tagFieldName contentsFieldName
165182 ObjectWithSingleField -> objectWithSingleFieldEnc opts
166183 TwoElemArray -> twoElemArrayEnc opts
167−{-# INLINE nonAllNullarySumToEncoding #-}
168184
169185--------------------------------------------------------------------------------
170186
171−class TaggedObject f where
187+class TaggedObjectPairs f where
172188 taggedObjectPairs :: Options -> String -> String -> f a -> [Pair]
173− taggedObjectEnc :: Options -> String -> String -> f a -> B.Builder
174189
175−instance ( TaggedObject a
176− , TaggedObject b ) => TaggedObject (a :+: b) where
190+instance ( TaggedObjectPairs a
191+ , TaggedObjectPairs b ) => TaggedObjectPairs (a :+: b) where
177192 taggedObjectPairs opts tagFieldName contentsFieldName (L1 x) =
178193 taggedObjectPairs opts tagFieldName contentsFieldName x
179194 taggedObjectPairs opts tagFieldName contentsFieldName (R1 x) =
180195 taggedObjectPairs opts tagFieldName contentsFieldName x
181− {-# INLINE taggedObjectPairs #-}
182−
183− taggedObjectEnc opts tagFieldName contentsFieldName (L1 x) =
184− taggedObjectEnc opts tagFieldName contentsFieldName x
185− taggedObjectEnc opts tagFieldName contentsFieldName (R1 x) =
186− taggedObjectEnc opts tagFieldName contentsFieldName x
187− {-# INLINE taggedObjectEnc #-}
188196
189−instance ( IsRecord a isRecord
190− , TaggedObject' a isRecord
191− , Constructor c ) => TaggedObject (C1 c a) where
197+instance ( IsRecord a isRecord
198+ , TaggedObjectPairs' a isRecord
199+ , Constructor c ) => TaggedObjectPairs (C1 c a) where
192200 taggedObjectPairs opts tagFieldName contentsFieldName =
193201 (pack tagFieldName .= constructorTagModifier opts
194202 (conName (undefined :: t c a p)) :) .
195203 (unTagged :: Tagged isRecord [Pair] -> [Pair]) .
196204 taggedObjectPairs' opts contentsFieldName . unM1
197− {-# INLINE taggedObjectPairs #-}
198205
206+class TaggedObjectPairs' f isRecord where
207+ taggedObjectPairs' :: Options -> String -> f a -> Tagged isRecord [Pair]
208+
209+instance (RecordToPairs f) => TaggedObjectPairs' f True where
210+ taggedObjectPairs' opts _ = Tagged . toList . recordToPairs opts
211+
212+instance (GToJSON f) => TaggedObjectPairs' f False where
213+ taggedObjectPairs' opts contentsFieldName =
214+ Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts
215+
216+--------------------------------------------------------------------------------
217+
218+class TaggedObjectEnc f where
219+ taggedObjectEnc :: Options -> String -> String -> f a -> B.Builder
220+
221+instance ( TaggedObjectEnc a
222+ , TaggedObjectEnc b ) => TaggedObjectEnc (a :+: b) where
223+ taggedObjectEnc opts tagFieldName contentsFieldName (L1 x) =
224+ taggedObjectEnc opts tagFieldName contentsFieldName x
225+ taggedObjectEnc opts tagFieldName contentsFieldName (R1 x) =
226+ taggedObjectEnc opts tagFieldName contentsFieldName x
227+
228+instance ( IsRecord a isRecord
229+ , TaggedObjectEnc' a isRecord
230+ , Constructor c ) => TaggedObjectEnc (C1 c a) where
199231 taggedObjectEnc opts tagFieldName contentsFieldName v =
200232 B.char7 '{' <>
201233 (builder tagFieldName <>
@@ -205,28 +237,17 @@ instance ( IsRecord a isRecord
205237 ((unTagged :: Tagged isRecord B.Builder -> B.Builder) .
206238 taggedObjectEnc' opts contentsFieldName . unM1 $ v) <>
207239 B.char7 '}'
208− {-# INLINE taggedObjectEnc #-}
209240
210−class TaggedObject' f isRecord where
211− taggedObjectPairs' :: Options -> String -> f a -> Tagged isRecord [Pair]
241+class TaggedObjectEnc' f isRecord where
212242 taggedObjectEnc' :: Options -> String -> f a -> Tagged isRecord B.Builder
213243
214−instance (RecordTo f) => TaggedObject' f True where
215− taggedObjectPairs' opts _ = Tagged . toList . recordToPairs opts
216− {-# INLINE taggedObjectPairs' #-}
217−
244+instance (RecordToEncoding f) => TaggedObjectEnc' f True where
218245 taggedObjectEnc' opts _ = Tagged . recordToEncoding opts
219− {-# INLINE taggedObjectEnc' #-}
220−
221−instance (GToJSON f) => TaggedObject' f False where
222− taggedObjectPairs' opts contentsFieldName =
223− Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts
224− {-# INLINE taggedObjectPairs' #-}
225246
247+instance (GToEncoding f) => TaggedObjectEnc' f False where
226248 taggedObjectEnc' opts contentsFieldName =
227249 Tagged . (\z -> builder contentsFieldName <> B.char7 ':' <> z) .
228250 gbuilder opts
229− {-# INLINE taggedObjectEnc' #-}
230251
231252--------------------------------------------------------------------------------
232253
@@ -237,133 +258,139 @@ class GetConName f where
237258instance (GetConName a, GetConName b) => GetConName (a :+: b) where
238259 getConName (L1 x) = getConName x
239260 getConName (R1 x) = getConName x
240− {-# INLINE getConName #-}
241261
242−instance (Constructor c, GToJSON a, ConsToJSON a) => GetConName (C1 c a) where
262+instance (Constructor c) => GetConName (C1 c a) where
243263 getConName = conName
244− {-# INLINE getConName #-}
245264
246265--------------------------------------------------------------------------------
247266
248−class TwoElemArray f where
267+class TwoElemArrayObj f where
249268 twoElemArrayObj :: Options -> f a -> V.Vector Value
250− twoElemArrayEnc :: Options -> f a -> B.Builder
251269
252−instance (TwoElemArray a, TwoElemArray b) => TwoElemArray (a :+: b) where
270+instance (TwoElemArrayObj a, TwoElemArrayObj b) => TwoElemArrayObj (a :+: b) where
253271 twoElemArrayObj opts (L1 x) = twoElemArrayObj opts x
254272 twoElemArrayObj opts (R1 x) = twoElemArrayObj opts x
255− {-# INLINE twoElemArrayObj #-}
256−
257− twoElemArrayEnc opts (L1 x) = twoElemArrayEnc opts x
258− twoElemArrayEnc opts (R1 x) = twoElemArrayEnc opts x
259− {-# INLINE twoElemArrayEnc #-}
260273
261274instance ( GToJSON a, ConsToJSON a
262− , Constructor c ) => TwoElemArray (C1 c a) where
275+ , Constructor c ) => TwoElemArrayObj (C1 c a) where
263276 twoElemArrayObj opts x = V.create $ do
264277 mv <- VM.unsafeNew 2
265278 VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
266279 $ conName (undefined :: t c a p)
267280 VM.unsafeWrite mv 1 $ gToJSON opts x
268281 return mv
269− {-# INLINE twoElemArrayObj #-}
270282
283+--------------------------------------------------------------------------------
284+
285+class TwoElemArrayEnc f where
286+ twoElemArrayEnc :: Options -> f a -> B.Builder
287+
288+instance (TwoElemArrayEnc a, TwoElemArrayEnc b) => TwoElemArrayEnc (a :+: b) where
289+ twoElemArrayEnc opts (L1 x) = twoElemArrayEnc opts x
290+ twoElemArrayEnc opts (R1 x) = twoElemArrayEnc opts x
291+
292+instance ( GToEncoding a, ConsToEncoding a
293+ , Constructor c ) => TwoElemArrayEnc (C1 c a) where
271294 twoElemArrayEnc opts x = fromEncoding . tuple $
272295 builder (constructorTagModifier opts (conName (undefined :: t c a p))) >*<
273296 gbuilder opts x
274− {-# INLINE twoElemArrayEnc #-}
275297
276298--------------------------------------------------------------------------------
277299
278300class ConsToJSON f where
279301 consToJSON :: Options -> f a -> Value
280− consToEncoding :: Options -> f a -> B.Builder
281302
282303class ConsToJSON' f isRecord where
283304 consToJSON' :: Options -> Bool -- ^ Are we a record with one field?
284305 -> f a -> Tagged isRecord Value
285− consToEncoding' :: Options -> Bool -- ^ Are we a record with one field?
286− -> f a -> Tagged isRecord B.Builder
287306
288307instance ( IsRecord f isRecord
289308 , ConsToJSON' f isRecord ) => ConsToJSON f where
290309 consToJSON opts = (unTagged :: Tagged isRecord Value -> Value)
291310 . consToJSON' opts (isUnary (undefined :: f a))
292− {-# INLINE consToJSON #-}
293−
294− consToEncoding opts = (unTagged :: Tagged isRecord B.Builder -> B.Builder)
295− . consToEncoding' opts (isUnary (undefined :: f a))
296− {-# INLINE consToEncoding #-}
297311
298−instance (RecordTo f) => ConsToJSON' f True where
312+instance (RecordToPairs f) => ConsToJSON' f True where
299313 consToJSON' opts isUn f = let
300314 vals = toList $ recordToPairs opts f
301315 in case (unwrapUnaryRecords opts,isUn,vals) of
302316 (True,True,[(_,val)]) -> Tagged val
303317 _ -> Tagged $ object vals
304− {-# INLINE consToJSON' #-}
305318
319+instance GToJSON f => ConsToJSON' f False where
320+ consToJSON' opts _ = Tagged . gToJSON opts
321+
322+--------------------------------------------------------------------------------
323+
324+class ConsToEncoding f where
325+ consToEncoding :: Options -> f a -> B.Builder
326+
327+class ConsToEncoding' f isRecord where
328+ consToEncoding' :: Options -> Bool -- ^ Are we a record with one field?
329+ -> f a -> Tagged isRecord B.Builder
330+
331+instance ( IsRecord f isRecord
332+ , ConsToEncoding' f isRecord ) => ConsToEncoding f where
333+ consToEncoding opts = (unTagged :: Tagged isRecord B.Builder -> B.Builder)
334+ . consToEncoding' opts (isUnary (undefined :: f a))
335+
336+instance (RecordToEncoding f) => ConsToEncoding' f True where
306337 consToEncoding' opts isUn x
307338 | (True,True) <- (unwrapUnaryRecords opts,isUn) = Tagged $ recordToEncoding opts x
308339 | otherwise = Tagged $
309340 B.char7 '{' <>
310341 recordToEncoding opts x <>
311342 B.char7 '}'
312− {-# INLINE consToEncoding' #-}
313343
314−instance GToJSON f => ConsToJSON' f False where
315− consToJSON' opts _ = Tagged . gToJSON opts
316− {-# INLINE consToJSON' #-}
344+instance GToEncoding f => ConsToEncoding' f False where
317345 consToEncoding' opts _ = Tagged . gbuilder opts
318− {-# INLINE consToEncoding' #-}
319346
320347--------------------------------------------------------------------------------
321348
322−class RecordTo f where
349+class RecordToPairs f where
323350 recordToPairs :: Options -> f a -> DList Pair
324− recordToEncoding :: Options -> f a -> B.Builder
325351
326−instance (RecordTo a, RecordTo b) => RecordTo (a :*: b) where
352+instance (RecordToPairs a, RecordToPairs b) => RecordToPairs (a :*: b) where
327353 recordToPairs opts (a :*: b) = recordToPairs opts a <>
328354 recordToPairs opts b
329− {-# INLINE recordToPairs #-}
330−
331− recordToEncoding opts (a :*: b) = recordToEncoding opts a <>
332− B.char7 ',' <>
333− recordToEncoding opts b
334− {-# INLINE recordToEncoding #-}
335355
336−instance (Selector s, GToJSON a) => RecordTo (S1 s a) where
356+instance (Selector s, GToJSON a) => RecordToPairs (S1 s a) where
337357 recordToPairs = fieldToPair
338− {-# INLINE recordToPairs #-}
339−
340− recordToEncoding = fieldToEncoding
341− {-# INLINE recordToEncoding #-}
342358
343359instance OVERLAPPING_ (Selector s, ToJSON a) =>
344− RecordTo (S1 s (K1 i (Maybe a))) where
360+ RecordToPairs (S1 s (K1 i (Maybe a))) where
345361 recordToPairs opts (M1 k1) | omitNothingFields opts
346362 , K1 Nothing <- k1 = empty
347363 recordToPairs opts m1 = fieldToPair opts m1
348− {-# INLINE recordToPairs #-}
349−
350− recordToEncoding opts (M1 k1) | omitNothingFields opts
351− , K1 Nothing <- k1 = mempty
352− recordToEncoding opts m1 = fieldToEncoding opts m1
353− {-# INLINE recordToEncoding #-}
354364
355365fieldToPair :: (Selector s, GToJSON a) => Options -> S1 s a p -> DList Pair
356366fieldToPair opts m1 = pure ( pack $ fieldLabelModifier opts $ selName m1
357367 , gToJSON opts (unM1 m1)
358368 )
359−{-# INLINE fieldToPair #-}
360369
361−fieldToEncoding :: (Selector s, GToJSON a) => Options -> S1 s a p -> B.Builder
370+--------------------------------------------------------------------------------
371+
372+class RecordToEncoding f where
373+ recordToEncoding :: Options -> f a -> B.Builder
374+
375+instance (RecordToEncoding a, RecordToEncoding b) => RecordToEncoding (a :*: b) where
376+ recordToEncoding opts (a :*: b) = recordToEncoding opts a <>
377+ B.char7 ',' <>
378+ recordToEncoding opts b
379+
380+instance (Selector s, GToEncoding a) => RecordToEncoding (S1 s a) where
381+ recordToEncoding = fieldToEncoding
382+
383+instance OVERLAPPING_ (Selector s, ToJSON a) =>
384+ RecordToEncoding (S1 s (K1 i (Maybe a))) where
385+ recordToEncoding opts (M1 k1) | omitNothingFields opts
386+ , K1 Nothing <- k1 = mempty
387+ recordToEncoding opts m1 = fieldToEncoding opts m1
388+
389+fieldToEncoding :: (Selector s, GToEncoding a) => Options -> S1 s a p -> B.Builder
362390fieldToEncoding opts m1 =
363391 builder (fieldLabelModifier opts $ selName m1) <>
364392 B.char7 ':' <>
365393 gbuilder opts (unM1 m1)
366−{-# INLINE fieldToEncoding #-}
367394
368395--------------------------------------------------------------------------------
369396
@@ -374,7 +401,6 @@ class WriteProduct f where
374401 -> Int -- ^ length
375402 -> f a
376403 -> ST s ()
377− encodeProduct :: Options -> f a -> B.Builder
378404
379405instance ( WriteProduct a
380406 , WriteProduct b ) => WriteProduct (a :*: b) where
@@ -385,44 +411,53 @@ instance ( WriteProduct a
385411 lenL = len `unsafeShiftR` 1
386412 lenR = len - lenL
387413 ixR = ix + lenL
388− {-# INLINE writeProduct #-}
389414
415+instance OVERLAPPABLE_ (GToJSON a) => WriteProduct a where
416+ writeProduct opts mv ix _ = VM.unsafeWrite mv ix . gToJSON opts
417+
418+--------------------------------------------------------------------------------
419+
420+class EncodeProduct f where
421+ encodeProduct :: Options -> f a -> B.Builder
422+
423+instance ( EncodeProduct a
424+ , EncodeProduct b ) => EncodeProduct (a :*: b) where
390425 encodeProduct opts (a :*: b) = encodeProduct opts a <>
391426 B.char7 ',' <>
392427 encodeProduct opts b
393− {-# INLINE encodeProduct #-}
394−
395−instance OVERLAPPABLE_ (GToJSON a) => WriteProduct a where
396− writeProduct opts mv ix _ = VM.unsafeWrite mv ix . gToJSON opts
397− {-# INLINE writeProduct #-}
398428
429+instance OVERLAPPABLE_ (GToEncoding a) => EncodeProduct a where
399430 encodeProduct opts = gbuilder opts
400− {-# INLINE encodeProduct #-}
401431
402432--------------------------------------------------------------------------------
403433
404−class ObjectWithSingleField f where
434+class ObjectWithSingleFieldObj f where
405435 objectWithSingleFieldObj :: Options -> f a -> Object
406− objectWithSingleFieldEnc :: Options -> f a -> B.Builder
407436
408−instance ( ObjectWithSingleField a
409− , ObjectWithSingleField b ) => ObjectWithSingleField (a :+: b) where
437+instance ( ObjectWithSingleFieldObj a
438+ , ObjectWithSingleFieldObj b ) => ObjectWithSingleFieldObj (a :+: b) where
410439 objectWithSingleFieldObj opts (L1 x) = objectWithSingleFieldObj opts x
411440 objectWithSingleFieldObj opts (R1 x) = objectWithSingleFieldObj opts x
412− {-# INLINE objectWithSingleFieldObj #-}
413−
414− objectWithSingleFieldEnc opts (L1 x) = objectWithSingleFieldEnc opts x
415− objectWithSingleFieldEnc opts (R1 x) = objectWithSingleFieldEnc opts x
416− {-# INLINE objectWithSingleFieldEnc #-}
417441
418442instance ( GToJSON a, ConsToJSON a
419− , Constructor c ) => ObjectWithSingleField (C1 c a) where
443+ , Constructor c ) => ObjectWithSingleFieldObj (C1 c a) where
420444 objectWithSingleFieldObj opts = H.singleton typ . gToJSON opts
421445 where
422446 typ = pack $ constructorTagModifier opts $
423447 conName (undefined :: t c a p)
424− {-# INLINE objectWithSingleFieldObj #-}
425448
449+--------------------------------------------------------------------------------
450+
451+class ObjectWithSingleFieldEnc f where
452+ objectWithSingleFieldEnc :: Options -> f a -> B.Builder
453+
454+instance ( ObjectWithSingleFieldEnc a
455+ , ObjectWithSingleFieldEnc b ) => ObjectWithSingleFieldEnc (a :+: b) where
456+ objectWithSingleFieldEnc opts (L1 x) = objectWithSingleFieldEnc opts x
457+ objectWithSingleFieldEnc opts (R1 x) = objectWithSingleFieldEnc opts x
458+
459+instance ( GToEncoding a, ConsToEncoding a
460+ , Constructor c ) => ObjectWithSingleFieldEnc (C1 c a) where
426461 objectWithSingleFieldEnc opts v =
427462 B.char7 '{' <>
428463 builder (constructorTagModifier opts
@@ -430,9 +465,8 @@ instance ( GToJSON a, ConsToJSON a
430465 B.char7 ':' <>
431466 gbuilder opts v <>
432467 B.char7 '}'
433− {-# INLINE objectWithSingleFieldEnc #-}
434468
435−gbuilder :: GToJSON f => Options -> f a -> Builder
469+gbuilder :: GToEncoding f => Options -> f a -> Builder
436470gbuilder opts = fromEncoding . gToEncoding opts
437471
438472--------------------------------------------------------------------------------
@@ -442,25 +476,21 @@ instance OVERLAPPABLE_ (GFromJSON a) => GFromJSON (M1 i c a) where
442476 -- Meta-information, which is not handled elsewhere, is just added to the
443477 -- parsed value:
444478 gParseJSON opts = fmap M1 . gParseJSON opts
445− {-# INLINE gParseJSON #-}
446479
447480instance (FromJSON a) => GFromJSON (K1 i a) where
448481 -- Constant values are decoded using their FromJSON instance:
449482 gParseJSON _opts = fmap K1 . parseJSON
450− {-# INLINE gParseJSON #-}
451483
452484instance GFromJSON U1 where
453485 -- Empty constructors are expected to be encoded as an empty array:
454486 gParseJSON _opts v
455487 | isEmptyArray v = pure U1
456488 | otherwise = typeMismatch "unit constructor (U1)" v
457− {-# INLINE gParseJSON #-}
458489
459490instance (ConsFromJSON a) => GFromJSON (C1 c a) where
460491 -- Constructors need to be decoded differently depending on whether they're
461492 -- a record or not. This distinction is made by consParseJSON:
462493 gParseJSON opts = fmap M1 . consParseJSON opts
463− {-# INLINE gParseJSON #-}
464494
465495instance ( FromProduct a, FromProduct b
466496 , ProductSize a, ProductSize b ) => GFromJSON (a :*: b) where
@@ -476,7 +506,6 @@ instance ( FromProduct a, FromProduct b
476506 else fail $ "When expecting a product of " ++ show lenProduct ++
477507 " values, encountered an Array of " ++ show lenArray ++
478508 " elements instead"
479− {-# INLINE gParseJSON #-}
480509
481510instance ( AllNullary (a :+: b) allNullary
482511 , ParseSum (a :+: b) allNullary ) => GFromJSON (a :+: b) where
@@ -486,7 +515,6 @@ instance ( AllNullary (a :+: b) allNullary
486515 gParseJSON opts = (unTagged :: Tagged allNullary (Parser ((a :+: b) d)) ->
487516 (Parser ((a :+: b) d)))
488517 . parseSum opts
489− {-# INLINE gParseJSON #-}
490518
491519--------------------------------------------------------------------------------
492520
@@ -499,12 +527,10 @@ instance ( SumFromString (a :+: b)
499527 parseSum opts
500528 | allNullaryToStringTag opts = Tagged . parseAllNullarySum opts
501529 | otherwise = Tagged . parseNonAllNullarySum opts
502− {-# INLINE parseSum #-}
503530
504531instance ( FromPair (a :+: b)
505532 , FromTaggedObject (a :+: b) ) => ParseSum (a :+: b) False where
506533 parseSum opts = Tagged . parseNonAllNullarySum opts
507− {-# INLINE parseSum #-}
508534
509535--------------------------------------------------------------------------------
510536
@@ -512,7 +538,6 @@ parseAllNullarySum :: SumFromString f => Options -> Value -> Parser (f a)
512538parseAllNullarySum opts = withText "Text" $ \key ->
513539 maybe (notFound $ unpack key) return $
514540 parseSumFromString opts key
515−{-# INLINE parseAllNullarySum #-}
516541
517542class SumFromString f where
518543 parseSumFromString :: Options -> Text -> Maybe (f a)
@@ -520,7 +545,6 @@ class SumFromString f where
520545instance (SumFromString a, SumFromString b) => SumFromString (a :+: b) where
521546 parseSumFromString opts key = (L1 <$> parseSumFromString opts key) <|>
522547 (R1 <$> parseSumFromString opts key)
523− {-# INLINE parseSumFromString #-}
524548
525549instance (Constructor c) => SumFromString (C1 c U1) where
526550 parseSumFromString opts key | key == name = Just $ M1 U1
@@ -528,7 +552,6 @@ instance (Constructor c) => SumFromString (C1 c U1) where
528552 where
529553 name = pack $ constructorTagModifier opts $
530554 conName (undefined :: t c U1 p)
531− {-# INLINE parseSumFromString #-}
532555
533556--------------------------------------------------------------------------------
534557
@@ -558,7 +581,6 @@ parseNonAllNullarySum opts =
558581 parsePair opts (tag, V.unsafeIndex arr 1)
559582 _ -> fail "First element is not a String"
560583 else fail "Array doesn't have 2 elements"
561−{-# INLINE parseNonAllNullarySum #-}
562584
563585--------------------------------------------------------------------------------
564586
@@ -571,7 +593,6 @@ instance (FromTaggedObject a, FromTaggedObject b) =>
571593 parseFromTaggedObject opts contentsFieldName obj tag =
572594 (fmap L1 <$> parseFromTaggedObject opts contentsFieldName obj tag) <|>
573595 (fmap R1 <$> parseFromTaggedObject opts contentsFieldName obj tag)
574− {-# INLINE parseFromTaggedObject #-}
575596
576597instance ( FromTaggedObject' f
577598 , Constructor c ) => FromTaggedObject (C1 c f) where
@@ -582,7 +603,6 @@ instance ( FromTaggedObject' f
582603 where
583604 name = pack $ constructorTagModifier opts $
584605 conName (undefined :: t c f p)
585− {-# INLINE parseFromTaggedObject #-}
586606
587607--------------------------------------------------------------------------------
588608
@@ -599,16 +619,13 @@ instance ( IsRecord f isRecord
599619 parseFromTaggedObject' opts contentsFieldName =
600620 (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a)) .
601621 parseFromTaggedObject'' opts contentsFieldName
602− {-# INLINE parseFromTaggedObject' #-}
603622
604623instance (FromRecord f) => FromTaggedObject'' f True where
605624 parseFromTaggedObject'' opts _ = Tagged . parseRecord opts Nothing
606− {-# INLINE parseFromTaggedObject'' #-}
607625
608626instance (GFromJSON f) => FromTaggedObject'' f False where
609627 parseFromTaggedObject'' opts contentsFieldName = Tagged .
610628 (gParseJSON opts <=< (.: pack contentsFieldName))
611− {-# INLINE parseFromTaggedObject'' #-}
612629
613630--------------------------------------------------------------------------------
614631
@@ -630,17 +647,14 @@ instance ( IsRecord f isRecord
630647 _ ->(v,Nothing)
631648 in (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a))
632649 $ consParseJSON' opts lab v2
633− {-# INLINE consParseJSON #-}
634650
635651
636652instance (FromRecord f) => ConsFromJSON' f True where
637653 consParseJSON' opts mlab = Tagged . (withObject "record (:*:)"
638654 $ parseRecord opts mlab)
639− {-# INLINE consParseJSON' #-}
640655
641656instance (GFromJSON f) => ConsFromJSON' f False where
642657 consParseJSON' opts _ = Tagged . gParseJSON opts
643− {-# INLINE consParseJSON' #-}
644658
645659--------------------------------------------------------------------------------
646660
@@ -652,7 +666,6 @@ class FromRecord f where
652666instance (FromRecord a, FromRecord b) => FromRecord (a :*: b) where
653667 parseRecord opts _ obj = (:*:) <$> parseRecord opts Nothing obj
654668 <*> parseRecord opts Nothing obj
655− {-# INLINE parseRecord #-}
656669
657670instance (Selector s, GFromJSON a) => FromRecord (S1 s a) where
658671 parseRecord opts (Just lab) = maybe (notFound $ unpack lab)
@@ -661,7 +674,6 @@ instance (Selector s, GFromJSON a) => FromRecord (S1 s a) where
661674 (gParseJSON opts) . H.lookup (pack label)
662675 where
663676 label = fieldLabelModifier opts $ selName (undefined :: t s a p)
664− {-# INLINE parseRecord #-}
665677
666678instance OVERLAPPING_ (Selector s, FromJSON a) =>
667679 FromRecord (S1 s (K1 i (Maybe a))) where
@@ -670,7 +682,6 @@ instance OVERLAPPING_ (Selector s, FromJSON a) =>
670682 where
671683 label = fieldLabelModifier opts $
672684 selName (undefined :: t s (K1 i (Maybe a)) p)
673− {-# INLINE parseRecord #-}
674685
675686--------------------------------------------------------------------------------
676687
@@ -680,11 +691,9 @@ class ProductSize f where
680691instance (ProductSize a, ProductSize b) => ProductSize (a :*: b) where
681692 productSize = Tagged2 $ unTagged2 (productSize :: Tagged2 a Int) +
682693 unTagged2 (productSize :: Tagged2 b Int)
683− {-# INLINE productSize #-}
684694
685695instance ProductSize (S1 s a) where
686696 productSize = Tagged2 1
687− {-# INLINE productSize #-}
688697
689698--------------------------------------------------------------------------------
690699
@@ -699,11 +708,9 @@ instance (FromProduct a, FromProduct b) => FromProduct (a :*: b) where
699708 lenL = len `unsafeShiftR` 1
700709 ixR = ix + lenL
701710 lenR = len - lenL
702− {-# INLINE parseProduct #-}
703711
704712instance (GFromJSON a) => FromProduct (S1 s a) where
705713 parseProduct opts arr ix _ = gParseJSON opts $ V.unsafeIndex arr ix
706− {-# INLINE parseProduct #-}
707714
708715--------------------------------------------------------------------------------
709716
@@ -713,7 +720,6 @@ class FromPair f where
713720instance (FromPair a, FromPair b) => FromPair (a :+: b) where
714721 parsePair opts pair = (fmap L1 <$> parsePair opts pair) <|>
715722 (fmap R1 <$> parsePair opts pair)
716− {-# INLINE parsePair #-}
717723
718724instance (Constructor c, GFromJSON a, ConsFromJSON a) => FromPair (C1 c a) where
719725 parsePair opts (tag, value)
@@ -722,7 +728,6 @@ instance (Constructor c, GFromJSON a, ConsFromJSON a) => FromPair (C1 c a) where
722728 where
723729 tag' = pack $ constructorTagModifier opts $
724730 conName (undefined :: t c a p)
725− {-# INLINE parsePair #-}
726731
727732--------------------------------------------------------------------------------
728733
@@ -734,7 +739,7 @@ class IsRecord (f :: * -> *) isRecord | f -> isRecord
734739instance (IsRecord f isRecord) => IsRecord (f :*: g) isRecord
735740 where isUnary = const False
736741#if MIN_VERSION_base(4,9,0)
737−instance OVERLAPPING_ IsRecord (M1 S (MetaSel Nothing u ss ds) f) False
742+instance OVERLAPPING_ IsRecord (M1 S ('MetaSel 'Nothing u ss ds) f) False
738743#else
739744instance OVERLAPPING_ IsRecord (M1 S NoSelector f) False
740745#endif