Add generic test cases for TaggedFlatObject

Author: Poscat

tests/Encoders.hs

@@ -88,6 +88,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
 
@@ -217,6 +227,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
 

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

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