git.iko.soy/typeable/aeson
on 1.4.4.0 help sign in
typeable/aeson/tests/PropertyTH.hs
130 lines 7.1 kB history raw
1{-# LANGUAGE NoImplicitPrelude #-}
3module PropertyTH ( templateHaskellTests ) where
5import Prelude.Compat
7import Data.Semigroup (Option(..))
8import Encoders
9import Instances ()
10import Test.Tasty (TestTree, testGroup)
11import Test.Tasty.QuickCheck (testProperty)
12import Test.QuickCheck ( (===) )
13import Types
14import PropUtils
17templateHaskellTests :: TestTree
18templateHaskellTests =
19 testGroup "template-haskell" [
20 testGroup "toJSON" [
21 testGroup "Nullary" [
22 testProperty "string" (isString . thNullaryToJSONString)
23 , testProperty "2ElemArray" (is2ElemArray . thNullaryToJSON2ElemArray)
24 , testProperty "TaggedObject" (isNullaryTaggedObject . thNullaryToJSONTaggedObject)
25 , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thNullaryToJSONObjectWithSingleField)
27 , testGroup "roundTrip" [
28 testProperty "string" (toParseJSON thNullaryParseJSONString thNullaryToJSONString)
29 , testProperty "2ElemArray" (toParseJSON thNullaryParseJSON2ElemArray thNullaryToJSON2ElemArray)
30 , testProperty "TaggedObject" (toParseJSON thNullaryParseJSONTaggedObject thNullaryToJSONTaggedObject)
31 , testProperty "ObjectWithSingleField" (toParseJSON thNullaryParseJSONObjectWithSingleField thNullaryToJSONObjectWithSingleField)
32 ]
33 ]
34 , testGroup "EitherTextInt" [
35 testProperty "UntaggedValue" (isUntaggedValueETI . thEitherTextIntToJSONUntaggedValue)
36 , testProperty "roundtrip" (toParseJSON thEitherTextIntParseJSONUntaggedValue thEitherTextIntToJSONUntaggedValue)
37 ]
38 , testGroup "SomeType" [
39 testProperty "2ElemArray" (is2ElemArray . thSomeTypeToJSON2ElemArray)
40 , testProperty "TaggedObject" (isTaggedObject . thSomeTypeToJSONTaggedObject)
41 , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thSomeTypeToJSONObjectWithSingleField)
42 , testGroup "roundTrip" [
43 testProperty "2ElemArray" (toParseJSON thSomeTypeParseJSON2ElemArray thSomeTypeToJSON2ElemArray)
44 , testProperty "TaggedObject" (toParseJSON thSomeTypeParseJSONTaggedObject thSomeTypeToJSONTaggedObject)
45 , testProperty "ObjectWithSingleField" (toParseJSON thSomeTypeParseJSONObjectWithSingleField thSomeTypeToJSONObjectWithSingleField)
47 , testProperty "2ElemArray unary" (toParseJSON1 thSomeTypeLiftParseJSON2ElemArray thSomeTypeLiftToJSON2ElemArray)
48 , testProperty "TaggedObject unary" (toParseJSON1 thSomeTypeLiftParseJSONTaggedObject thSomeTypeLiftToJSONTaggedObject)
49 , testProperty "ObjectWithSingleField unary" (toParseJSON1 thSomeTypeLiftParseJSONObjectWithSingleField thSomeTypeLiftToJSONObjectWithSingleField)
51 ]
52 ]
53 , testGroup "Approx" [
54 testProperty "string" (isString . thApproxToJSONUnwrap)
55 , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thApproxToJSONDefault)
56 , testGroup "roundTrip" [
57 testProperty "string" (toParseJSON thApproxParseJSONUnwrap thApproxToJSONUnwrap)
58 , testProperty "ObjectWithSingleField" (toParseJSON thApproxParseJSONDefault thApproxToJSONDefault)
59 ]
60 ]
61 , testGroup "GADT" [
62 testProperty "string" (isString . thGADTToJSONUnwrap)
63 , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thGADTToJSONDefault)
64 , testGroup "roundTrip" [
65 testProperty "string" (toParseJSON thGADTParseJSONUnwrap thGADTToJSONUnwrap)
66 , testProperty "ObjectWithSingleField" (toParseJSON thGADTParseJSONDefault thGADTToJSONDefault)
67 ]
68 ]
69 , testGroup "OneConstructor" [
70 testProperty "default" (isEmptyArray . thOneConstructorToJSONDefault)
71 , testProperty "Tagged" (isTaggedObject . thOneConstructorToJSONTagged)
72 , testGroup "roundTrip" [
73 testProperty "default" (toParseJSON thOneConstructorParseJSONDefault thOneConstructorToJSONDefault)
74 , testProperty "Tagged" (toParseJSON thOneConstructorParseJSONTagged thOneConstructorToJSONTagged)
75 ]
76 ]
77 , testGroup "OptionField" [
78 testProperty "like Maybe" $
79 \x -> thOptionFieldToJSON (OptionField (Option x)) === thMaybeFieldToJSON (MaybeField x)
80 , testProperty "roundTrip" (toParseJSON thOptionFieldParseJSON thOptionFieldToJSON)
81 ]
82 ]
83 , testGroup "toEncoding" [
84 testProperty "NullaryString" $
85 thNullaryToJSONString `sameAs` thNullaryToEncodingString
86 , testProperty "Nullary2ElemArray" $
87 thNullaryToJSON2ElemArray `sameAs` thNullaryToEncoding2ElemArray
88 , testProperty "NullaryTaggedObject" $
89 thNullaryToJSONTaggedObject `sameAs` thNullaryToEncodingTaggedObject
90 , testProperty "NullaryObjectWithSingleField" $
91 thNullaryToJSONObjectWithSingleField `sameAs`
92 thNullaryToEncodingObjectWithSingleField
93 , testProperty "ApproxUnwrap" $
94 thApproxToJSONUnwrap `sameAs` thApproxToEncodingUnwrap
95 , testProperty "ApproxDefault" $
96 thApproxToJSONDefault `sameAs` thApproxToEncodingDefault
98 , testProperty "EitherTextInt UntaggedValue" $
99 thEitherTextIntToJSONUntaggedValue `sameAs` thEitherTextIntToEncodingUntaggedValue
101 , testProperty "SomeType2ElemArray" $
102 thSomeTypeToJSON2ElemArray `sameAs` thSomeTypeToEncoding2ElemArray
103 , testProperty "SomeType2ElemArray unary" $
104 thSomeTypeLiftToJSON2ElemArray `sameAs1` thSomeTypeLiftToEncoding2ElemArray
105 , testProperty "SomeType2ElemArray unary agree" $
106 thSomeTypeToEncoding2ElemArray `sameAs1Agree` thSomeTypeLiftToEncoding2ElemArray
108 , testProperty "SomeTypeTaggedObject" $
109 thSomeTypeToJSONTaggedObject `sameAs` thSomeTypeToEncodingTaggedObject
110 , testProperty "SomeTypeTaggedObject unary" $
111 thSomeTypeLiftToJSONTaggedObject `sameAs1` thSomeTypeLiftToEncodingTaggedObject
112 , testProperty "SomeTypeTaggedObject unary agree" $
113 thSomeTypeToEncodingTaggedObject `sameAs1Agree` thSomeTypeLiftToEncodingTaggedObject
115 , testProperty "SomeTypeObjectWithSingleField" $
116 thSomeTypeToJSONObjectWithSingleField `sameAs` thSomeTypeToEncodingObjectWithSingleField
117 , testProperty "SomeTypeObjectWithSingleField unary" $
118 thSomeTypeLiftToJSONObjectWithSingleField `sameAs1` thSomeTypeLiftToEncodingObjectWithSingleField
119 , testProperty "SomeTypeObjectWithSingleField unary agree" $
120 thSomeTypeToEncodingObjectWithSingleField `sameAs1Agree` thSomeTypeLiftToEncodingObjectWithSingleField
122 , testProperty "OneConstructorDefault" $
123 thOneConstructorToJSONDefault `sameAs` thOneConstructorToEncodingDefault
124 , testProperty "OneConstructorTagged" $
125 thOneConstructorToJSONTagged `sameAs` thOneConstructorToEncodingTagged
127 , testProperty "OptionField" $
128 thOptionFieldToJSON `sameAs` thOptionFieldToEncoding
129 ]
130 ]