Add th property tests for TaggedFlatObject

Author: Poscat

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)
@@ -170,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)
 

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" $