git.iko.soy/typeable/aeson
on 1.4.5.0 help sign in
typeable/aeson/tests/PropertyGeneric.hs
124 lines 6.3 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE NoImplicitPrelude #-}
4module PropertyGeneric ( genericTests ) where
6import Prelude.Compat
8import Data.Semigroup (Option(..))
9import Encoders
10import Instances ()
11import Test.Tasty (TestTree, testGroup)
12import Test.Tasty.QuickCheck (testProperty)
13import Test.QuickCheck ( (===) )
14import Types
15import PropUtils
18genericTests :: TestTree
19genericTests =
20 testGroup "generic" [
21 testGroup "toJSON" [
22 testGroup "Nullary" [
23 testProperty "string" (isString . gNullaryToJSONString)
24 , testProperty "2ElemArray" (is2ElemArray . gNullaryToJSON2ElemArray)
25 , testProperty "TaggedObject" (isNullaryTaggedObject . gNullaryToJSONTaggedObject)
26 , testProperty "ObjectWithSingleField" (isObjectWithSingleField . gNullaryToJSONObjectWithSingleField)
27 , testGroup "roundTrip" [
28 testProperty "string" (toParseJSON gNullaryParseJSONString gNullaryToJSONString)
29 , testProperty "2ElemArray" (toParseJSON gNullaryParseJSON2ElemArray gNullaryToJSON2ElemArray)
30 , testProperty "TaggedObject" (toParseJSON gNullaryParseJSONTaggedObject gNullaryToJSONTaggedObject)
31 , testProperty "ObjectWithSingleField" (toParseJSON gNullaryParseJSONObjectWithSingleField gNullaryToJSONObjectWithSingleField)
32 ]
33 ]
34 , testGroup "EitherTextInt" [
35 testProperty "UntaggedValue" (isUntaggedValueETI . gEitherTextIntToJSONUntaggedValue)
36 , testProperty "roundtrip" (toParseJSON gEitherTextIntParseJSONUntaggedValue gEitherTextIntToJSONUntaggedValue)
37 ]
38 , testGroup "SomeType" [
39 testProperty "2ElemArray" (is2ElemArray . gSomeTypeToJSON2ElemArray)
40 , testProperty "TaggedObject" (isTaggedObject . gSomeTypeToJSONTaggedObject)
41 , testProperty "ObjectWithSingleField" (isObjectWithSingleField . gSomeTypeToJSONObjectWithSingleField)
42 , testGroup "roundTrip" [
43 testProperty "2ElemArray" (toParseJSON gSomeTypeParseJSON2ElemArray gSomeTypeToJSON2ElemArray)
44 , testProperty "TaggedObject" (toParseJSON gSomeTypeParseJSONTaggedObject gSomeTypeToJSONTaggedObject)
45 , testProperty "ObjectWithSingleField" (toParseJSON gSomeTypeParseJSONObjectWithSingleField gSomeTypeToJSONObjectWithSingleField)
47#if __GLASGOW_HASKELL__ >= 706
48 , testProperty "2ElemArray unary" (toParseJSON1 gSomeTypeLiftParseJSON2ElemArray gSomeTypeLiftToJSON2ElemArray)
49 , testProperty "TaggedObject unary" (toParseJSON1 gSomeTypeLiftParseJSONTaggedObject gSomeTypeLiftToJSONTaggedObject)
50 , testProperty "ObjectWithSingleField unary" (toParseJSON1 gSomeTypeLiftParseJSONObjectWithSingleField gSomeTypeLiftToJSONObjectWithSingleField)
51#endif
52 ]
53 ]
54 , testGroup "OneConstructor" [
55 testProperty "default" (isEmptyArray . gOneConstructorToJSONDefault)
56 , testProperty "Tagged" (isTaggedObject . gOneConstructorToJSONTagged)
57 , testGroup "roundTrip" [
58 testProperty "default" (toParseJSON gOneConstructorParseJSONDefault gOneConstructorToJSONDefault)
59 , testProperty "Tagged" (toParseJSON gOneConstructorParseJSONTagged gOneConstructorToJSONTagged)
60 ]
61 ]
62 , testGroup "OptionField" [
63 testProperty "like Maybe" $
64 \x -> gOptionFieldToJSON (OptionField (Option x)) === thMaybeFieldToJSON (MaybeField x)
65 , testProperty "roundTrip" (toParseJSON gOptionFieldParseJSON gOptionFieldToJSON)
66 ]
67 ]
68 , testGroup "toEncoding" [
69 testProperty "NullaryString" $
70 gNullaryToJSONString `sameAs` gNullaryToEncodingString
71 , testProperty "Nullary2ElemArray" $
72 gNullaryToJSON2ElemArray `sameAs` gNullaryToEncoding2ElemArray
73 , testProperty "NullaryTaggedObject" $
74 gNullaryToJSONTaggedObject `sameAs` gNullaryToEncodingTaggedObject
75 , testProperty "NullaryObjectWithSingleField" $
76 gNullaryToJSONObjectWithSingleField `sameAs`
77 gNullaryToEncodingObjectWithSingleField
78 -- , testProperty "ApproxUnwrap" $
79 -- gApproxToJSONUnwrap `sameAs` gApproxToEncodingUnwrap
80 , testProperty "ApproxDefault" $
81 gApproxToJSONDefault `sameAs` gApproxToEncodingDefault
83 , testProperty "EitherTextInt UntaggedValue" $
84 gEitherTextIntToJSONUntaggedValue `sameAs` gEitherTextIntToEncodingUntaggedValue
86 , testProperty "SomeType2ElemArray" $
87 gSomeTypeToJSON2ElemArray `sameAs` gSomeTypeToEncoding2ElemArray
88#if __GLASGOW_HASKELL__ >= 706
89 , testProperty "SomeType2ElemArray unary" $
90 gSomeTypeLiftToJSON2ElemArray `sameAs1` gSomeTypeLiftToEncoding2ElemArray
91 , testProperty "SomeType2ElemArray unary agree" $
92 gSomeTypeToEncoding2ElemArray `sameAs1Agree` gSomeTypeLiftToEncoding2ElemArray
93#endif
95 , testProperty "SomeTypeTaggedObject" $
96 gSomeTypeToJSONTaggedObject `sameAs` gSomeTypeToEncodingTaggedObject
97#if __GLASGOW_HASKELL__ >= 706
98 , testProperty "SomeTypeTaggedObject unary" $
99 gSomeTypeLiftToJSONTaggedObject `sameAs1` gSomeTypeLiftToEncodingTaggedObject
100 , testProperty "SomeTypeTaggedObject unary agree" $
101 gSomeTypeToEncodingTaggedObject `sameAs1Agree` gSomeTypeLiftToEncodingTaggedObject
102#endif
104 , testProperty "SomeTypeObjectWithSingleField" $
105 gSomeTypeToJSONObjectWithSingleField `sameAs` gSomeTypeToEncodingObjectWithSingleField
106#if __GLASGOW_HASKELL__ >= 706
107 , testProperty "SomeTypeObjectWithSingleField unary" $
108 gSomeTypeLiftToJSONObjectWithSingleField `sameAs1` gSomeTypeLiftToEncodingObjectWithSingleField
109 , testProperty "SomeTypeObjectWithSingleField unary agree" $
110 gSomeTypeToEncodingObjectWithSingleField `sameAs1Agree` gSomeTypeLiftToEncodingObjectWithSingleField
111#endif
113 , testProperty "SomeTypeOmitNothingFields" $
114 gSomeTypeToJSONOmitNothingFields `sameAs` gSomeTypeToEncodingOmitNothingFields
116 , testProperty "OneConstructorDefault" $
117 gOneConstructorToJSONDefault `sameAs` gOneConstructorToEncodingDefault
118 , testProperty "OneConstructorTagged" $
119 gOneConstructorToJSONTagged `sameAs` gOneConstructorToEncodingTagged
121 , testProperty "OptionField" $
122 gOptionFieldToJSON `sameAs` gOptionFieldToEncoding
123 ]
124 ]