empty contentsFieldName means use tag value as content field name

Author: wi11dey

src/Data/Aeson/TH.hs

@@ -407,11 +407,11 @@ sumToValue letInsert target opts multiCons nullary conName value pairs
         case sumEncoding opts of
           TwoElemArray ->
             array target [conStr target opts conName, value]
-          TaggedObject{tagFieldName, contentsFieldName, tagAsContentsFieldName} ->
+          TaggedObject{tagFieldName, contentsFieldName} ->
             -- TODO: Maybe throw an error in case
             -- tagFieldName overwrites a field in pairs.
             let tag = pairE letInsert target tagFieldName (conStr target opts conName)
-                contentsFieldName' = if tagAsContentsFieldName
+                contentsFieldName' = if null contentsFieldName
                                      then conString opts conName
                                      else contentsFieldName
                 content = pairs contentsFieldName'
@@ -718,8 +718,8 @@ consFromJSON jc tName opts instTys cons = do
 
     mixedMatches tvMap =
         case sumEncoding opts of
-          TaggedObject {tagFieldName, contentsFieldName, tagAsContentsFieldName} ->
-            parseObject $ parseTaggedObject tvMap tagFieldName contentsFieldName tagAsContentsFieldName
+          TaggedObject {tagFieldName, contentsFieldName} ->
+            parseObject $ parseTaggedObject tvMap tagFieldName contentsFieldName
           UntaggedValue -> error "UntaggedValue: Should be handled already"
           ObjectWithSingleField ->
             parseObject $ parseObjectWithSingleField tvMap
@@ -761,7 +761,7 @@ consFromJSON jc tName opts instTys cons = do
                    []
         ]
 
-    parseTaggedObject tvMap typFieldName valFieldName tagAsContentsFieldName obj = do
+    parseTaggedObject tvMap typFieldName valFieldName obj = do
       conKey <- newName "conKeyX"
       valField <- newName "valField"
       doE [ bindS (varP conKey)
@@ -770,7 +770,7 @@ consFromJSON jc tName opts instTys cons = do
                             ([|Key.fromString|] `appE` stringE typFieldName))
           , letS [ valD (varP valField)
                         ( normalB
-                          $ if tagAsContentsFieldName
+                          $ if null valFieldName
                             then varE conKey
                             else litE $ stringL valFieldName
                         )

src/Data/Aeson/Types/FromJSON.hs

@@ -1209,7 +1209,7 @@ parseNonAllNullarySum p@(tname :* opts :* _) =
       TaggedObject{..} ->
           withObject tname $ \obj -> do
               tag <- contextType tname . contextTag tagKey cnames_ $ obj .: tagKey
-              let contentsFieldName' = if tagAsContentsFieldName
+              let contentsFieldName' = if null contentsFieldName
                                        then unpack tag
                                        else contentsFieldName
               fromMaybe (badTag tag <?> Key tagKey) $

src/Data/Aeson/Types/Internal.hs

@@ -761,9 +761,8 @@ instance Show Options where
 
 -- | Specifies how to encode constructors of a sum datatype.
 data SumEncoding =
-    TaggedObject { tagFieldName           :: String
-                 , contentsFieldName      :: String
-                 , tagAsContentsFieldName :: Bool
+    TaggedObject { tagFieldName      :: String
+                 , contentsFieldName :: String
                  }
     -- ^ A constructor will be encoded to an object with a field
     -- 'tagFieldName' which specifies the constructor tag (modified by
@@ -775,7 +774,7 @@ data SumEncoding =
     -- record the encoded constructor contents will be stored under
     -- the 'contentsFieldName' field.
     --
-    -- If 'tagAsContentsFieldName' is True, then the value of
+    -- If 'contentsFieldName' is the empty string, then the value of
     -- 'tagFieldName' will be used as the 'contentsFieldName' instead.
   | UntaggedValue
     -- ^ Constructor names won't be encoded. Instead only the contents of the
@@ -868,9 +867,8 @@ defaultOptions = Options
 -- @
 defaultTaggedObject :: SumEncoding
 defaultTaggedObject = TaggedObject
-                      { tagFieldName           = "tag"
-                      , contentsFieldName      = "contents"
-                      , tagAsContentsFieldName = False
+                      { tagFieldName      = "tag"
+                      , contentsFieldName = "contents"
                       }
 
 -- | Default 'JSONKeyOptions':

src/Data/Aeson/Types/ToJSON.hs

@@ -961,7 +961,7 @@ nonAllNullarySumToJSON opts targs =
     case sumEncoding opts of
 
       TaggedObject{..}      ->
-        taggedObject opts targs (Key.fromString tagFieldName) (Key.fromString contentsFieldName) tagAsContentsFieldName
+        taggedObject opts targs (Key.fromString tagFieldName) (Key.fromString contentsFieldName)
 
       ObjectWithSingleField ->
         (unTagged :: Tagged ObjectWithSingleField enc -> enc)
@@ -984,17 +984,17 @@ nonAllNullarySumToJSON opts targs =
 
 class TaggedObject enc arity f where
     taggedObject :: Options -> ToArgs enc arity a
-                 -> Key -> Key -> Bool
+                 -> Key -> Key
                  -> f a -> enc
 
 instance ( TaggedObject enc arity a
          , TaggedObject enc arity b
          ) => TaggedObject enc arity (a :+: b)
   where
-    taggedObject opts targs tagFieldName contentsFieldName tagAsContentsFieldName (L1 x) =
-        taggedObject opts targs tagFieldName contentsFieldName tagAsContentsFieldName x
-    taggedObject opts targs tagFieldName contentsFieldName tagAsContentsFieldName (R1 x) =
-        taggedObject opts targs tagFieldName contentsFieldName tagAsContentsFieldName x
+    taggedObject opts targs tagFieldName contentsFieldName (L1 x) =
+        taggedObject opts targs tagFieldName contentsFieldName x
+    taggedObject opts targs tagFieldName contentsFieldName (R1 x) =
+        taggedObject opts targs tagFieldName contentsFieldName x
     {-# INLINE taggedObject #-}
 
 instance ( IsRecord                      a isRecord
@@ -1005,14 +1005,14 @@ instance ( IsRecord                      a isRecord
          , Constructor c
          ) => TaggedObject enc arity (C1 c a)
   where
-    taggedObject opts targs tagFieldName contentsFieldName tagAsContentsFieldName =
+    taggedObject opts targs tagFieldName contentsFieldName =
       fromPairs . mappend tag . contents
       where
         constructorTagString = constructorTagModifier opts (conName (undefined :: t c a p))
         tag = tagFieldName `pair` (fromString constructorTagString :: enc)
-        contentsFieldName' = if tagAsContentsFieldName
-          then Key.fromString constructorTagString
-          else contentsFieldName
+        contentsFieldName' = if null $ Key.toString contentsFieldName
+                             then Key.fromString constructorTagString
+                             else contentsFieldName
         contents =
           (unTagged :: Tagged isRecord pairs -> pairs) .
             taggedObject' opts targs contentsFieldName' . unM1

tests/UnitTests.hs

@@ -280,7 +280,7 @@ showOptions =
         ++ ", allNullaryToStringTag = True"
         ++ ", omitNothingFields = False"
         ++ ", allowOmittedFields = True"
-        ++ ", sumEncoding = TaggedObject {tagFieldName = \"tag\", contentsFieldName = \"contents\", tagAsContentsFieldName = False}"
+        ++ ", sumEncoding = TaggedObject {tagFieldName = \"tag\", contentsFieldName = \"contents\"}"
         ++ ", unwrapUnaryRecords = False"
         ++ ", tagSingleConstructors = False"
         ++ ", rejectUnknownFields = False"