on master help sign in
A few more TH tests, with a twist
commit076c90f261bc3d55717804638029fa8ae794bb01 authorBryan O'Sullivan <bos@serpentine.com> dateThu 2 Jul 2015, 16:00 (11 years ago) parent08fa32a
2 files changed+28−2
tests/Encoders.hs+14−2 tests/Properties.hs+14
tests/Encoders.hs+14−2
@@ -87,6 +87,9 @@ gNullaryParseJSONObjectWithSingleField = genericParseJSON optsObjectWithSingleFi
8787thSomeTypeToJSON2ElemArray :: SomeType Int -> Value
8888thSomeTypeToJSON2ElemArray = $(mkToJSON opts2ElemArray ''SomeType)
8989
90+thSomeTypeToEncoding2ElemArray :: SomeType Int -> Encoding
91+thSomeTypeToEncoding2ElemArray = $(mkToEncoding opts2ElemArray ''SomeType)
92+
9093thSomeTypeParseJSON2ElemArray :: Value -> Parser (SomeType Int)
9194thSomeTypeParseJSON2ElemArray = $(mkParseJSON opts2ElemArray ''SomeType)
9295
@@ -94,15 +97,24 @@ thSomeTypeParseJSON2ElemArray = $(mkParseJSON opts2ElemArray ''SomeType)
9497thSomeTypeToJSONTaggedObject :: SomeType Int -> Value
9598thSomeTypeToJSONTaggedObject = $(mkToJSON optsTaggedObject ''SomeType)
9699
100+thSomeTypeToEncodingTaggedObject :: SomeType Int -> Encoding
101+thSomeTypeToEncodingTaggedObject = $(mkToEncoding optsTaggedObject ''SomeType)
102+
97103thSomeTypeParseJSONTaggedObject :: Value -> Parser (SomeType Int)
98104thSomeTypeParseJSONTaggedObject = $(mkParseJSON optsTaggedObject ''SomeType)
99105
100106
101107thSomeTypeToJSONObjectWithSingleField :: SomeType Int -> Value
102−thSomeTypeToJSONObjectWithSingleField = $(mkToJSON optsObjectWithSingleField ''SomeType)
108+thSomeTypeToJSONObjectWithSingleField =
109+ $(mkToJSON optsObjectWithSingleField ''SomeType)
110+
111+thSomeTypeToEncodingObjectWithSingleField :: SomeType Int -> Encoding
112+thSomeTypeToEncodingObjectWithSingleField =
113+ $(mkToEncoding optsObjectWithSingleField ''SomeType)
103114
104115thSomeTypeParseJSONObjectWithSingleField :: Value -> Parser (SomeType Int)
105−thSomeTypeParseJSONObjectWithSingleField = $(mkParseJSON optsObjectWithSingleField ''SomeType)
116+thSomeTypeParseJSONObjectWithSingleField =
117+ $(mkParseJSON optsObjectWithSingleField ''SomeType)
106118
107119
108120gSomeTypeToJSON2ElemArray :: SomeType Int -> Value
tests/Properties.hs+14
@@ -77,11 +77,18 @@ modifyFailureProp orig added =
7777 result :: Result ()
7878 result = parse parser ()
7979
80+-- | Perform a bit-for-bit comparison of two encoding methods.
8081sameAs :: (a -> Value) -> (a -> Encoding) -> a -> Property
8182sameAs toVal toEnc v =
8283 toLazyByteString (encodeToBuilder (toVal v)) ===
8384 toLazyByteString (fromEncoding (toEnc v))
8485
86+-- | Behaves like 'sameAs', but compares decoded values to account for
87+-- HashMap-driven variation in JSON object key ordering.
88+sameAsV :: (a -> Value) -> (a -> Encoding) -> a -> Property
89+sameAsV toVal toEnc v =
90+ eitherDecode (toLazyByteString (fromEncoding (toEnc v))) === Right (toVal v)
91+
8592main :: IO ()
8693main = do
8794 comparisonTest <- encoderComparisonTests
@@ -205,6 +212,13 @@ tests = [
205212 thApproxToJSONUnwrap `sameAs` thApproxToEncodingUnwrap
206213 , testProperty "ApproxDefault" $
207214 thApproxToJSONDefault `sameAs` thApproxToEncodingDefault
215+ , testProperty "SomeType2ElemArray" $
216+ thSomeTypeToJSON2ElemArray `sameAsV` thSomeTypeToEncoding2ElemArray
217+ , testProperty "SomeTypeTaggedObject" $
218+ thSomeTypeToJSONTaggedObject `sameAsV` thSomeTypeToEncodingTaggedObject
219+ , testProperty "SomeTypeObjectWithSingleField" $
220+ thSomeTypeToJSONObjectWithSingleField `sameAsV`
221+ thSomeTypeToEncodingObjectWithSingleField
208222 ]
209223 ]
210224 ]