diff --git a/flake.nix b/flake.nix new file mode 100644 index 000000000..6f92fda56 --- /dev/null +++ b/flake.nix @@ -0,0 +1,31 @@ +{ + inputs.nixpkgs.url = github:NixOS/nixpkgs/nixos-unstable; + inputs.flake-utils.url = github:poscat0x04/flake-utils; + + outputs = { self, nixpkgs, flake-utils, ... }: with flake-utils; + eachDefaultSystem ( + system: + let + pkgs = import nixpkgs { inherit system; overlays = [ self.overlay ]; }; + in + with pkgs; + { + devShell = aeson-dev.envFunc { withHoogle = true; }; + defaultPackage = aeson; + } + ) // { + overlay = self: super: + let + hpkgs = super.haskellPackages; + aeson = hpkgs.callCabal2nix "aeson" ./. {}; + in + with super; with haskell.lib; + { + inherit aeson; + aeson-dev = addBuildTools aeson [ + haskell-language-server + cabal-install + ]; + }; + }; +} diff --git a/src/Data/Aeson/TH.hs b/src/Data/Aeson/TH.hs index 3dd63521b..775b48020 100644 --- a/src/Data/Aeson/TH.hs +++ b/src/Data/Aeson/TH.hs @@ -421,6 +421,7 @@ sumToValue target opts multiCons nullary conName value pairs content = pairs contentsFieldName in fromPairsE $ if nullary then tag else infixApp tag [|(Monoid.<>)|] content + TaggedFlatObject {} -> error "TaggedFlatObject: Should be handled already" ObjectWithSingleField -> objectE [(conString opts conName, value)] UntaggedValue | nullary -> conStr target opts conName @@ -434,7 +435,21 @@ argsToValue :: ToJSONFun -> JSONClass -> TyVarMap -> Options -> Bool -> Construc argsToValue target jc tvMap opts multiCons ConstructorInfo { constructorName = conName , constructorVariant = NormalConstructor - , constructorFields = argTys } = do + , constructorFields = argTys } + | TaggedFlatObject{tagFieldName} <- sumEncoding opts + , multiCons = do + let tag = (tagFieldName, conStr target opts conName) + argTys' <- mapM resolveTypeSynonyms argTys + let len = length argTys' + args <- newNameList "arg" len + let os = zipWith (\arg argTy -> dispatchToJSON target jc conName tvMap argTy `appE` varE arg) args argTys' + pairs = zip (fmap (show :: Int -> String) [0..]) os + obj = objectE (tag : pairs) + match (conP conName $ map varP args) + (normalB obj) + [] + | otherwise = + do argTys' <- mapM resolveTypeSynonyms argTys let len = length argTys' args <- newNameList "arg" len @@ -491,14 +506,33 @@ argsToValue target jc tvMap opts multiCons else e arg match (conP conName $ map varP args) - (normalB $ recordSumToValue target opts multiCons (null argTys) conName pairs) + (normalB $ case () of + () + | TaggedFlatObject {tagFieldName} <- sumEncoding opts -> do + let tag = pairE tagFieldName (conStr target opts conName) + fromPairsE $ infixApp tag [|(Monoid.<>)|] pairs + | otherwise -> recordSumToValue target opts multiCons (null argTys) conName pairs) [] -- Infix constructors. argsToValue target jc tvMap opts multiCons ConstructorInfo { constructorName = conName , constructorVariant = InfixConstructor - , constructorFields = argTys } = do + , constructorFields = argTys } + | TaggedFlatObject {tagFieldName} <- sumEncoding opts + , multiCons = do + [alTy, arTy] <- mapM resolveTypeSynonyms argTys + al <- newName "argL" + ar <- newName "argR" + let tag = (tagFieldName, conStr target opts conName) + os = zipWith (\arg argTy -> dispatchToJSON target jc conName tvMap argTy `appE` varE arg) [al, ar] [alTy, arTy] + pairs = zip (fmap (show :: Int -> String) [0..]) os + obj = objectE (tag : pairs) + match (infixP (varP al) conName (varP ar)) + (normalB obj) + [] + | otherwise = + do [alTy, arTy] <- mapM resolveTypeSynonyms argTys al <- newName "argL" ar <- newName "argR" @@ -729,6 +763,8 @@ consFromJSON jc tName opts instTys cons = do case sumEncoding opts of TaggedObject {tagFieldName, contentsFieldName} -> parseObject $ parseTaggedObject tvMap tagFieldName contentsFieldName + TaggedFlatObject {tagFieldName} -> + parseObject $ parseTaggedFlatObject tvMap tagFieldName UntaggedValue -> error "UntaggedValue: Should be handled already" ObjectWithSingleField -> parseObject $ parseObjectWithSingleField tvMap @@ -779,6 +815,88 @@ consFromJSON jc tName opts instTys cons = do , noBindS $ parseContents tvMap conKey (Left (valFieldName, obj)) 'conNotFoundFailTaggedObject ] + parseTaggedFlatObject tvMap tagFieldName obj = do + conKey <- newName "conKey" + doE [ bindS (varP conKey) + (infixApp (varE obj) [|(.:)|] ([|T.pack|] `appE` stringE tagFieldName)) + , noBindS $ + caseE (varE conKey) + [ match wildP + ( guardedB $ + [ do g <- normalG $ infixApp (varE conKey) + [|(==)|] + ([|T.pack|] `appE` + conNameExp opts con) + argTys <- mapM resolveTypeSynonyms (constructorFields con) + let conName = constructorName con + e <- case constructorVariant con of + RecordConstructor fields -> + parseRecord jc tvMap argTys opts tName conName fields obj False + _ -> + parseNumRec tvMap argTys conName obj + return (g, e) + | con <- cons + ] + ++ + [ liftM2 (,) + (normalG [e|otherwise|]) + ( varE 'conNotFoundFailTaggedObject + `appE` litE (stringL $ show tName) + `appE` listE (map ( litE + . stringL + . constructorTagModifier opts + . nameBase + . constructorName + ) cons + ) + `appE` ([|T.unpack|] `appE` varE conKey) + ) + ] + ) + [] + ] + ] + + parseNumRec :: TyVarMap + -> [Type] + -> Name + -> Name + -> ExpQ + parseNumRec tvMap argTys conName obj = + (if rejectUnknownFields opts + then infixApp checkUnknownRecords [|(>>)|] + else id) $ + if null argTys + then [|pure|] `appE` conE conName + else + foldl' (\a b -> infixApp a [|(<*>)|] b) + (infixApp (conE conName) [|(<$>)|] x) + xs + where + fields = map (show :: Int -> String) $ take (length argTys) [0..] + knownFields = appE [|H.fromList|] $ listE $ + map (\knownName -> tupE [appE [|T.pack|] $ litE $ stringL knownName, [|()|]]) fields + checkUnknownRecords = + caseE (appE [|H.keys|] $ infixApp (varE obj) [|H.difference|] knownFields) + [ match (listP []) (normalB [|return ()|]) [] + , newName "unknownFields" >>= + \unknownFields -> match (varP unknownFields) + (normalB $ appE [|fail|] $ infixApp + (litE (stringL "Unknown fields: ")) + [|(++)|] + (appE [|show|] (varE unknownFields))) + [] + ] + x:xs = [ [|lookupField|] + `appE` dispatchParseJSON jc conName tvMap argTy + `appE` litE (stringL $ show tName) + `appE` litE (stringL $ constructorTagModifier opts $ nameBase conName) + `appE` varE obj + `appE` ( [|T.pack|] `appE` stringE field + ) + | (field, argTy) <- zip fields argTys + ] + parseUntaggedValue tvMap cons' conVal = foldr1 (\e e' -> infixApp e [|(<|>)|] e') (map (\x -> parseValue tvMap x conVal) cons') diff --git a/src/Data/Aeson/Types/FromJSON.hs b/src/Data/Aeson/Types/FromJSON.hs index cd39ac3e9..1629fdad0 100644 --- a/src/Data/Aeson/Types/FromJSON.hs +++ b/src/Data/Aeson/Types/FromJSON.hs @@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} @@ -158,6 +159,7 @@ import qualified Data.Primitive.Types as PM import qualified Data.Primitive.PrimArray as PM import Data.Coerce (Coercible, coerce) +import GHC.TypeLits parseIndexedJSON :: (Value -> Parser a) -> Int -> Value -> Parser a parseIndexedJSON p idx value = p value <?> Index idx @@ -1010,6 +1012,7 @@ instance ( ConstructorNames f , FromPair arity f , FromTaggedObject arity f , FromUntaggedValue arity f + , FromTaggedFlatObject arity f ) => ParseSum arity f True where parseSum p@(tname :* opts :* _) | allNullaryToStringTag opts = Tagged . parseAllNullarySum tname opts @@ -1019,6 +1022,7 @@ instance ( ConstructorNames f , FromPair arity f , FromTaggedObject arity f , FromUntaggedValue arity f + , FromTaggedFlatObject arity f ) => ParseSum arity f False where parseSum p = Tagged . parseNonAllNullarySum p @@ -1101,6 +1105,7 @@ parseNonAllNullarySum :: forall f c arity. ( FromPair arity f , FromTaggedObject arity f , FromUntaggedValue arity f + , FromTaggedFlatObject arity f , ConstructorNames f ) => TypeName :* Options :* FromArgs arity c -> Value -> Parser (f c) @@ -1118,6 +1123,17 @@ parseNonAllNullarySum p@(tname :* opts :* _) = ", but found tag " ++ show tag cnames_ = unTagged2 (constructorTags (constructorTagModifier opts) :: Tagged2 f [String]) + TaggedFlatObject{..} -> + withObject tname $ \obj -> do + let tagKey = pack tagFieldName + badTag tag = failWith_ $ \cnames -> + "expected tag field to be one of " ++ show cnames ++ + ", but found tag " ++ show tag + cnames_ = unTagged2 (constructorTags (constructorTagModifier opts) :: Tagged2 f [String]) + tag <- contextType tname . contextTag tagKey cnames_ $ obj .: tagKey + fromMaybe (badTag tag <?> Key tagKey) $ + parseTaggedFlatObject (tag :* p) obj + ObjectWithSingleField -> withObject tname $ \obj -> case H.toList obj of [(tag, v)] -> maybe (badTag tag) (<?> Key tag) $ @@ -1401,6 +1417,66 @@ instance ( Constructor c -------------------------------------------------------------------------------- +class FromTaggedFlatObject arity f where + parseTaggedFlatObject :: Text :* TypeName :* Options :* FromArgs arity a + -> Object + -> Maybe (Parser (f a)) + +instance ( FromTaggedFlatObject arity f + , FromTaggedFlatObject arity g + ) => FromTaggedFlatObject arity (f :+: g) where + parseTaggedFlatObject p obj = + (fmap L1 <$> parseTaggedFlatObject p obj) <|> + (fmap R1 <$> parseTaggedFlatObject p obj) + +instance ( IsRecord f isRecord + , FromTaggedFlatObject' arity f isRecord + , Constructor c + ) => FromTaggedFlatObject arity (C1 c f) where + parseTaggedFlatObject :: Text :* TypeName :* Options :* FromArgs arity a + -> Object + -> Maybe (Parser (C1 c f a)) + parseTaggedFlatObject (tag :* p@(_ :* opts :* _)) obj + | tag == tag' = Just $ fmap M1 $ (unTagged :: Tagged isRecord (Parser (f a)) -> Parser (f a)) $ parseTaggedFlatObject' (cname :* p) obj + | otherwise = Nothing + where + tag' = pack $ constructorTagModifier opts cname + cname = conName (undefined :: M1 i c f p) + +class FromTaggedFlatObject' arity f isRecord where + parseTaggedFlatObject' :: ConName :* TypeName :* Options :* FromArgs arity a + -> Object + -> Tagged isRecord (Parser (f a)) + +instance (RecordFromJSON arity f, FieldNames f) => FromTaggedFlatObject' arity f True where + parseTaggedFlatObject' p = Tagged . recordParseJSON (True :* p) + +instance FromTaggedFlatObject' arity U1 False where + parseTaggedFlatObject' _ _ = Tagged (pure U1) + +instance OVERLAPPABLE_ PositionFromObject 0 arity f => FromTaggedFlatObject' arity f False where + parseTaggedFlatObject' (_ :* p) obj = Tagged (positionFromObject (Proxy :: Proxy 0) p obj) + +class KnownNat n => PositionFromObject n arity f where + positionFromObject :: Proxy n + -> TypeName :* Options :* FromArgs arity a + -> Object + -> Parser (f a) + +instance (KnownNat n, GFromJSON arity a) => PositionFromObject n arity (S1 m a) where + positionFromObject _ (_ :* opts :* fargs) obj = + explicitParseField (gParseJSON opts fargs) obj $ pack $ show $ natVal (Proxy :: Proxy n) + +instance ( PositionFromObject n arity f + , PositionFromObject (n+1) arity g + ) => PositionFromObject n arity (f :*: g) where + positionFromObject _ p obj = + (:*:) + <$> positionFromObject (Proxy :: Proxy n) p obj + <*> positionFromObject (Proxy :: Proxy (n+1)) p obj + +-------------------------------------------------------------------------------- + class FromUntaggedValue arity f where parseUntaggedValue :: TypeName :* Options :* FromArgs arity a -> Value diff --git a/src/Data/Aeson/Types/Internal.hs b/src/Data/Aeson/Types/Internal.hs index ac92f987b..e9363ebc3 100644 --- a/src/Data/Aeson/Types/Internal.hs +++ b/src/Data/Aeson/Types/Internal.hs @@ -682,6 +682,39 @@ data SumEncoding = -- by the encoded value of that field! If the constructor is not a -- record the encoded constructor contents will be stored under -- the 'contentsFieldName' field. + | TaggedFlatObject { tagFieldName :: String } + -- ^ Conceptually, this option will allow data types to be encoded to an object + -- with an additional field 'tagFieldName' which specifies the constructor tag. + -- This option differs from 'TaggedObject' in that the fields are encoded + -- in the same object as the tag, instead of in another object under the + -- field @contentsFieldName@. + -- + -- The detailed behavior is as follows: + -- + -- 1. If the data type has only a single constructor and has field names + -- (a record), it will be encoded as an object without any additional fields. + -- For example, given @A@ defined as + -- @data A = A {field1 :: Int, field2 :: Int}@, + -- this option will encode @A 1 2@ as @{"field1": 1, "field2": 2}@ + -- 2. If the data type has only a single constructor but does not have any fields, + -- it will be encoded as an array. + -- For example, given @A@ defined as + -- @data A = A Int Int@, + -- this option will encode @A 1 2@ as @[1, 2]@ + -- 3. If the data type has multiple constructors and the constructor has field names, + -- it will be encoded as an object with an additional field '$tagFieldName'. + -- For example, given @A@ defined as + -- @data A = A {field1 :: Int, field2 :: Int} | B@, + -- this option will encode @A 1 2@ as @{"field1": 1, "field2": 2, "$tagFieldName": \"A"}@ + -- 4. If the data type has multiple constructors and the constructor does not have + -- any feild names, it will be encoded as an object whose keys are the position of the value + -- in that data type with an additional field '$tagFieldName'. + -- For example, given @A@ defined as + -- @data A = A Int Int | B@, + -- this option will encode @A 1 2@ as @{"0": 1, "1": 2, "$tagFieldName": \"A"}@ + -- 5. The behavior is undefined when the '$tagFieldName' collides with another field name and should + -- not be relied upon. It may or may not overwite the field. + -- It may or may not throw an runtime exception. It may or may not raise an compile time error. | UntaggedValue -- ^ Constructor names won't be encoded. Instead only the contents of the -- constructor will be encoded as if the type had a single constructor. JSON diff --git a/src/Data/Aeson/Types/ToJSON.hs b/src/Data/Aeson/Types/ToJSON.hs index 5908e70ed..bc19c363b 100644 --- a/src/Data/Aeson/Types/ToJSON.hs +++ b/src/Data/Aeson/Types/ToJSON.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE EmptyDataDecls #-} @@ -141,6 +142,7 @@ import qualified Data.Primitive.Array as PM import qualified Data.Primitive.SmallArray as PM import qualified Data.Primitive.Types as PM import qualified Data.Primitive.PrimArray as PM +import GHC.TypeLits toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b) @@ -851,6 +853,7 @@ class SumToJSON enc arity f allNullary where instance ( GetConName f , FromString enc , TaggedObject enc arity f + , TaggedFlatObject enc arity f , SumToJSON' ObjectWithSingleField enc arity f , SumToJSON' TwoElemArray enc arity f , SumToJSON' UntaggedValue enc arity f @@ -862,6 +865,7 @@ instance ( GetConName f | otherwise = Tagged . nonAllNullarySumToJSON opts targs instance ( TaggedObject enc arity f + , TaggedFlatObject enc arity f , SumToJSON' ObjectWithSingleField enc arity f , SumToJSON' TwoElemArray enc arity f , SumToJSON' UntaggedValue enc arity f @@ -870,6 +874,7 @@ instance ( TaggedObject enc arity f sumToJSON opts targs = Tagged . nonAllNullarySumToJSON opts targs nonAllNullarySumToJSON :: ( TaggedObject enc arity f + , TaggedFlatObject enc arity f , SumToJSON' ObjectWithSingleField enc arity f , SumToJSON' TwoElemArray enc arity f , SumToJSON' UntaggedValue enc arity f @@ -881,6 +886,9 @@ nonAllNullarySumToJSON opts targs = TaggedObject{..} -> taggedObject opts targs tagFieldName contentsFieldName + TaggedFlatObject{..} -> + taggedFlatObject opts targs tagFieldName + ObjectWithSingleField -> (unTagged :: Tagged ObjectWithSingleField enc -> enc) . sumToJSON' opts targs @@ -906,6 +914,69 @@ instance FromString Value where -------------------------------------------------------------------------------- +class TaggedFlatObject enc arity f where + taggedFlatObject :: Options -> ToArgs enc arity a + -> String -> f a -> enc + +instance (TaggedFlatObject enc arity a + , TaggedFlatObject enc arity b + ) => TaggedFlatObject enc arity (a :+: b) + where + taggedFlatObject opts targs tagFieldName (L1 x) = + taggedFlatObject opts targs tagFieldName x + taggedFlatObject opts targs tagFieldName (R1 x) = + taggedFlatObject opts targs tagFieldName x + +instance ( IsRecord a isRecord + , TaggedFlatObject' enc pairs arity a isRecord + , KeyValuePair enc pairs + , FromString enc + , Constructor c + , FromPairs enc pairs + ) => TaggedFlatObject enc arity (C1 c a) where + taggedFlatObject opts targs tagFieldName (M1 a) = + fromPairs (tag `mappend` contents) + where + tag :: pairs + tag = tagFieldName `pair` + (fromString (constructorTagModifier opts (conName (undefined :: t c a p))) + :: enc) + contents :: pairs + contents = (unTagged :: Tagged isRecord pairs -> pairs) $ taggedFlatObject' opts targs a + +class TaggedFlatObject' enc pairs arity f isRecord where + taggedFlatObject' :: Options -> ToArgs enc arity a + -> f a -> Tagged isRecord pairs + +instance RecordToPairs pairs enc arity f => TaggedFlatObject' pairs enc arity f True where + taggedFlatObject' opts targs = Tagged . recordToPairs opts targs + +instance Monoid pairs => TaggedFlatObject' enc pairs arity U1 False where + taggedFlatObject' _ _ _ = Tagged mempty + +instance OVERLAPPABLE_ PositionToPairs 0 pairs enc arity f => TaggedFlatObject' enc pairs arity f False where + taggedFlatObject' opts targs a = Tagged $ positionToPairs (Proxy :: Proxy 0) opts targs a + +class KnownNat n => PositionToPairs n pairs enc arity f where + positionToPairs :: Proxy n -> Options -> ToArgs enc arity a -> f a -> pairs + +instance ( KeyValuePair enc pairs + , GToJSON' enc arity a + , KnownNat n + ) => PositionToPairs n pairs enc arity (S1 m a) where + positionToPairs p opts targs (M1 a) = + show (natVal p) `pair` gToJSON opts targs a + +instance ( Monoid pairs + , PositionToPairs n pairs enc arity f + , PositionToPairs (n+1) pairs enc arity g + ) => PositionToPairs n pairs enc arity (f :*: g) where + positionToPairs _ opts targs (f :*: g) = + positionToPairs (Proxy :: Proxy n) opts targs f + `mappend` positionToPairs (Proxy :: Proxy (n+1)) opts targs g + +-------------------------------------------------------------------------------- + class TaggedObject enc arity f where taggedObject :: Options -> ToArgs enc arity a -> String -> String diff --git a/tests/DataFamilies/Encoders.hs b/tests/DataFamilies/Encoders.hs index 111050b95..59c4a79a3 100644 --- a/tests/DataFamilies/Encoders.hs +++ b/tests/DataFamilies/Encoders.hs @@ -46,6 +46,16 @@ thNullaryParseJSONTaggedObject :: Value -> Parser (Nullary Int) thNullaryParseJSONTaggedObject = $(mkParseJSON optsTaggedObject 'C3) +thNullaryToJSONTaggedFlatObject :: Nullary Int -> Value +thNullaryToJSONTaggedFlatObject = $(mkToJSON optsTaggedFlatObject 'C1) + +thNullaryToEncodingTaggedFlatObject :: Nullary Int -> Encoding +thNullaryToEncodingTaggedFlatObject = $(mkToEncoding optsTaggedFlatObject 'C2) + +thNullaryParseJSONTaggedFlatObject :: Value -> Parser (Nullary Int) +thNullaryParseJSONTaggedFlatObject = $(mkParseJSON optsTaggedFlatObject 'C3) + + thNullaryToJSONObjectWithSingleField :: Nullary Int -> Value thNullaryToJSONObjectWithSingleField = $(mkToJSON optsObjectWithSingleField 'C1) @@ -82,6 +92,16 @@ thSomeTypeParseJSONTaggedObject :: Value -> Parser (SomeType c () Int) thSomeTypeParseJSONTaggedObject = $(mkParseJSON optsTaggedObject 'Unary) +thSomeTypeToJSONTaggedFlatObject :: SomeType c () Int -> Value +thSomeTypeToJSONTaggedFlatObject = $(mkToJSON optsTaggedFlatObject 'Record) + +thSomeTypeToEncodingTaggedFlatObject :: SomeType c () Int -> Encoding +thSomeTypeToEncodingTaggedFlatObject = $(mkToEncoding optsTaggedFlatObject 'Nullary) + +thSomeTypeParseJSONTaggedFlatObject :: Value -> Parser (SomeType c () Int) +thSomeTypeParseJSONTaggedFlatObject = $(mkParseJSON optsTaggedFlatObject 'Unary) + + thSomeTypeToJSONObjectWithSingleField :: SomeType c () Int -> Value thSomeTypeToJSONObjectWithSingleField = $(mkToJSON optsObjectWithSingleField 'Product) @@ -177,6 +197,16 @@ gNullaryParseJSONTaggedObject :: Value -> Parser (Nullary Int) gNullaryParseJSONTaggedObject = genericParseJSON optsTaggedObject +gNullaryToJSONTaggedFlatObject :: Nullary Int -> Value +gNullaryToJSONTaggedFlatObject = genericToJSON optsTaggedFlatObject + +gNullaryToEncodingTaggedFlatObject :: Nullary Int -> Encoding +gNullaryToEncodingTaggedFlatObject = genericToEncoding optsTaggedFlatObject + +gNullaryParseJSONTaggedFlatObject :: Value -> Parser (Nullary Int) +gNullaryParseJSONTaggedFlatObject = genericParseJSON optsTaggedFlatObject + + gNullaryToJSONObjectWithSingleField :: Nullary Int -> Value gNullaryToJSONObjectWithSingleField = genericToJSON optsObjectWithSingleField @@ -208,6 +238,16 @@ gSomeTypeParseJSONTaggedObject :: Value -> Parser (SomeType c () Int) gSomeTypeParseJSONTaggedObject = genericParseJSON optsTaggedObject +gSomeTypeToJSONTaggedFlatObject :: SomeType c () Int -> Value +gSomeTypeToJSONTaggedFlatObject = genericToJSON optsTaggedFlatObject + +gSomeTypeToEncodingTaggedFlatObject :: SomeType c () Int -> Encoding +gSomeTypeToEncodingTaggedFlatObject = genericToEncoding optsTaggedFlatObject + +gSomeTypeParseJSONTaggedFlatObject :: Value -> Parser (SomeType c () Int) +gSomeTypeParseJSONTaggedFlatObject = genericParseJSON optsTaggedFlatObject + + gSomeTypeToJSONObjectWithSingleField :: SomeType c () Int -> Value gSomeTypeToJSONObjectWithSingleField = genericToJSON optsObjectWithSingleField diff --git a/tests/DataFamilies/Properties.hs b/tests/DataFamilies/Properties.hs index 67492ed67..b0c43b9a1 100644 --- a/tests/DataFamilies/Properties.hs +++ b/tests/DataFamilies/Properties.hs @@ -23,21 +23,25 @@ tests = testGroup "data families" [ testProperty "string" (isString . thNullaryToJSONString) , testProperty "2ElemArray" (is2ElemArray . thNullaryToJSON2ElemArray) , testProperty "TaggedObject" (isNullaryTaggedObject . thNullaryToJSONTaggedObject) + , testProperty "TaggedFlatObject" (isNullaryTaggedObject . thNullaryToJSONTaggedFlatObject) , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thNullaryToJSONObjectWithSingleField) , testGroup "roundTrip" [ testProperty "string" (toParseJSON thNullaryParseJSONString thNullaryToJSONString) , testProperty "2ElemArray" (toParseJSON thNullaryParseJSON2ElemArray thNullaryToJSON2ElemArray) , testProperty "TaggedObject" (toParseJSON thNullaryParseJSONTaggedObject thNullaryToJSONTaggedObject) + , testProperty "TaggedFlatObject" (toParseJSON thNullaryParseJSONTaggedFlatObject thNullaryToJSONTaggedFlatObject) , testProperty "ObjectWithSingleField" (toParseJSON thNullaryParseJSONObjectWithSingleField thNullaryToJSONObjectWithSingleField) ] ] , testGroup "SomeType" [ testProperty "2ElemArray" (is2ElemArray . thSomeTypeToJSON2ElemArray) , testProperty "TaggedObject" (isTaggedObject . thSomeTypeToJSONTaggedObject) + , testProperty "TaggedFlatObject" (isTaggedObject . thSomeTypeToJSONTaggedFlatObject) , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thSomeTypeToJSONObjectWithSingleField) , testGroup "roundTrip" [ testProperty "2ElemArray" (toParseJSON thSomeTypeParseJSON2ElemArray thSomeTypeToJSON2ElemArray) , testProperty "TaggedObject" (toParseJSON thSomeTypeParseJSONTaggedObject thSomeTypeToJSONTaggedObject) + , testProperty "TaggedFlatObject" (toParseJSON thSomeTypeParseJSONTaggedFlatObject thSomeTypeToJSONTaggedFlatObject) , testProperty "ObjectWithSingleField" (toParseJSON thSomeTypeParseJSONObjectWithSingleField thSomeTypeToJSONObjectWithSingleField) ] ] @@ -65,6 +69,8 @@ tests = testGroup "data families" [ thNullaryToJSON2ElemArray `sameAs` thNullaryToEncoding2ElemArray , testProperty "NullaryTaggedObject" $ thNullaryToJSONTaggedObject `sameAs` thNullaryToEncodingTaggedObject + , testProperty "NullaryTaggedFlatObject" $ + thNullaryToJSONTaggedFlatObject `sameAs` thNullaryToEncodingTaggedFlatObject , testProperty "NullaryObjectWithSingleField" $ thNullaryToJSONObjectWithSingleField `sameAs` thNullaryToEncodingObjectWithSingleField @@ -76,6 +82,8 @@ tests = testGroup "data families" [ thSomeTypeToJSON2ElemArray `sameAs` thSomeTypeToEncoding2ElemArray , testProperty "SomeTypeTaggedObject" $ thSomeTypeToJSONTaggedObject `sameAs` thSomeTypeToEncodingTaggedObject + , testProperty "SomeTypeTaggedFlatObject" $ + thSomeTypeToJSONTaggedFlatObject `sameAs` thSomeTypeToEncodingTaggedFlatObject , testProperty "SomeTypeObjectWithSingleField" $ thSomeTypeToJSONObjectWithSingleField `sameAs` thSomeTypeToEncodingObjectWithSingleField @@ -88,21 +96,25 @@ tests = testGroup "data families" [ testProperty "string" (isString . gNullaryToJSONString) , testProperty "2ElemArray" (is2ElemArray . gNullaryToJSON2ElemArray) , testProperty "TaggedObject" (isNullaryTaggedObject . gNullaryToJSONTaggedObject) + , testProperty "TaggedFlatObject" (isNullaryTaggedObject . gNullaryToJSONTaggedFlatObject) , testProperty "ObjectWithSingleField" (isObjectWithSingleField . gNullaryToJSONObjectWithSingleField) , testGroup "roundTrip" [ testProperty "string" (toParseJSON gNullaryParseJSONString gNullaryToJSONString) , testProperty "2ElemArray" (toParseJSON gNullaryParseJSON2ElemArray gNullaryToJSON2ElemArray) , testProperty "TaggedObject" (toParseJSON gNullaryParseJSONTaggedObject gNullaryToJSONTaggedObject) + , testProperty "TaggedFlatObject" (toParseJSON gNullaryParseJSONTaggedFlatObject gNullaryToJSONTaggedFlatObject) , testProperty "ObjectWithSingleField" (toParseJSON gNullaryParseJSONObjectWithSingleField gNullaryToJSONObjectWithSingleField) ] ] , testGroup "SomeType" [ testProperty "2ElemArray" (is2ElemArray . gSomeTypeToJSON2ElemArray) , testProperty "TaggedObject" (isTaggedObject . gSomeTypeToJSONTaggedObject) + , testProperty "TaggedFlatObject" (isTaggedObject . gSomeTypeToJSONTaggedFlatObject) , testProperty "ObjectWithSingleField" (isObjectWithSingleField . gSomeTypeToJSONObjectWithSingleField) , testGroup "roundTrip" [ testProperty "2ElemArray" (toParseJSON gSomeTypeParseJSON2ElemArray gSomeTypeToJSON2ElemArray) , testProperty "TaggedObject" (toParseJSON gSomeTypeParseJSONTaggedObject gSomeTypeToJSONTaggedObject) + , testProperty "TaggedFlatObject" (toParseJSON gSomeTypeParseJSONTaggedFlatObject gSomeTypeToJSONTaggedFlatObject) , testProperty "ObjectWithSingleField" (toParseJSON gSomeTypeParseJSONObjectWithSingleField gSomeTypeToJSONObjectWithSingleField) ] ] @@ -122,6 +134,8 @@ tests = testGroup "data families" [ gNullaryToJSON2ElemArray `sameAs` gNullaryToEncoding2ElemArray , testProperty "NullaryTaggedObject" $ gNullaryToJSONTaggedObject `sameAs` gNullaryToEncodingTaggedObject + , testProperty "NullaryTaggedFlatObject" $ + gNullaryToJSONTaggedFlatObject `sameAs` gNullaryToEncodingTaggedFlatObject , testProperty "NullaryObjectWithSingleField" $ gNullaryToJSONObjectWithSingleField `sameAs` gNullaryToEncodingObjectWithSingleField @@ -133,6 +147,8 @@ tests = testGroup "data families" [ gSomeTypeToJSON2ElemArray `sameAs` gSomeTypeToEncoding2ElemArray , testProperty "SomeTypeTaggedObject" $ gSomeTypeToJSONTaggedObject `sameAs` gSomeTypeToEncodingTaggedObject + , testProperty "SomeTypeTaggedFlatObject" $ + gSomeTypeToJSONTaggedFlatObject `sameAs` gSomeTypeToEncodingTaggedFlatObject , testProperty "SomeTypeObjectWithSingleField" $ gSomeTypeToJSONObjectWithSingleField `sameAs` gSomeTypeToEncodingObjectWithSingleField diff --git a/tests/Encoders.hs b/tests/Encoders.hs index 8bcab3cfb..6260a2425 100644 --- a/tests/Encoders.hs +++ b/tests/Encoders.hs @@ -47,6 +47,16 @@ thNullaryParseJSONTaggedObject :: Value -> Parser Nullary thNullaryParseJSONTaggedObject = $(mkParseJSON optsTaggedObject ''Nullary) +thNullaryToJSONTaggedFlatObject :: Nullary -> Value +thNullaryToJSONTaggedFlatObject = $(mkToJSON optsTaggedFlatObject ''Nullary) + +thNullaryToEncodingTaggedFlatObject :: Nullary -> Encoding +thNullaryToEncodingTaggedFlatObject = $(mkToEncoding optsTaggedFlatObject ''Nullary) + +thNullaryParseJSONTaggedFlatObject :: Value -> Parser Nullary +thNullaryParseJSONTaggedFlatObject = $(mkParseJSON optsTaggedFlatObject ''Nullary) + + thNullaryToJSONObjectWithSingleField :: Nullary -> Value thNullaryToJSONObjectWithSingleField = $(mkToJSON optsObjectWithSingleField ''Nullary) @@ -88,6 +98,16 @@ gNullaryParseJSONTaggedObject :: Value -> Parser Nullary gNullaryParseJSONTaggedObject = genericParseJSON optsTaggedObject +gNullaryToJSONTaggedFlatObject :: Nullary -> Value +gNullaryToJSONTaggedFlatObject = genericToJSON optsTaggedFlatObject + +gNullaryToEncodingTaggedFlatObject :: Nullary -> Encoding +gNullaryToEncodingTaggedFlatObject = genericToEncoding optsTaggedFlatObject + +gNullaryParseJSONTaggedFlatObject :: Value -> Parser Nullary +gNullaryParseJSONTaggedFlatObject = genericParseJSON optsTaggedFlatObject + + gNullaryToJSONObjectWithSingleField :: Nullary -> Value gNullaryToJSONObjectWithSingleField = genericToJSON optsObjectWithSingleField @@ -160,6 +180,25 @@ thSomeTypeLiftParseJSONTaggedObject :: LiftParseJSON SomeType a thSomeTypeLiftParseJSONTaggedObject = $(mkLiftParseJSON optsTaggedObject ''SomeType) +thSomeTypeToJSONTaggedFlatObject :: SomeType Int -> Value +thSomeTypeToJSONTaggedFlatObject = $(mkToJSON optsTaggedFlatObject ''SomeType) + +thSomeTypeToEncodingTaggedFlatObject :: SomeType Int -> Encoding +thSomeTypeToEncodingTaggedFlatObject = $(mkToEncoding optsTaggedFlatObject ''SomeType) + +thSomeTypeLiftToJSONTaggedFlatObject :: LiftToJSON SomeType a +thSomeTypeLiftToJSONTaggedFlatObject = $(mkLiftToJSON optsTaggedFlatObject ''SomeType) + +thSomeTypeLiftToEncodingTaggedFlatObject :: LiftToEncoding SomeType a +thSomeTypeLiftToEncodingTaggedFlatObject = $(mkLiftToEncoding optsTaggedFlatObject ''SomeType) + +thSomeTypeParseJSONTaggedFlatObject :: Value -> Parser (SomeType Int) +thSomeTypeParseJSONTaggedFlatObject = $(mkParseJSON optsTaggedFlatObject ''SomeType) + +thSomeTypeLiftParseJSONTaggedFlatObject :: LiftParseJSON SomeType a +thSomeTypeLiftParseJSONTaggedFlatObject = $(mkLiftParseJSON optsTaggedFlatObject ''SomeType) + + thSomeTypeToJSONObjectWithSingleField :: SomeType Int -> Value thSomeTypeToJSONObjectWithSingleField = $(mkToJSON optsObjectWithSingleField ''SomeType) @@ -217,6 +256,25 @@ gSomeTypeLiftParseJSONTaggedObject :: LiftParseJSON SomeType a gSomeTypeLiftParseJSONTaggedObject = genericLiftParseJSON optsTaggedObject +gSomeTypeToJSONTaggedFlatObject :: SomeType Int -> Value +gSomeTypeToJSONTaggedFlatObject = genericToJSON optsTaggedFlatObject + +gSomeTypeToEncodingTaggedFlatObject :: SomeType Int -> Encoding +gSomeTypeToEncodingTaggedFlatObject = genericToEncoding optsTaggedFlatObject + +gSomeTypeParseJSONTaggedFlatObject :: Value -> Parser (SomeType Int) +gSomeTypeParseJSONTaggedFlatObject = genericParseJSON optsTaggedFlatObject + +gSomeTypeLiftToEncodingTaggedFlatObject :: LiftToEncoding SomeType a +gSomeTypeLiftToEncodingTaggedFlatObject = genericLiftToEncoding optsTaggedFlatObject + +gSomeTypeLiftToJSONTaggedFlatObject :: LiftToJSON SomeType a +gSomeTypeLiftToJSONTaggedFlatObject = genericLiftToJSON optsTaggedFlatObject + +gSomeTypeLiftParseJSONTaggedFlatObject :: LiftParseJSON SomeType a +gSomeTypeLiftParseJSONTaggedFlatObject = genericLiftParseJSON optsTaggedFlatObject + + gSomeTypeToJSONObjectWithSingleField :: SomeType Int -> Value gSomeTypeToJSONObjectWithSingleField = genericToJSON optsObjectWithSingleField diff --git a/tests/Options.hs b/tests/Options.hs index 8618750e7..ba26fe8c7 100644 --- a/tests/Options.hs +++ b/tests/Options.hs @@ -39,6 +39,9 @@ optsOmitNothingFields = optsDefault { omitNothingFields = True } +optsTaggedFlatObject :: Options +optsTaggedFlatObject = optsDefault { allNullaryToStringTag = False, sumEncoding = TaggedFlatObject "tag"} + optsUntaggedValue :: Options optsUntaggedValue = optsDefault { sumEncoding = UntaggedValue diff --git a/tests/PropertyGeneric.hs b/tests/PropertyGeneric.hs index 8f9ed8cff..1bf7a510e 100644 --- a/tests/PropertyGeneric.hs +++ b/tests/PropertyGeneric.hs @@ -23,11 +23,13 @@ genericTests = testProperty "string" (isString . gNullaryToJSONString) , testProperty "2ElemArray" (is2ElemArray . gNullaryToJSON2ElemArray) , testProperty "TaggedObject" (isNullaryTaggedObject . gNullaryToJSONTaggedObject) + , testProperty "TaggedFlatObject" (isNullaryTaggedObject . gNullaryToJSONTaggedFlatObject) , testProperty "ObjectWithSingleField" (isObjectWithSingleField . gNullaryToJSONObjectWithSingleField) , testGroup "roundTrip" [ testProperty "string" (toParseJSON gNullaryParseJSONString gNullaryToJSONString) , testProperty "2ElemArray" (toParseJSON gNullaryParseJSON2ElemArray gNullaryToJSON2ElemArray) , testProperty "TaggedObject" (toParseJSON gNullaryParseJSONTaggedObject gNullaryToJSONTaggedObject) + , testProperty "TaggedFlatObject" (toParseJSON gNullaryParseJSONTaggedFlatObject gNullaryToJSONTaggedFlatObject) , testProperty "ObjectWithSingleField" (toParseJSON gNullaryParseJSONObjectWithSingleField gNullaryToJSONObjectWithSingleField) ] ] @@ -38,14 +40,17 @@ genericTests = , testGroup "SomeType" [ testProperty "2ElemArray" (is2ElemArray . gSomeTypeToJSON2ElemArray) , testProperty "TaggedObject" (isTaggedObject . gSomeTypeToJSONTaggedObject) + , testProperty "TaggedFlatObject" (isTaggedObject . gSomeTypeToJSONTaggedFlatObject) , testProperty "ObjectWithSingleField" (isObjectWithSingleField . gSomeTypeToJSONObjectWithSingleField) , testGroup "roundTrip" [ testProperty "2ElemArray" (toParseJSON gSomeTypeParseJSON2ElemArray gSomeTypeToJSON2ElemArray) , testProperty "TaggedObject" (toParseJSON gSomeTypeParseJSONTaggedObject gSomeTypeToJSONTaggedObject) + , testProperty "TaggedFlatObject" (toParseJSON gSomeTypeParseJSONTaggedFlatObject gSomeTypeToJSONTaggedFlatObject) , testProperty "ObjectWithSingleField" (toParseJSON gSomeTypeParseJSONObjectWithSingleField gSomeTypeToJSONObjectWithSingleField) , testProperty "2ElemArray unary" (toParseJSON1 gSomeTypeLiftParseJSON2ElemArray gSomeTypeLiftToJSON2ElemArray) , testProperty "TaggedObject unary" (toParseJSON1 gSomeTypeLiftParseJSONTaggedObject gSomeTypeLiftToJSONTaggedObject) + , testProperty "TaggedFlatObject unary" (toParseJSON1 gSomeTypeLiftParseJSONTaggedFlatObject gSomeTypeLiftToJSONTaggedFlatObject) , testProperty "ObjectWithSingleField unary" (toParseJSON1 gSomeTypeLiftParseJSONObjectWithSingleField gSomeTypeLiftToJSONObjectWithSingleField) ] ] @@ -70,6 +75,8 @@ genericTests = gNullaryToJSON2ElemArray `sameAs` gNullaryToEncoding2ElemArray , testProperty "NullaryTaggedObject" $ gNullaryToJSONTaggedObject `sameAs` gNullaryToEncodingTaggedObject + , testProperty "NullaryTaggedFlatObject" $ + gNullaryToJSONTaggedFlatObject `sameAs` gNullaryToEncodingTaggedFlatObject , testProperty "NullaryObjectWithSingleField" $ gNullaryToJSONObjectWithSingleField `sameAs` gNullaryToEncodingObjectWithSingleField @@ -94,6 +101,13 @@ genericTests = gSomeTypeLiftToJSONTaggedObject `sameAs1` gSomeTypeLiftToEncodingTaggedObject , testProperty "SomeTypeTaggedObject unary agree" $ gSomeTypeToEncodingTaggedObject `sameAs1Agree` gSomeTypeLiftToEncodingTaggedObject + + , testProperty "SomeTyptTaggedFlatObject" $ + gSomeTypeToJSONTaggedFlatObject `sameAs` gSomeTypeToEncodingTaggedFlatObject + , testProperty "SomeTyptTaggedFlatObject unary" $ + gSomeTypeLiftToJSONTaggedFlatObject `sameAs1` gSomeTypeLiftToEncodingTaggedFlatObject + , testProperty "SomeTyptTaggedFlatObject unary agree" $ + gSomeTypeToEncodingTaggedFlatObject `sameAs1Agree` gSomeTypeLiftToEncodingTaggedFlatObject , testProperty "SomeTypeObjectWithSingleField" $ gSomeTypeToJSONObjectWithSingleField `sameAs` gSomeTypeToEncodingObjectWithSingleField diff --git a/tests/PropertyTH.hs b/tests/PropertyTH.hs index e4ef0b391..6e2a91c67 100644 --- a/tests/PropertyTH.hs +++ b/tests/PropertyTH.hs @@ -22,12 +22,14 @@ templateHaskellTests = testProperty "string" (isString . thNullaryToJSONString) , testProperty "2ElemArray" (is2ElemArray . thNullaryToJSON2ElemArray) , testProperty "TaggedObject" (isNullaryTaggedObject . thNullaryToJSONTaggedObject) + , testProperty "TaggedFlatObject" (isNullaryTaggedObject . thNullaryToJSONTaggedFlatObject) , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thNullaryToJSONObjectWithSingleField) , testGroup "roundTrip" [ testProperty "string" (toParseJSON thNullaryParseJSONString thNullaryToJSONString) , testProperty "2ElemArray" (toParseJSON thNullaryParseJSON2ElemArray thNullaryToJSON2ElemArray) , testProperty "TaggedObject" (toParseJSON thNullaryParseJSONTaggedObject thNullaryToJSONTaggedObject) + , testProperty "TaggedFlatObject" (toParseJSON thNullaryParseJSONTaggedFlatObject thNullaryToJSONTaggedFlatObject) , testProperty "ObjectWithSingleField" (toParseJSON thNullaryParseJSONObjectWithSingleField thNullaryToJSONObjectWithSingleField) ] ] @@ -38,14 +40,17 @@ templateHaskellTests = , testGroup "SomeType" [ testProperty "2ElemArray" (is2ElemArray . thSomeTypeToJSON2ElemArray) , testProperty "TaggedObject" (isTaggedObject . thSomeTypeToJSONTaggedObject) + , testProperty "TaggedFlatObject" (isTaggedObject . thSomeTypeToJSONTaggedFlatObject) , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thSomeTypeToJSONObjectWithSingleField) , testGroup "roundTrip" [ testProperty "2ElemArray" (toParseJSON thSomeTypeParseJSON2ElemArray thSomeTypeToJSON2ElemArray) , testProperty "TaggedObject" (toParseJSON thSomeTypeParseJSONTaggedObject thSomeTypeToJSONTaggedObject) + , testProperty "TaggedFlatObject" (toParseJSON thSomeTypeParseJSONTaggedFlatObject thSomeTypeToJSONTaggedFlatObject) , testProperty "ObjectWithSingleField" (toParseJSON thSomeTypeParseJSONObjectWithSingleField thSomeTypeToJSONObjectWithSingleField) , testProperty "2ElemArray unary" (toParseJSON1 thSomeTypeLiftParseJSON2ElemArray thSomeTypeLiftToJSON2ElemArray) , testProperty "TaggedObject unary" (toParseJSON1 thSomeTypeLiftParseJSONTaggedObject thSomeTypeLiftToJSONTaggedObject) + , testProperty "TaggedFlatObject unary" (toParseJSON1 thSomeTypeLiftParseJSONTaggedFlatObject thSomeTypeLiftToJSONTaggedFlatObject) , testProperty "ObjectWithSingleField unary" (toParseJSON1 thSomeTypeLiftParseJSONObjectWithSingleField thSomeTypeLiftToJSONObjectWithSingleField) ] @@ -87,6 +92,8 @@ templateHaskellTests = thNullaryToJSON2ElemArray `sameAs` thNullaryToEncoding2ElemArray , testProperty "NullaryTaggedObject" $ thNullaryToJSONTaggedObject `sameAs` thNullaryToEncodingTaggedObject + , testProperty "NullaryTaggedFlatObject" $ + thNullaryToJSONTaggedFlatObject `sameAs` thNullaryToEncodingTaggedFlatObject , testProperty "NullaryObjectWithSingleField" $ thNullaryToJSONObjectWithSingleField `sameAs` thNullaryToEncodingObjectWithSingleField @@ -112,6 +119,13 @@ templateHaskellTests = , testProperty "SomeTypeTaggedObject unary agree" $ thSomeTypeToEncodingTaggedObject `sameAs1Agree` thSomeTypeLiftToEncodingTaggedObject + , testProperty "SomeTypeTaggedFlatObject" $ + thSomeTypeToJSONTaggedFlatObject `sameAs` thSomeTypeToEncodingTaggedFlatObject + , testProperty "SomeTypeTaggedFlatObject unary" $ + thSomeTypeLiftToJSONTaggedFlatObject `sameAs1` thSomeTypeLiftToEncodingTaggedFlatObject + , testProperty "SomeTypeTaggedFlatObject unary agree" $ + thSomeTypeToEncodingTaggedFlatObject `sameAs1Agree` thSomeTypeLiftToEncodingTaggedFlatObject + , testProperty "SomeTypeObjectWithSingleField" $ thSomeTypeToJSONObjectWithSingleField `sameAs` thSomeTypeToEncodingObjectWithSingleField , testProperty "SomeTypeObjectWithSingleField unary" $ diff --git a/tests/UnitTests/NullaryConstructors.hs b/tests/UnitTests/NullaryConstructors.hs index dcc19cace..8d1e7cc5d 100644 --- a/tests/UnitTests/NullaryConstructors.hs +++ b/tests/UnitTests/NullaryConstructors.hs @@ -31,6 +31,8 @@ nullaryConstructors = , dec "[\"c1\",[]]" @=? thNullaryToJSON2ElemArray C1 , dec "{\"tag\":\"c1\"}" @=? thNullaryToJSONTaggedObject C1 , dec "{\"tag\":\"c1\"}" @=? gNullaryToJSONTaggedObject C1 + , dec "{\"tag\":\"c1\"}" @=? thNullaryToJSONTaggedFlatObject C1 + , dec "{\"tag\":\"c1\"}" @=? gNullaryToJSONTaggedFlatObject C1 , decE "\"C1\"" @=? enc (gNullaryToEncodingString C1) , decE "\"C1\"" @=? enc (thNullaryToEncodingString C1) @@ -40,6 +42,8 @@ nullaryConstructors = , decE "{\"c1\":[]}" @=? enc (gNullaryToEncodingObjectWithSingleField C1) , decE "{\"tag\":\"c1\"}" @=? enc (thNullaryToEncodingTaggedObject C1) , decE "{\"tag\":\"c1\"}" @=? enc (gNullaryToEncodingTaggedObject C1) + , decE "{\"tag\":\"c1\"}" @=? enc (thNullaryToEncodingTaggedFlatObject C1) + , decE "{\"tag\":\"c1\"}" @=? enc (gNullaryToEncodingTaggedFlatObject C1) , ISuccess C1 @=? parse thNullaryParseJSONTaggedObject (dec "{\"tag\":\"c1\"}") , ISuccess C1 @=? parse gNullaryParseJSONTaggedObject (dec "{\"tag\":\"c1\"}")