@@ -88,67 +88,67 @@ class SumToJSON f allNullary where
8888 sumToJSON :: Options -> f a -> Tagged allNullary Value
8989
9090instance ( GetConName f
91− , ObjectWithType f
91+ , TaggedObject f
9292 , ObjectWithSingleField f
9393 , TwoElemArray f ) => SumToJSON f True where
9494 sumToJSON opts
9595 | nullaryToString opts = Tagged . String . pack
96− . constructorNameModifier opts . getConName
96+ . constructorTagModifier opts . getConName
9797 | otherwise = Tagged . nonAllNullarySumToJSON opts
9898 {-# INLINE sumToJSON #-}
9999
100100instance ( TwoElemArray f
101− , ObjectWithType f
101+ , TaggedObject f
102102 , ObjectWithSingleField f ) => SumToJSON f False where
103103 sumToJSON opts = Tagged . nonAllNullarySumToJSON opts
104104 {-# INLINE sumToJSON #-}
105105
106106nonAllNullarySumToJSON :: ( TwoElemArray f
107− , ObjectWithType f
107+ , TaggedObject f
108108 , ObjectWithSingleField f
109109 ) => Options -> f a -> Value
110110nonAllNullarySumToJSON opts =
111111 case sumEncoding opts of
112− ObjectWithType{..} -> object . objectWithType opts typeFieldName
113− contentsFieldName
112+ TaggedObject{..} -> object . taggedObject opts tagFieldName
113+ contentsFieldName
114114 ObjectWithSingleField -> Object . objectWithSingleField opts
115115 TwoElemArray -> Array . twoElemArray opts
116116{-# INLINE nonAllNullarySumToJSON #-}
117117
118118--------------------------------------------------------------------------------
119119
120−class ObjectWithType f where
121− objectWithType :: Options -> String -> String -> f a -> [Pair]
122−
123−instance ( ObjectWithType a
124− , ObjectWithType b ) => ObjectWithType (a :+: b) where
125− objectWithType opts typeFieldName contentsFieldName (L1 x) =
126− objectWithType opts typeFieldName contentsFieldName x
127− objectWithType opts typeFieldName contentsFieldName (R1 x) =
128− objectWithType opts typeFieldName contentsFieldName x
129− {-# INLINE objectWithType #-}
130−
131−instance ( IsRecord a isRecord
132− , ObjectWithType' a isRecord
133− , Constructor c ) => ObjectWithType (C1 c a) where
134− objectWithType opts typeFieldName contentsFieldName =
135− (pack typeFieldName .= constructorNameModifier opts
120+class TaggedObject f where
121+ taggedObject :: Options -> String -> String -> f a -> [Pair]
122+
123+instance ( TaggedObject a
124+ , TaggedObject b ) => TaggedObject (a :+: b) where
125+ taggedObject opts tagFieldName contentsFieldName (L1 x) =
126+ taggedObject opts tagFieldName contentsFieldName x
127+ taggedObject opts tagFieldName contentsFieldName (R1 x) =
128+ taggedObject opts tagFieldName contentsFieldName x
129+ {-# INLINE taggedObject #-}
130+
131+instance ( IsRecord a isRecord
132+ , TaggedObject' a isRecord
133+ , Constructor c ) => TaggedObject (C1 c a) where
134+ taggedObject opts tagFieldName contentsFieldName =
135+ (pack tagFieldName .= constructorTagModifier opts
136136 (conName (undefined :: t c a p)) :) .
137137 (unTagged :: Tagged isRecord [Pair] -> [Pair]) .
138− objectWithType' opts contentsFieldName . unM1
139− {-# INLINE objectWithType #-}
138+ taggedObject' opts contentsFieldName . unM1
139+ {-# INLINE taggedObject #-}
140140
141−class ObjectWithType' f isRecord where
142− objectWithType' :: Options -> String -> f a -> Tagged isRecord [Pair]
141+class TaggedObject' f isRecord where
142+ taggedObject' :: Options -> String -> f a -> Tagged isRecord [Pair]
143143
144−instance (RecordToPairs f) => ObjectWithType' f True where
145− objectWithType' opts _ = Tagged . toList . recordToPairs opts
146− {-# INLINE objectWithType' #-}
144+instance (RecordToPairs f) => TaggedObject' f True where
145+ taggedObject' opts _ = Tagged . toList . recordToPairs opts
146+ {-# INLINE taggedObject' #-}
147147
148−instance (GToJSON f) => ObjectWithType' f False where
149− objectWithType' opts contentsFieldName =
148+instance (GToJSON f) => TaggedObject' f False where
149+ taggedObject' opts contentsFieldName =
150150 Tagged . (:[]) . (pack contentsFieldName .=) . gToJSON opts
151− {-# INLINE objectWithType' #-}
151+ {-# INLINE taggedObject' #-}
152152
153153--------------------------------------------------------------------------------
154154
@@ -179,7 +179,7 @@ instance ( GToJSON a, ConsToJSON a
179179 , Constructor c ) => TwoElemArray (C1 c a) where
180180 twoElemArray opts x = V.create $ do
181181 mv <- VM.unsafeNew 2
182− VM.unsafeWrite mv 0 $ String $ pack $ constructorNameModifier opts
182+ VM.unsafeWrite mv 0 $ String $ pack $ constructorTagModifier opts
183183 $ conName (undefined :: t c a p)
184184 VM.unsafeWrite mv 1 $ gToJSON opts x
185185 return mv
@@ -277,7 +277,7 @@ instance ( GToJSON a, ConsToJSON a
277277 , Constructor c ) => ObjectWithSingleField (C1 c a) where
278278 objectWithSingleField opts = H.singleton typ . gToJSON opts
279279 where
280− typ = pack $ constructorNameModifier opts $
280+ typ = pack $ constructorTagModifier opts $
281281 conName (undefined :: t c a p)
282282 {-# INLINE objectWithSingleField #-}
283283
@@ -339,16 +339,16 @@ instance ( AllNullary (a :+: b) allNullary
339339class ParseSum f allNullary where
340340 parseSum :: Options -> Value -> Tagged allNullary (Parser (f a))
341341
342−instance ( SumFromString (a :+: b)
343− , FromPair (a :+: b)
344− , FromObjectWithType (a :+: b) ) => ParseSum (a :+: b) True where
342+instance ( SumFromString (a :+: b)
343+ , FromPair (a :+: b)
344+ , FromTaggedObject (a :+: b) ) => ParseSum (a :+: b) True where
345345 parseSum opts
346346 | nullaryToString opts = Tagged . parseAllNullarySum opts
347347 | otherwise = Tagged . parseNonAllNullarySum opts
348348 {-# INLINE parseSum #-}
349349
350−instance ( FromPair (a :+: b)
351− , FromObjectWithType (a :+: b) ) => ParseSum (a :+: b) False where
350+instance ( FromPair (a :+: b)
351+ , FromTaggedObject (a :+: b) ) => ParseSum (a :+: b) False where
352352 parseSum opts = Tagged . parseNonAllNullarySum opts
353353 {-# INLINE parseSum #-}
354354
@@ -372,89 +372,89 @@ instance (Constructor c) => SumFromString (C1 c U1) where
372372 parseSumFromString opts key | key == name = Just $ M1 U1
373373 | otherwise = Nothing
374374 where
375− name = pack $ constructorNameModifier opts $
375+ name = pack $ constructorTagModifier opts $
376376 conName (undefined :: t c U1 p)
377377 {-# INLINE parseSumFromString #-}
378378
379379--------------------------------------------------------------------------------
380380
381381parseNonAllNullarySum :: ( FromPair (a :+: b)
382− , FromObjectWithType (a :+: b)
382+ , FromTaggedObject (a :+: b)
383383 ) => Options -> Value -> Parser ((a :+: b) c)
384384parseNonAllNullarySum opts =
385385 case sumEncoding opts of
386− ObjectWithType{..} ->
386+ TaggedObject{..} ->
387387 withObject "Object" $ \obj -> do
388− key <- obj .: pack typeFieldName
389− fromMaybe (notFound $ unpack key) $
390− parseFromObjectWithType opts contentsFieldName obj key
388+ tag <- obj .: pack tagFieldName
389+ fromMaybe (notFound $ unpack tag) $
390+ parseFromTaggedObject opts contentsFieldName obj tag
391391
392392 ObjectWithSingleField ->
393393 withObject "Object" $ \obj ->
394394 case H.toList obj of
395− [keyVal@(key, _)] -> fromMaybe (notFound $ unpack key) $
396− parsePair opts keyVal
395+ [pair@(tag, _)] -> fromMaybe (notFound $ unpack tag) $
396+ parsePair opts pair
397397 _ -> fail "Object doesn't have a single field"
398398
399399 TwoElemArray ->
400400 withArray "Array" $ \arr ->
401401 if V.length arr == 2
402402 then case V.unsafeIndex arr 0 of
403− String key -> fromMaybe (notFound $ unpack key) $
404− parsePair opts (key, V.unsafeIndex arr 1)
403+ String tag -> fromMaybe (notFound $ unpack tag) $
404+ parsePair opts (tag, V.unsafeIndex arr 1)
405405 _ -> fail "First element is not a String"
406406 else fail "Array doesn't have 2 elements"
407407{-# INLINE parseNonAllNullarySum #-}
408408
409409--------------------------------------------------------------------------------
410410
411−class FromObjectWithType f where
412− parseFromObjectWithType :: Options -> String -> Object -> Text
413− -> Maybe (Parser (f a))
414−
415−instance (FromObjectWithType a, FromObjectWithType b) =>
416− FromObjectWithType (a :+: b) where
417− parseFromObjectWithType opts contentsFieldName obj key =
418− (fmap L1 <$> parseFromObjectWithType opts contentsFieldName obj key) <|>
419− (fmap R1 <$> parseFromObjectWithType opts contentsFieldName obj key)
420− {-# INLINE parseFromObjectWithType #-}
421−
422−instance ( FromObjectWithType' f
423− , Constructor c ) => FromObjectWithType (C1 c f) where
424− parseFromObjectWithType opts contentsFieldName obj key
425− | key == name = Just $ M1 <$> parseFromObjectWithType'
411+class FromTaggedObject f where
412+ parseFromTaggedObject :: Options -> String -> Object -> Text
413+ -> Maybe (Parser (f a))
414+
415+instance (FromTaggedObject a, FromTaggedObject b) =>
416+ FromTaggedObject (a :+: b) where
417+ parseFromTaggedObject opts contentsFieldName obj tag =
418+ (fmap L1 <$> parseFromTaggedObject opts contentsFieldName obj tag) <|>
419+ (fmap R1 <$> parseFromTaggedObject opts contentsFieldName obj tag)
420+ {-# INLINE parseFromTaggedObject #-}
421+
422+instance ( FromTaggedObject' f
423+ , Constructor c ) => FromTaggedObject (C1 c f) where
424+ parseFromTaggedObject opts contentsFieldName obj tag
425+ | tag == name = Just $ M1 <$> parseFromTaggedObject'
426426 opts contentsFieldName obj
427427 | otherwise = Nothing
428428 where
429− name = pack $ constructorNameModifier opts $
429+ name = pack $ constructorTagModifier opts $
430430 conName (undefined :: t c f p)
431− {-# INLINE parseFromObjectWithType #-}
431+ {-# INLINE parseFromTaggedObject #-}
432432
433433--------------------------------------------------------------------------------
434434
435−class FromObjectWithType' f where
436− parseFromObjectWithType' :: Options -> String -> Object -> Parser (f a)
435+class FromTaggedObject' f where
436+ parseFromTaggedObject' :: Options -> String -> Object -> Parser (f a)
437437
438−class FromObjectWithType'' f isRecord where
439− parseFromObjectWithType'' :: Options -> String -> Object
440− -> Tagged isRecord (Parser (f a))
438+class FromTaggedObject'' f isRecord where
439+ parseFromTaggedObject'' :: Options -> String -> Object
440+ -> Tagged isRecord (Parser (f a))
441441
442−instance ( IsRecord f isRecord
443− , FromObjectWithType'' f isRecord
444− ) => FromObjectWithType' f where
445− parseFromObjectWithType' opts contentsFieldName =
442+instance ( IsRecord f isRecord
443+ , FromTaggedObject'' f isRecord
444+ ) => FromTaggedObject' f where
445+ parseFromTaggedObject' opts contentsFieldName =
446446 (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a)) .
447− parseFromObjectWithType'' opts contentsFieldName
448− {-# INLINE parseFromObjectWithType' #-}
447+ parseFromTaggedObject'' opts contentsFieldName
448+ {-# INLINE parseFromTaggedObject' #-}
449449
450−instance (FromRecord f) => FromObjectWithType'' f True where
451− parseFromObjectWithType'' opts _ = Tagged . parseRecord opts
452− {-# INLINE parseFromObjectWithType'' #-}
450+instance (FromRecord f) => FromTaggedObject'' f True where
451+ parseFromTaggedObject'' opts _ = Tagged . parseRecord opts
452+ {-# INLINE parseFromTaggedObject'' #-}
453453
454−instance (GFromJSON f) => FromObjectWithType'' f False where
455− parseFromObjectWithType'' opts contentsFieldName = Tagged .
454+instance (GFromJSON f) => FromTaggedObject'' f False where
455+ parseFromTaggedObject'' opts contentsFieldName = Tagged .
456456 (gParseJSON opts <=< (.: pack contentsFieldName))
457− {-# INLINE parseFromObjectWithType'' #-}
457+ {-# INLINE parseFromTaggedObject'' #-}
458458
459459--------------------------------------------------------------------------------
460460
@@ -546,16 +546,16 @@ class FromPair f where
546546 parsePair :: Options -> Pair -> Maybe (Parser (f a))
547547
548548instance (FromPair a, FromPair b) => FromPair (a :+: b) where
549− parsePair opts keyVal = (fmap L1 <$> parsePair opts keyVal) <|>
550− (fmap R1 <$> parsePair opts keyVal)
549+ parsePair opts pair = (fmap L1 <$> parsePair opts pair) <|>
550+ (fmap R1 <$> parsePair opts pair)
551551 {-# INLINE parsePair #-}
552552
553553instance (Constructor c, GFromJSON a, ConsFromJSON a) => FromPair (C1 c a) where
554− parsePair opts (key, value)
555− | key == name = Just $ gParseJSON opts value
554+ parsePair opts (tag, value)
555+ | tag == tag' = Just $ gParseJSON opts value
556556 | otherwise = Nothing
557557 where
558− name = pack $ constructorNameModifier opts $
558+ tag' = pack $ constructorTagModifier opts $
559559 conName (undefined :: t c a p)
560560 {-# INLINE parsePair #-}
561561