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