git.iko.soy/typeable/aeson
on master help sign in
Split Properties tests into multiple files.

The original property testing used a single file to specify all property tests, which caused compilation issues and intermittent Travis CI build failures. This commit breaks the Properties file into multiple files to make it faster to compile. | Properties | GHC | QuickCheck | Clean build/test | properties build/test | |-------------+-------+------------+-----------------------+-----------------------| | single file | 8.4.4 | 2.11.3 | 3m48s / 5m56s / 1m33s | 1m42s / 1m58s / 0m31s | | | | 2.12.6.1 | 3m27s / 5m42s / 0m58s | 1m45s / 2m2s / 0m33s | |-------------+-------+------------+-----------------------+-----------------------| | multi-file | 8.4.4 | 2.11.3 | 2m19s / 4m26s / 0m37s | 0m35s / 0m44s / 0m9s | | | | 2.12.6.1 | 2m20s / 4m26s / 0m37s | 0m36s / 0m45s / 0m10s | (times are in real, user, and sys time)

commit3f553c488c45d617c3e37cc0ada8668847b99e8f authorKevin Quick <kquick@galois.com> dateTue 1 Jan 2019, 19:43 (8 years ago) parent2c144d1
9 files changed+641−529
compare with master
unifiedsplit
aeson.cabal+6 tests/DataFamilies/Properties.hs+2−1 tests/PropUtils.hs+208 tests/Properties.hs+10−528 tests/PropertyGeneric.hs+124 tests/PropertyKeys.hs+43 tests/PropertyRTFunctors.hs+51 tests/PropertyRoundTrip.hs+67 tests/PropertyTH.hs+130
aeson.cabal+6
@@ -197,7 +197,13 @@ test-suite tests
197197 Functions
198198 Instances
199199 Options
200+ PropUtils
200201 Properties
202+ PropertyGeneric
203+ PropertyKeys
204+ PropertyRoundTrip
205+ PropertyRTFunctors
206+ PropertyTH
201207 SerializationFormatSpec
202208 Types
203209 UnitTests
tests/DataFamilies/Properties.hs+2−1
@@ -7,7 +7,8 @@ import Prelude.Compat
77
88import DataFamilies.Encoders
99import DataFamilies.Instances ()
10−import Properties hiding (tests)
10+import PropUtils
11+
1112
1213import Test.Tasty (TestTree, testGroup)
1314import Test.Tasty.QuickCheck (testProperty)
tests/PropUtils.hsnew file+208
@@ -0,0 +1,208 @@
1+{-# LANGUAGE NoImplicitPrelude #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE RankNTypes #-}
4+
5+module PropUtils (module PropUtils) where
6+
7+import Prelude.Compat
8+
9+import Data.Aeson (eitherDecode, encode)
10+import Data.Aeson.Encoding (encodingToLazyByteString)
11+import Data.Aeson.Internal (IResult(..), formatError, ifromJSON, iparse)
12+import qualified Data.Aeson.Internal as I
13+import Data.Aeson.Parser (value)
14+import Data.Aeson.Types
15+import Data.HashMap.Strict (HashMap)
16+import Data.Hashable (Hashable)
17+import Data.Int (Int8)
18+import Data.Map (Map)
19+import Data.Time (ZonedTime)
20+import Encoders
21+import Instances ()
22+import Test.QuickCheck (Arbitrary(..), Property, Testable, (===), (.&&.), counterexample)
23+import Types
24+import qualified Data.Attoparsec.Lazy as L
25+import qualified Data.ByteString.Lazy.Char8 as L
26+import qualified Data.HashMap.Strict as H
27+import qualified Data.Map as Map
28+import qualified Data.Text as T
29+import qualified Data.Vector as V
30+
31+
32+encodeDouble :: Double -> Double -> Property
33+encodeDouble num denom
34+ | isInfinite d || isNaN d = encode d === "null"
35+ | otherwise = (read . L.unpack . encode) d === d
36+ where d = num / denom
37+
38+encodeInteger :: Integer -> Property
39+encodeInteger i = encode i === L.pack (show i)
40+
41+toParseJSON :: (Eq a, Show a) =>
42+ (Value -> Parser a) -> (a -> Value) -> a -> Property
43+toParseJSON parsejson tojson x =
44+ case iparse parsejson . tojson $ x of
45+ IError path msg -> failure "parse" (formatError path msg) x
46+ ISuccess x' -> x === x'
47+
48+toParseJSON1
49+ :: (Eq (f Int), Show (f Int))
50+ => (forall a. LiftParseJSON f a)
51+ -> (forall a. LiftToJSON f a)
52+ -> f Int
53+ -> Property
54+toParseJSON1 parsejson1 tojson1 = toParseJSON parsejson tojson
55+ where
56+ parsejson = parsejson1 parseJSON (listParser parseJSON)
57+ tojson = tojson1 toJSON (listValue toJSON)
58+
59+roundTripEnc :: (FromJSON a, ToJSON a, Show a) =>
60+ (a -> a -> Property) -> a -> a -> Property
61+roundTripEnc eq _ i =
62+ case fmap ifromJSON . L.parse value . encode $ i of
63+ L.Done _ (ISuccess v) -> v `eq` i
64+ L.Done _ (IError path err) -> failure "fromJSON" (formatError path err) i
65+ L.Fail _ _ err -> failure "parse" err i
66+
67+roundTripNoEnc :: (FromJSON a, ToJSON a, Show a) =>
68+ (a -> a -> Property) -> a -> a -> Property
69+roundTripNoEnc eq _ i =
70+ case ifromJSON . toJSON $ i of
71+ (ISuccess v) -> v `eq` i
72+ (IError path err) -> failure "fromJSON" (formatError path err) i
73+
74+roundTripEq :: (Eq a, FromJSON a, ToJSON a, Show a) => a -> a -> Property
75+roundTripEq x y = roundTripEnc (===) x y .&&. roundTripNoEnc (===) x y
76+
77+-- We test keys by encoding HashMap and Map with it
78+roundTripKey
79+ :: (Ord a, Hashable a, FromJSONKey a, ToJSONKey a, Show a)
80+ => a -> HashMap a Int -> Map a Int -> Property
81+roundTripKey _ h m = roundTripEq h h .&&. roundTripEq m m
82+
83+infix 4 ==~
84+(==~) :: (ApproxEq a, Show a) => a -> a -> Property
85+x ==~ y =
86+ counterexample (show x ++ " /= " ++ show y) (x =~ y)
87+
88+toFromJSON :: (Arbitrary a, Eq a, FromJSON a, ToJSON a, Show a) => a -> Property
89+toFromJSON x = case ifromJSON (toJSON x) of
90+ IError path err -> failure "fromJSON" (formatError path err) x
91+ ISuccess x' -> x === x'
92+
93+modifyFailureProp :: String -> String -> Bool
94+modifyFailureProp orig added =
95+ result == Error (added ++ orig)
96+ where
97+ parser = const $ modifyFailure (added ++) $ fail orig
98+ result :: Result ()
99+ result = parse parser ()
100+
101+parserThrowErrorProp :: String -> Property
102+parserThrowErrorProp msg =
103+ result === Error msg
104+ where
105+ parser = const $ parserThrowError [] msg
106+ result :: Result ()
107+ result = parse parser ()
108+
109+-- | Tests (also) that we catch the JSONPath and it has elements in the right order.
110+parserCatchErrorProp :: [String] -> String -> Property
111+parserCatchErrorProp path msg =
112+ result === Success ([I.Key "outer", I.Key "inner"] ++ jsonPath, msg)
113+ where
114+ parser = parserCatchError outer (curry pure)
115+
116+ outer = inner I.<?> I.Key "outer"
117+ inner = parserThrowError jsonPath msg I.<?> I.Key "inner"
118+
119+ result :: Result (I.JSONPath, String)
120+ result = parse (const parser) ()
121+
122+ jsonPath = map (I.Key . T.pack) path
123+
124+-- | Perform a structural comparison of the results of two encoding
125+-- methods. Compares decoded values to account for HashMap-driven
126+-- variation in JSON object key ordering.
127+sameAs :: (a -> Value) -> (a -> Encoding) -> a -> Property
128+sameAs toVal toEnc v =
129+ counterexample (show s) $
130+ eitherDecode s === Right (toVal v)
131+ where
132+ s = encodingToLazyByteString (toEnc v)
133+
134+sameAs1
135+ :: (forall a. LiftToJSON f a)
136+ -> (forall a. LiftToEncoding f a)
137+ -> f Int
138+ -> Property
139+sameAs1 toVal1 toEnc1 v = lhs === rhs
140+ where
141+ rhs = Right $ toVal1 toJSON (listValue toJSON) v
142+ lhs = eitherDecode . encodingToLazyByteString $
143+ toEnc1 toEncoding (listEncoding toEncoding) v
144+
145+sameAs1Agree
146+ :: ToJSON a
147+ => (f a -> Encoding)
148+ -> (forall b. LiftToEncoding f b)
149+ -> f a
150+ -> Property
151+sameAs1Agree toEnc toEnc1 v = rhs === lhs
152+ where
153+ rhs = encodingToLazyByteString $ toEnc v
154+ lhs = encodingToLazyByteString $ toEnc1 toEncoding (listEncoding toEncoding) v
155+
156+type P6 = Product6 Int Bool String (Approx Double) (Int, Approx Double) ()
157+type S4 = Sum4 Int8 ZonedTime T.Text (Map.Map String Int)
158+
159+--------------------------------------------------------------------------------
160+-- Value properties
161+--------------------------------------------------------------------------------
162+
163+-- | Add the formatted @Value@ to the printed counterexample when the property
164+-- fails.
165+checkValue :: Testable a => (Value -> a) -> Value -> Property
166+checkValue prop v = counterexample (L.unpack (encode v)) (prop v)
167+
168+isString :: Value -> Bool
169+isString (String _) = True
170+isString _ = False
171+
172+is2ElemArray :: Value -> Bool
173+is2ElemArray (Array v) = V.length v == 2 && isString (V.head v)
174+is2ElemArray _ = False
175+
176+isTaggedObjectValue :: Value -> Bool
177+isTaggedObjectValue (Object obj) = "tag" `H.member` obj &&
178+ "contents" `H.member` obj
179+isTaggedObjectValue _ = False
180+
181+isNullaryTaggedObject :: Value -> Bool
182+isNullaryTaggedObject obj = isTaggedObject' obj && isObjectWithSingleField obj
183+
184+isTaggedObject :: Value -> Property
185+isTaggedObject = checkValue isTaggedObject'
186+
187+isTaggedObject' :: Value -> Bool
188+isTaggedObject' (Object obj) = "tag" `H.member` obj
189+isTaggedObject' _ = False
190+
191+isObjectWithSingleField :: Value -> Bool
192+isObjectWithSingleField (Object obj) = H.size obj == 1
193+isObjectWithSingleField _ = False
194+
195+-- | is untaggedValue of EitherTextInt
196+isUntaggedValueETI :: Value -> Bool
197+isUntaggedValueETI (String s)
198+ | s == "nonenullary" = True
199+isUntaggedValueETI (Bool _) = True
200+isUntaggedValueETI (Number _) = True
201+isUntaggedValueETI (Array a) = length a == 2
202+isUntaggedValueETI _ = False
203+
204+isEmptyArray :: Value -> Property
205+isEmptyArray = checkValue isEmptyArray'
206+
207+isEmptyArray' :: Value -> Bool
208+isEmptyArray' = (Array mempty ==)
tests/Properties.hs+10−528
@@ -1,231 +1,18 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE FlexibleContexts #-} -- For arbitrary Compose
31{-# LANGUAGE NoImplicitPrelude #-}
4−{-# LANGUAGE OverloadedStrings #-}
5−{-# LANGUAGE RankNTypes #-}
6−{-# LANGUAGE ScopedTypeVariables #-}
72
83module Properties (module Properties) where
94
105import Prelude.Compat
116
12−import Control.Applicative (Const)
13−import Data.Aeson (eitherDecode, encode)
14−import Data.Aeson.Encoding (encodingToLazyByteString)
15−import Data.Aeson.Internal (IResult(..), formatError, ifromJSON, iparse)
16−import qualified Data.Aeson.Internal as I
17−import Data.Aeson.Parser (value)
18−import Data.Aeson.Types
19−import Data.DList (DList)
20−import Data.Functor.Compose (Compose (..))
21−import Data.HashMap.Strict (HashMap)
22−import Data.Hashable (Hashable)
23−import Data.Int (Int8)
24−import Data.List.NonEmpty (NonEmpty)
25−import Data.Map (Map)
26−import Data.Proxy (Proxy)
27−import Data.Ratio (Ratio)
28−import Data.Semigroup (Option(..))
29−import Data.Sequence (Seq)
30−import Data.Tagged (Tagged)
31−import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
32−import Data.Version (Version)
33−import Encoders
347import Instances ()
35−import Numeric.Natural (Natural)
368import Test.Tasty (TestTree, testGroup)
379import Test.Tasty.QuickCheck (testProperty)
38−import Test.QuickCheck (Arbitrary(..), Property, Testable, (===), (.&&.), counterexample)
39−import Types
40−import qualified Data.Attoparsec.Lazy as L
41−import qualified Data.ByteString.Lazy.Char8 as L
42−import qualified Data.HashMap.Strict as H
43−import qualified Data.Map as Map
44−import qualified Data.Text as T
45−import qualified Data.Text.Lazy as LT
46−import qualified Data.UUID.Types as UUID
47−import qualified Data.Vector as V
48−
49−encodeDouble :: Double -> Double -> Property
50−encodeDouble num denom
51− | isInfinite d || isNaN d = encode d === "null"
52− | otherwise = (read . L.unpack . encode) d === d
53− where d = num / denom
54−
55−encodeInteger :: Integer -> Property
56−encodeInteger i = encode i === L.pack (show i)
57−
58−toParseJSON :: (Eq a, Show a) =>
59− (Value -> Parser a) -> (a -> Value) -> a -> Property
60−toParseJSON parsejson tojson x =
61− case iparse parsejson . tojson $ x of
62− IError path msg -> failure "parse" (formatError path msg) x
63− ISuccess x' -> x === x'
64−
65−toParseJSON1
66− :: (Eq (f Int), Show (f Int))
67− => (forall a. LiftParseJSON f a)
68− -> (forall a. LiftToJSON f a)
69− -> f Int
70− -> Property
71−toParseJSON1 parsejson1 tojson1 = toParseJSON parsejson tojson
72− where
73− parsejson = parsejson1 parseJSON (listParser parseJSON)
74− tojson = tojson1 toJSON (listValue toJSON)
75−
76−roundTripEnc :: (FromJSON a, ToJSON a, Show a) =>
77− (a -> a -> Property) -> a -> a -> Property
78−roundTripEnc eq _ i =
79− case fmap ifromJSON . L.parse value . encode $ i of
80− L.Done _ (ISuccess v) -> v `eq` i
81− L.Done _ (IError path err) -> failure "fromJSON" (formatError path err) i
82− L.Fail _ _ err -> failure "parse" err i
83−
84−roundTripNoEnc :: (FromJSON a, ToJSON a, Show a) =>
85− (a -> a -> Property) -> a -> a -> Property
86−roundTripNoEnc eq _ i =
87− case ifromJSON . toJSON $ i of
88− (ISuccess v) -> v `eq` i
89− (IError path err) -> failure "fromJSON" (formatError path err) i
90−
91−roundTripEq :: (Eq a, FromJSON a, ToJSON a, Show a) => a -> a -> Property
92−roundTripEq x y = roundTripEnc (===) x y .&&. roundTripNoEnc (===) x y
93−
94−-- We test keys by encoding HashMap and Map with it
95−roundTripKey
96− :: (Ord a, Hashable a, FromJSONKey a, ToJSONKey a, Show a)
97− => a -> HashMap a Int -> Map a Int -> Property
98−roundTripKey _ h m = roundTripEq h h .&&. roundTripEq m m
99−
100−infix 4 ==~
101−(==~) :: (ApproxEq a, Show a) => a -> a -> Property
102−x ==~ y =
103− counterexample (show x ++ " /= " ++ show y) (x =~ y)
104−
105−toFromJSON :: (Arbitrary a, Eq a, FromJSON a, ToJSON a, Show a) => a -> Property
106−toFromJSON x = case ifromJSON (toJSON x) of
107− IError path err -> failure "fromJSON" (formatError path err) x
108− ISuccess x' -> x === x'
109−
110−modifyFailureProp :: String -> String -> Bool
111−modifyFailureProp orig added =
112− result == Error (added ++ orig)
113− where
114− parser = const $ modifyFailure (added ++) $ fail orig
115− result :: Result ()
116− result = parse parser ()
117−
118−parserThrowErrorProp :: String -> Property
119−parserThrowErrorProp msg =
120− result === Error msg
121− where
122− parser = const $ parserThrowError [] msg
123− result :: Result ()
124− result = parse parser ()
125−
126−-- | Tests (also) that we catch the JSONPath and it has elements in the right order.
127−parserCatchErrorProp :: [String] -> String -> Property
128−parserCatchErrorProp path msg =
129− result === Success ([I.Key "outer", I.Key "inner"] ++ jsonPath, msg)
130− where
131− parser = parserCatchError outer (curry pure)
132−
133− outer = inner I.<?> I.Key "outer"
134− inner = parserThrowError jsonPath msg I.<?> I.Key "inner"
135−
136− result :: Result (I.JSONPath, String)
137− result = parse (const parser) ()
138−
139− jsonPath = map (I.Key . T.pack) path
140−
141−-- | Perform a structural comparison of the results of two encoding
142−-- methods. Compares decoded values to account for HashMap-driven
143−-- variation in JSON object key ordering.
144−sameAs :: (a -> Value) -> (a -> Encoding) -> a -> Property
145−sameAs toVal toEnc v =
146− counterexample (show s) $
147− eitherDecode s === Right (toVal v)
148− where
149− s = encodingToLazyByteString (toEnc v)
150−
151−sameAs1
152− :: (forall a. LiftToJSON f a)
153− -> (forall a. LiftToEncoding f a)
154− -> f Int
155− -> Property
156−sameAs1 toVal1 toEnc1 v = lhs === rhs
157− where
158− rhs = Right $ toVal1 toJSON (listValue toJSON) v
159− lhs = eitherDecode . encodingToLazyByteString $
160− toEnc1 toEncoding (listEncoding toEncoding) v
161−
162−sameAs1Agree
163− :: ToJSON a
164− => (f a -> Encoding)
165− -> (forall b. LiftToEncoding f b)
166− -> f a
167− -> Property
168−sameAs1Agree toEnc toEnc1 v = rhs === lhs
169− where
170− rhs = encodingToLazyByteString $ toEnc v
171− lhs = encodingToLazyByteString $ toEnc1 toEncoding (listEncoding toEncoding) v
172−
173−type P6 = Product6 Int Bool String (Approx Double) (Int, Approx Double) ()
174−type S4 = Sum4 Int8 ZonedTime T.Text (Map.Map String Int)
175−
176−--------------------------------------------------------------------------------
177−-- Value properties
178−--------------------------------------------------------------------------------
179−
180−-- | Add the formatted @Value@ to the printed counterexample when the property
181−-- fails.
182−checkValue :: Testable a => (Value -> a) -> Value -> Property
183−checkValue prop v = counterexample (L.unpack (encode v)) (prop v)
184−
185−isString :: Value -> Bool
186−isString (String _) = True
187−isString _ = False
188−
189−is2ElemArray :: Value -> Bool
190−is2ElemArray (Array v) = V.length v == 2 && isString (V.head v)
191−is2ElemArray _ = False
192−
193−isTaggedObjectValue :: Value -> Bool
194−isTaggedObjectValue (Object obj) = "tag" `H.member` obj &&
195− "contents" `H.member` obj
196−isTaggedObjectValue _ = False
197−
198−isNullaryTaggedObject :: Value -> Bool
199−isNullaryTaggedObject obj = isTaggedObject' obj && isObjectWithSingleField obj
200−
201−isTaggedObject :: Value -> Property
202−isTaggedObject = checkValue isTaggedObject'
203−
204−isTaggedObject' :: Value -> Bool
205−isTaggedObject' (Object obj) = "tag" `H.member` obj
206−isTaggedObject' _ = False
207−
208−isObjectWithSingleField :: Value -> Bool
209−isObjectWithSingleField (Object obj) = H.size obj == 1
210−isObjectWithSingleField _ = False
211−
212−-- | is untaggedValue of EitherTextInt
213−isUntaggedValueETI :: Value -> Bool
214−isUntaggedValueETI (String s)
215− | s == "nonenullary" = True
216−isUntaggedValueETI (Bool _) = True
217−isUntaggedValueETI (Number _) = True
218−isUntaggedValueETI (Array a) = length a == 2
219−isUntaggedValueETI _ = False
220−
221−isEmptyArray :: Value -> Property
222−isEmptyArray = checkValue isEmptyArray'
223−
224−isEmptyArray' :: Value -> Bool
225−isEmptyArray' = (Array mempty ==)
226−
227−
228−--------------------------------------------------------------------------------
10+import Test.QuickCheck (Property)
11+import PropUtils
12+import PropertyGeneric
13+import PropertyKeys
14+import PropertyRoundTrip
15+import PropertyTH
22916
23017
23118tests :: TestTree
@@ -234,98 +21,8 @@ tests = testGroup "properties" [
23421 testProperty "encodeDouble" encodeDouble
23522 , testProperty "encodeInteger" encodeInteger
23623 ]
237− , testGroup "roundTrip" [
238− testProperty "Bool" $ roundTripEq True
239− , testProperty "Double" $ roundTripEq (1 :: Approx Double)
240− , testProperty "Int" $ roundTripEq (1 :: Int)
241− , testProperty "NonEmpty Char" $ roundTripEq (undefined :: NonEmpty Char)
242− , testProperty "Integer" $ roundTripEq (1 :: Integer)
243− , testProperty "String" $ roundTripEq ("" :: String)
244− , testProperty "Text" $ roundTripEq T.empty
245− , testProperty "Lazy Text" $ roundTripEq LT.empty
246− , testProperty "Foo" $ roundTripEq (undefined :: Foo)
247− , testProperty "Day" $ roundTripEq (undefined :: Day)
248− , testProperty "BCE Day" $ roundTripEq (undefined :: BCEDay)
249− , testProperty "DotNetTime" $ roundTripEq (undefined :: Approx DotNetTime)
250− , testProperty "LocalTime" $ roundTripEq (undefined :: LocalTime)
251− , testProperty "TimeOfDay" $ roundTripEq (undefined :: TimeOfDay)
252− , testProperty "UTCTime" $ roundTripEq (undefined :: UTCTime)
253− , testProperty "ZonedTime" $ roundTripEq (undefined :: ZonedTime)
254− , testProperty "NominalDiffTime" $ roundTripEq (undefined :: NominalDiffTime)
255− , testProperty "DiffTime" $ roundTripEq (undefined :: DiffTime)
256− , testProperty "Version" $ roundTripEq (undefined :: Version)
257− , testProperty "Natural" $ roundTripEq (undefined :: Natural)
258− , testProperty "Proxy" $ roundTripEq (undefined :: Proxy Int)
259− , testProperty "Tagged" $ roundTripEq (undefined :: Tagged Int Char)
260− , testProperty "Const" $ roundTripEq (undefined :: Const Int Char)
261− , testProperty "DList" $ roundTripEq (undefined :: DList Int)
262− , testProperty "Seq" $ roundTripEq (undefined :: Seq Int)
263− , testProperty "Rational" $ roundTripEq (undefined :: Rational)
264− , testProperty "Ratio Int" $ roundTripEq (undefined :: Ratio Int)
265− , testProperty "UUID" $ roundTripEq UUID.nil
266− , testGroup "functors"
267− [ testProperty "Identity Char" $ roundTripEq (undefined :: I Int)
268−
269− , testProperty "Identity Char" $ roundTripEq (undefined :: I Char)
270− , testProperty "Identity [Char]" $ roundTripEq (undefined :: I String)
271− , testProperty "[Identity Char]" $ roundTripEq (undefined :: [I Char])
272−
273− , testProperty "Compose I I Int" $ roundTripEq (undefined :: LogScaled (Compose I I Int))
274− , testProperty "Compose [] I Int" $ roundTripEq (undefined :: LogScaled (Compose [] I Int))
275− , testProperty "Compose I [] Int" $ roundTripEq (undefined :: LogScaled (Compose I [] Int))
276− , testProperty "Compose [] [] Int" $ roundTripEq (undefined :: LogScaled (Compose [] [] Int))
277−
278− , testProperty "Compose I I Char" $ roundTripEq (undefined :: LogScaled (Compose I I Char))
279− , testProperty "Compose [] I Char" $ roundTripEq (undefined :: LogScaled (Compose [] I Char))
280− , testProperty "Compose I [] Char" $ roundTripEq (undefined :: LogScaled (Compose I [] Char))
281− , testProperty "Compose [] [] Char" $ roundTripEq (undefined :: LogScaled (Compose [] [] Char))
282−
283− , testProperty "Compose3 I I I Char" $ roundTripEq (undefined :: LogScaled (Compose3 I I I Char))
284− , testProperty "Compose3 I [] I Char" $ roundTripEq (undefined :: LogScaled (Compose3 I [] I Char))
285− , testProperty "Compose3 I I [] Char" $ roundTripEq (undefined :: LogScaled (Compose3 I I [] Char))
286− , testProperty "Compose3 I [] [] Char" $ roundTripEq (undefined :: LogScaled (Compose3 I [] [] Char))
287− , testProperty "Compose3 [] I I Char" $ roundTripEq (undefined :: LogScaled (Compose3 [] I I Char))
288− , testProperty "Compose3 [] [] I Char" $ roundTripEq (undefined :: LogScaled (Compose3 [] [] I Char))
289− , testProperty "Compose3 [] I [] Char" $ roundTripEq (undefined :: LogScaled (Compose3 [] I [] Char))
290− , testProperty "Compose3 [] [] [] Char" $ roundTripEq (undefined :: LogScaled (Compose3 [] [] [] Char))
291−
292− , testProperty "Compose3' I I I Char" $ roundTripEq (undefined :: LogScaled (Compose3' I I I Char))
293− , testProperty "Compose3' I [] I Char" $ roundTripEq (undefined :: LogScaled (Compose3' I [] I Char))
294− , testProperty "Compose3' I I [] Char" $ roundTripEq (undefined :: LogScaled (Compose3' I I [] Char))
295− , testProperty "Compose3' I [] [] Char" $ roundTripEq (undefined :: LogScaled (Compose3' I [] [] Char))
296− , testProperty "Compose3' [] I I Char" $ roundTripEq (undefined :: LogScaled (Compose3' [] I I Char))
297− , testProperty "Compose3' [] [] I Char" $ roundTripEq (undefined :: LogScaled (Compose3' [] [] I Char))
298− , testProperty "Compose3' [] I [] Char" $ roundTripEq (undefined :: LogScaled (Compose3' [] I [] Char))
299− , testProperty "Compose3' [] [] [] Char" $ roundTripEq (undefined :: LogScaled (Compose3' [] [] [] Char))
300− ]
301− , testGroup "ghcGenerics" [
302− testProperty "OneConstructor" $ roundTripEq OneConstructor
303− , testProperty "Product2" $ roundTripEq (undefined :: Product2 Int Bool)
304− , testProperty "Product6" $ roundTripEq (undefined :: P6)
305− , testProperty "Sum4" $ roundTripEq (undefined :: S4)
306− ]
307− ]
308− , testGroup "roundTrip Key"
309− [ testProperty "Bool" $ roundTripKey True
310− , testProperty "Text" $ roundTripKey (undefined :: T.Text)
311− , testProperty "String" $ roundTripKey (undefined :: String)
312− , testProperty "Int" $ roundTripKey (undefined :: Int)
313− , testProperty "[Text]" $ roundTripKey (undefined :: LogScaled [T.Text])
314− , testProperty "(Int,Char)" $ roundTripKey (undefined :: (Int,Char))
315− , testProperty "Integer" $ roundTripKey (undefined :: Integer)
316− , testProperty "Natural" $ roundTripKey (undefined :: Natural)
317− , testProperty "Float" $ roundTripKey (undefined :: Float)
318− , testProperty "Double" $ roundTripKey (undefined :: Double)
319−#if MIN_VERSION_base(4,7,0)
320− , testProperty "Day" $ roundTripKey (undefined :: Day)
321− , testProperty "LocalTime" $ roundTripKey (undefined :: LocalTime)
322− , testProperty "TimeOfDay" $ roundTripKey (undefined :: TimeOfDay)
323− , testProperty "UTCTime" $ roundTripKey (undefined :: UTCTime)
324−#endif
325− , testProperty "Version" $ roundTripKey (undefined :: Version)
326− , testProperty "Lazy Text" $ roundTripKey (undefined :: LT.Text)
327− , testProperty "UUID" $ roundTripKey UUID.nil
328− ]
24+ , roundTripTests
25+ , keysTests
32926 , testGroup "toFromJSON" [
33027 testProperty "Integer" (toFromJSON :: Integer -> Property)
33128 , testProperty "Double" (toFromJSON :: Double -> Property)
@@ -338,221 +35,6 @@ tests = testGroup "properties" [
33835 , testProperty "parserThrowError" parserThrowErrorProp
33936 , testProperty "parserCatchError" parserCatchErrorProp
34037 ]
341− , testGroup "generic" [
342− testGroup "toJSON" [
343− testGroup "Nullary" [
344− testProperty "string" (isString . gNullaryToJSONString)
345− , testProperty "2ElemArray" (is2ElemArray . gNullaryToJSON2ElemArray)
346− , testProperty "TaggedObject" (isNullaryTaggedObject . gNullaryToJSONTaggedObject)
347− , testProperty "ObjectWithSingleField" (isObjectWithSingleField . gNullaryToJSONObjectWithSingleField)
348− , testGroup "roundTrip" [
349− testProperty "string" (toParseJSON gNullaryParseJSONString gNullaryToJSONString)
350− , testProperty "2ElemArray" (toParseJSON gNullaryParseJSON2ElemArray gNullaryToJSON2ElemArray)
351− , testProperty "TaggedObject" (toParseJSON gNullaryParseJSONTaggedObject gNullaryToJSONTaggedObject)
352− , testProperty "ObjectWithSingleField" (toParseJSON gNullaryParseJSONObjectWithSingleField gNullaryToJSONObjectWithSingleField)
353− ]
354− ]
355− , testGroup "EitherTextInt" [
356− testProperty "UntaggedValue" (isUntaggedValueETI . gEitherTextIntToJSONUntaggedValue)
357− , testProperty "roundtrip" (toParseJSON gEitherTextIntParseJSONUntaggedValue gEitherTextIntToJSONUntaggedValue)
358− ]
359− , testGroup "SomeType" [
360− testProperty "2ElemArray" (is2ElemArray . gSomeTypeToJSON2ElemArray)
361− , testProperty "TaggedObject" (isTaggedObject . gSomeTypeToJSONTaggedObject)
362− , testProperty "ObjectWithSingleField" (isObjectWithSingleField . gSomeTypeToJSONObjectWithSingleField)
363− , testGroup "roundTrip" [
364− testProperty "2ElemArray" (toParseJSON gSomeTypeParseJSON2ElemArray gSomeTypeToJSON2ElemArray)
365− , testProperty "TaggedObject" (toParseJSON gSomeTypeParseJSONTaggedObject gSomeTypeToJSONTaggedObject)
366− , testProperty "ObjectWithSingleField" (toParseJSON gSomeTypeParseJSONObjectWithSingleField gSomeTypeToJSONObjectWithSingleField)
367−
368−#if __GLASGOW_HASKELL__ >= 706
369− , testProperty "2ElemArray unary" (toParseJSON1 gSomeTypeLiftParseJSON2ElemArray gSomeTypeLiftToJSON2ElemArray)
370− , testProperty "TaggedObject unary" (toParseJSON1 gSomeTypeLiftParseJSONTaggedObject gSomeTypeLiftToJSONTaggedObject)
371− , testProperty "ObjectWithSingleField unary" (toParseJSON1 gSomeTypeLiftParseJSONObjectWithSingleField gSomeTypeLiftToJSONObjectWithSingleField)
372−#endif
373− ]
374− ]
375− , testGroup "OneConstructor" [
376− testProperty "default" (isEmptyArray . gOneConstructorToJSONDefault)
377− , testProperty "Tagged" (isTaggedObject . gOneConstructorToJSONTagged)
378− , testGroup "roundTrip" [
379− testProperty "default" (toParseJSON gOneConstructorParseJSONDefault gOneConstructorToJSONDefault)
380− , testProperty "Tagged" (toParseJSON gOneConstructorParseJSONTagged gOneConstructorToJSONTagged)
381− ]
382− ]
383− , testGroup "OptionField" [
384− testProperty "like Maybe" $
385− \x -> gOptionFieldToJSON (OptionField (Option x)) === thMaybeFieldToJSON (MaybeField x)
386− , testProperty "roundTrip" (toParseJSON gOptionFieldParseJSON gOptionFieldToJSON)
387− ]
388− ]
389− , testGroup "toEncoding" [
390− testProperty "NullaryString" $
391− gNullaryToJSONString `sameAs` gNullaryToEncodingString
392− , testProperty "Nullary2ElemArray" $
393− gNullaryToJSON2ElemArray `sameAs` gNullaryToEncoding2ElemArray
394− , testProperty "NullaryTaggedObject" $
395− gNullaryToJSONTaggedObject `sameAs` gNullaryToEncodingTaggedObject
396− , testProperty "NullaryObjectWithSingleField" $
397− gNullaryToJSONObjectWithSingleField `sameAs`
398− gNullaryToEncodingObjectWithSingleField
399− -- , testProperty "ApproxUnwrap" $
400− -- gApproxToJSONUnwrap `sameAs` gApproxToEncodingUnwrap
401− , testProperty "ApproxDefault" $
402− gApproxToJSONDefault `sameAs` gApproxToEncodingDefault
403−
404− , testProperty "EitherTextInt UntaggedValue" $
405− gEitherTextIntToJSONUntaggedValue `sameAs` gEitherTextIntToEncodingUntaggedValue
406−
407− , testProperty "SomeType2ElemArray" $
408− gSomeTypeToJSON2ElemArray `sameAs` gSomeTypeToEncoding2ElemArray
409−#if __GLASGOW_HASKELL__ >= 706
410− , testProperty "SomeType2ElemArray unary" $
411− gSomeTypeLiftToJSON2ElemArray `sameAs1` gSomeTypeLiftToEncoding2ElemArray
412− , testProperty "SomeType2ElemArray unary agree" $
413− gSomeTypeToEncoding2ElemArray `sameAs1Agree` gSomeTypeLiftToEncoding2ElemArray
414−#endif
415−
416− , testProperty "SomeTypeTaggedObject" $
417− gSomeTypeToJSONTaggedObject `sameAs` gSomeTypeToEncodingTaggedObject
418−#if __GLASGOW_HASKELL__ >= 706
419− , testProperty "SomeTypeTaggedObject unary" $
420− gSomeTypeLiftToJSONTaggedObject `sameAs1` gSomeTypeLiftToEncodingTaggedObject
421− , testProperty "SomeTypeTaggedObject unary agree" $
422− gSomeTypeToEncodingTaggedObject `sameAs1Agree` gSomeTypeLiftToEncodingTaggedObject
423−#endif
424−
425− , testProperty "SomeTypeObjectWithSingleField" $
426− gSomeTypeToJSONObjectWithSingleField `sameAs` gSomeTypeToEncodingObjectWithSingleField
427−#if __GLASGOW_HASKELL__ >= 706
428− , testProperty "SomeTypeObjectWithSingleField unary" $
429− gSomeTypeLiftToJSONObjectWithSingleField `sameAs1` gSomeTypeLiftToEncodingObjectWithSingleField
430− , testProperty "SomeTypeObjectWithSingleField unary agree" $
431− gSomeTypeToEncodingObjectWithSingleField `sameAs1Agree` gSomeTypeLiftToEncodingObjectWithSingleField
432−#endif
433−
434− , testProperty "SomeTypeOmitNothingFields" $
435− gSomeTypeToJSONOmitNothingFields `sameAs` gSomeTypeToEncodingOmitNothingFields
436−
437− , testProperty "OneConstructorDefault" $
438− gOneConstructorToJSONDefault `sameAs` gOneConstructorToEncodingDefault
439− , testProperty "OneConstructorTagged" $
440− gOneConstructorToJSONTagged `sameAs` gOneConstructorToEncodingTagged
441−
442− , testProperty "OptionField" $
443− gOptionFieldToJSON `sameAs` gOptionFieldToEncoding
444− ]
445− ]
446− , testGroup "template-haskell" [
447− testGroup "toJSON" [
448− testGroup "Nullary" [
449− testProperty "string" (isString . thNullaryToJSONString)
450− , testProperty "2ElemArray" (is2ElemArray . thNullaryToJSON2ElemArray)
451− , testProperty "TaggedObject" (isNullaryTaggedObject . thNullaryToJSONTaggedObject)
452− , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thNullaryToJSONObjectWithSingleField)
453−
454− , testGroup "roundTrip" [
455− testProperty "string" (toParseJSON thNullaryParseJSONString thNullaryToJSONString)
456− , testProperty "2ElemArray" (toParseJSON thNullaryParseJSON2ElemArray thNullaryToJSON2ElemArray)
457− , testProperty "TaggedObject" (toParseJSON thNullaryParseJSONTaggedObject thNullaryToJSONTaggedObject)
458− , testProperty "ObjectWithSingleField" (toParseJSON thNullaryParseJSONObjectWithSingleField thNullaryToJSONObjectWithSingleField)
459− ]
460− ]
461− , testGroup "EitherTextInt" [
462− testProperty "UntaggedValue" (isUntaggedValueETI . thEitherTextIntToJSONUntaggedValue)
463− , testProperty "roundtrip" (toParseJSON thEitherTextIntParseJSONUntaggedValue thEitherTextIntToJSONUntaggedValue)
464− ]
465− , testGroup "SomeType" [
466− testProperty "2ElemArray" (is2ElemArray . thSomeTypeToJSON2ElemArray)
467− , testProperty "TaggedObject" (isTaggedObject . thSomeTypeToJSONTaggedObject)
468− , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thSomeTypeToJSONObjectWithSingleField)
469− , testGroup "roundTrip" [
470− testProperty "2ElemArray" (toParseJSON thSomeTypeParseJSON2ElemArray thSomeTypeToJSON2ElemArray)
471− , testProperty "TaggedObject" (toParseJSON thSomeTypeParseJSONTaggedObject thSomeTypeToJSONTaggedObject)
472− , testProperty "ObjectWithSingleField" (toParseJSON thSomeTypeParseJSONObjectWithSingleField thSomeTypeToJSONObjectWithSingleField)
473−
474− , testProperty "2ElemArray unary" (toParseJSON1 thSomeTypeLiftParseJSON2ElemArray thSomeTypeLiftToJSON2ElemArray)
475− , testProperty "TaggedObject unary" (toParseJSON1 thSomeTypeLiftParseJSONTaggedObject thSomeTypeLiftToJSONTaggedObject)
476− , testProperty "ObjectWithSingleField unary" (toParseJSON1 thSomeTypeLiftParseJSONObjectWithSingleField thSomeTypeLiftToJSONObjectWithSingleField)
477−
478− ]
479− ]
480− , testGroup "Approx" [
481− testProperty "string" (isString . thApproxToJSONUnwrap)
482− , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thApproxToJSONDefault)
483− , testGroup "roundTrip" [
484− testProperty "string" (toParseJSON thApproxParseJSONUnwrap thApproxToJSONUnwrap)
485− , testProperty "ObjectWithSingleField" (toParseJSON thApproxParseJSONDefault thApproxToJSONDefault)
486− ]
487− ]
488− , testGroup "GADT" [
489− testProperty "string" (isString . thGADTToJSONUnwrap)
490− , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thGADTToJSONDefault)
491− , testGroup "roundTrip" [
492− testProperty "string" (toParseJSON thGADTParseJSONUnwrap thGADTToJSONUnwrap)
493− , testProperty "ObjectWithSingleField" (toParseJSON thGADTParseJSONDefault thGADTToJSONDefault)
494− ]
495− ]
496− , testGroup "OneConstructor" [
497− testProperty "default" (isEmptyArray . thOneConstructorToJSONDefault)
498− , testProperty "Tagged" (isTaggedObject . thOneConstructorToJSONTagged)
499− , testGroup "roundTrip" [
500− testProperty "default" (toParseJSON thOneConstructorParseJSONDefault thOneConstructorToJSONDefault)
501− , testProperty "Tagged" (toParseJSON thOneConstructorParseJSONTagged thOneConstructorToJSONTagged)
502− ]
503− ]
504− , testGroup "OptionField" [
505− testProperty "like Maybe" $
506− \x -> thOptionFieldToJSON (OptionField (Option x)) === thMaybeFieldToJSON (MaybeField x)
507− , testProperty "roundTrip" (toParseJSON thOptionFieldParseJSON thOptionFieldToJSON)
508− ]
509− ]
510− , testGroup "toEncoding" [
511− testProperty "NullaryString" $
512− thNullaryToJSONString `sameAs` thNullaryToEncodingString
513− , testProperty "Nullary2ElemArray" $
514− thNullaryToJSON2ElemArray `sameAs` thNullaryToEncoding2ElemArray
515− , testProperty "NullaryTaggedObject" $
516− thNullaryToJSONTaggedObject `sameAs` thNullaryToEncodingTaggedObject
517− , testProperty "NullaryObjectWithSingleField" $
518− thNullaryToJSONObjectWithSingleField `sameAs`
519− thNullaryToEncodingObjectWithSingleField
520− , testProperty "ApproxUnwrap" $
521− thApproxToJSONUnwrap `sameAs` thApproxToEncodingUnwrap
522− , testProperty "ApproxDefault" $
523− thApproxToJSONDefault `sameAs` thApproxToEncodingDefault
524−
525− , testProperty "EitherTextInt UntaggedValue" $
526− thEitherTextIntToJSONUntaggedValue `sameAs` thEitherTextIntToEncodingUntaggedValue
527−
528− , testProperty "SomeType2ElemArray" $
529− thSomeTypeToJSON2ElemArray `sameAs` thSomeTypeToEncoding2ElemArray
530− , testProperty "SomeType2ElemArray unary" $
531− thSomeTypeLiftToJSON2ElemArray `sameAs1` thSomeTypeLiftToEncoding2ElemArray
532− , testProperty "SomeType2ElemArray unary agree" $
533− thSomeTypeToEncoding2ElemArray `sameAs1Agree` thSomeTypeLiftToEncoding2ElemArray
534−
535− , testProperty "SomeTypeTaggedObject" $
536− thSomeTypeToJSONTaggedObject `sameAs` thSomeTypeToEncodingTaggedObject
537− , testProperty "SomeTypeTaggedObject unary" $
538− thSomeTypeLiftToJSONTaggedObject `sameAs1` thSomeTypeLiftToEncodingTaggedObject
539− , testProperty "SomeTypeTaggedObject unary agree" $
540− thSomeTypeToEncodingTaggedObject `sameAs1Agree` thSomeTypeLiftToEncodingTaggedObject
541−
542− , testProperty "SomeTypeObjectWithSingleField" $
543− thSomeTypeToJSONObjectWithSingleField `sameAs` thSomeTypeToEncodingObjectWithSingleField
544− , testProperty "SomeTypeObjectWithSingleField unary" $
545− thSomeTypeLiftToJSONObjectWithSingleField `sameAs1` thSomeTypeLiftToEncodingObjectWithSingleField
546− , testProperty "SomeTypeObjectWithSingleField unary agree" $
547− thSomeTypeToEncodingObjectWithSingleField `sameAs1Agree` thSomeTypeLiftToEncodingObjectWithSingleField
548−
549− , testProperty "OneConstructorDefault" $
550− thOneConstructorToJSONDefault `sameAs` thOneConstructorToEncodingDefault
551− , testProperty "OneConstructorTagged" $
552− thOneConstructorToJSONTagged `sameAs` thOneConstructorToEncodingTagged
553−
554− , testProperty "OptionField" $
555− thOptionFieldToJSON `sameAs` thOptionFieldToEncoding
556− ]
557− ]
38+ , genericTests
39+ , templateHaskellTests
55840 ]
tests/PropertyGeneric.hsnew file+124
@@ -0,0 +1,124 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE NoImplicitPrelude #-}
3+
4+module PropertyGeneric ( genericTests ) where
5+
6+import Prelude.Compat
7+
8+import Data.Semigroup (Option(..))
9+import Encoders
10+import Instances ()
11+import Test.Tasty (TestTree, testGroup)
12+import Test.Tasty.QuickCheck (testProperty)
13+import Test.QuickCheck ( (===) )
14+import Types
15+import PropUtils
16+
17+
18+genericTests :: TestTree
19+genericTests =
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)
46+
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
82+
83+ , testProperty "EitherTextInt UntaggedValue" $
84+ gEitherTextIntToJSONUntaggedValue `sameAs` gEitherTextIntToEncodingUntaggedValue
85+
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
94+
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
103+
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
112+
113+ , testProperty "SomeTypeOmitNothingFields" $
114+ gSomeTypeToJSONOmitNothingFields `sameAs` gSomeTypeToEncodingOmitNothingFields
115+
116+ , testProperty "OneConstructorDefault" $
117+ gOneConstructorToJSONDefault `sameAs` gOneConstructorToEncodingDefault
118+ , testProperty "OneConstructorTagged" $
119+ gOneConstructorToJSONTagged `sameAs` gOneConstructorToEncodingTagged
120+
121+ , testProperty "OptionField" $
122+ gOptionFieldToJSON `sameAs` gOptionFieldToEncoding
123+ ]
124+ ]
tests/PropertyKeys.hsnew file+43
@@ -0,0 +1,43 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE NoImplicitPrelude #-}
3+
4+module PropertyKeys ( keysTests ) where
5+
6+import Prelude.Compat
7+
8+import Data.Time (Day, LocalTime, TimeOfDay, UTCTime)
9+import Data.Version (Version)
10+import Instances ()
11+import Numeric.Natural (Natural)
12+import Test.Tasty (TestTree, testGroup)
13+import Test.Tasty.QuickCheck (testProperty)
14+import Types
15+import qualified Data.Text as T
16+import qualified Data.Text.Lazy as LT
17+import qualified Data.UUID.Types as UUID
18+import PropUtils
19+
20+
21+keysTests :: TestTree
22+keysTests =
23+ testGroup "roundTrip Key"
24+ [ testProperty "Bool" $ roundTripKey True
25+ , testProperty "Text" $ roundTripKey (undefined :: T.Text)
26+ , testProperty "String" $ roundTripKey (undefined :: String)
27+ , testProperty "Int" $ roundTripKey (undefined :: Int)
28+ , testProperty "[Text]" $ roundTripKey (undefined :: LogScaled [T.Text])
29+ , testProperty "(Int,Char)" $ roundTripKey (undefined :: (Int,Char))
30+ , testProperty "Integer" $ roundTripKey (undefined :: Integer)
31+ , testProperty "Natural" $ roundTripKey (undefined :: Natural)
32+ , testProperty "Float" $ roundTripKey (undefined :: Float)
33+ , testProperty "Double" $ roundTripKey (undefined :: Double)
34+#if MIN_VERSION_base(4,7,0)
35+ , testProperty "Day" $ roundTripKey (undefined :: Day)
36+ , testProperty "LocalTime" $ roundTripKey (undefined :: LocalTime)
37+ , testProperty "TimeOfDay" $ roundTripKey (undefined :: TimeOfDay)
38+ , testProperty "UTCTime" $ roundTripKey (undefined :: UTCTime)
39+#endif
40+ , testProperty "Version" $ roundTripKey (undefined :: Version)
41+ , testProperty "Lazy Text" $ roundTripKey (undefined :: LT.Text)
42+ , testProperty "UUID" $ roundTripKey UUID.nil
43+ ]
tests/PropertyRTFunctors.hsnew file+51
@@ -0,0 +1,51 @@
1+{-# LANGUAGE NoImplicitPrelude #-}
2+
3+module PropertyRTFunctors ( roundTripFunctorsTests ) where
4+
5+import Prelude.Compat
6+
7+import Data.Functor.Compose (Compose (..))
8+import Instances ()
9+import Test.Tasty (TestTree, testGroup)
10+import Test.Tasty.QuickCheck (testProperty)
11+import Types
12+import PropUtils
13+
14+
15+roundTripFunctorsTests :: TestTree
16+roundTripFunctorsTests =
17+ testGroup "functors"
18+ [ testProperty "Identity Char" $ roundTripEq (undefined :: I Int)
19+
20+ , testProperty "Identity Char" $ roundTripEq (undefined :: I Char)
21+ , testProperty "Identity [Char]" $ roundTripEq (undefined :: I String)
22+ , testProperty "[Identity Char]" $ roundTripEq (undefined :: [I Char])
23+
24+ , testProperty "Compose I I Int" $ roundTripEq (undefined :: LogScaled (Compose I I Int))
25+ , testProperty "Compose [] I Int" $ roundTripEq (undefined :: LogScaled (Compose [] I Int))
26+ , testProperty "Compose I [] Int" $ roundTripEq (undefined :: LogScaled (Compose I [] Int))
27+ , testProperty "Compose [] [] Int" $ roundTripEq (undefined :: LogScaled (Compose [] [] Int))
28+
29+ , testProperty "Compose I I Char" $ roundTripEq (undefined :: LogScaled (Compose I I Char))
30+ , testProperty "Compose [] I Char" $ roundTripEq (undefined :: LogScaled (Compose [] I Char))
31+ , testProperty "Compose I [] Char" $ roundTripEq (undefined :: LogScaled (Compose I [] Char))
32+ , testProperty "Compose [] [] Char" $ roundTripEq (undefined :: LogScaled (Compose [] [] Char))
33+
34+ , testProperty "Compose3 I I I Char" $ roundTripEq (undefined :: LogScaled (Compose3 I I I Char))
35+ , testProperty "Compose3 I [] I Char" $ roundTripEq (undefined :: LogScaled (Compose3 I [] I Char))
36+ , testProperty "Compose3 I I [] Char" $ roundTripEq (undefined :: LogScaled (Compose3 I I [] Char))
37+ , testProperty "Compose3 I [] [] Char" $ roundTripEq (undefined :: LogScaled (Compose3 I [] [] Char))
38+ , testProperty "Compose3 [] I I Char" $ roundTripEq (undefined :: LogScaled (Compose3 [] I I Char))
39+ , testProperty "Compose3 [] [] I Char" $ roundTripEq (undefined :: LogScaled (Compose3 [] [] I Char))
40+ , testProperty "Compose3 [] I [] Char" $ roundTripEq (undefined :: LogScaled (Compose3 [] I [] Char))
41+ , testProperty "Compose3 [] [] [] Char" $ roundTripEq (undefined :: LogScaled (Compose3 [] [] [] Char))
42+
43+ , testProperty "Compose3' I I I Char" $ roundTripEq (undefined :: LogScaled (Compose3' I I I Char))
44+ , testProperty "Compose3' I [] I Char" $ roundTripEq (undefined :: LogScaled (Compose3' I [] I Char))
45+ , testProperty "Compose3' I I [] Char" $ roundTripEq (undefined :: LogScaled (Compose3' I I [] Char))
46+ , testProperty "Compose3' I [] [] Char" $ roundTripEq (undefined :: LogScaled (Compose3' I [] [] Char))
47+ , testProperty "Compose3' [] I I Char" $ roundTripEq (undefined :: LogScaled (Compose3' [] I I Char))
48+ , testProperty "Compose3' [] [] I Char" $ roundTripEq (undefined :: LogScaled (Compose3' [] [] I Char))
49+ , testProperty "Compose3' [] I [] Char" $ roundTripEq (undefined :: LogScaled (Compose3' [] I [] Char))
50+ , testProperty "Compose3' [] [] [] Char" $ roundTripEq (undefined :: LogScaled (Compose3' [] [] [] Char))
51+ ]
tests/PropertyRoundTrip.hsnew file+67
@@ -0,0 +1,67 @@
1+{-# LANGUAGE NoImplicitPrelude #-}
2+
3+module PropertyRoundTrip ( roundTripTests ) where
4+
5+import Prelude.Compat
6+
7+import Control.Applicative (Const)
8+import Data.Aeson.Types
9+import Data.DList (DList)
10+import Data.List.NonEmpty (NonEmpty)
11+import Data.Proxy (Proxy)
12+import Data.Ratio (Ratio)
13+import Data.Sequence (Seq)
14+import Data.Tagged (Tagged)
15+import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
16+import Data.Version (Version)
17+import Instances ()
18+import Numeric.Natural (Natural)
19+import Test.Tasty (TestTree, testGroup)
20+import Test.Tasty.QuickCheck (testProperty)
21+import Types
22+import qualified Data.Text as T
23+import qualified Data.Text.Lazy as LT
24+import qualified Data.UUID.Types as UUID
25+import PropUtils
26+import PropertyRTFunctors
27+
28+
29+roundTripTests :: TestTree
30+roundTripTests =
31+ testGroup "roundTrip" [
32+ testProperty "Bool" $ roundTripEq True
33+ , testProperty "Double" $ roundTripEq (1 :: Approx Double)
34+ , testProperty "Int" $ roundTripEq (1 :: Int)
35+ , testProperty "NonEmpty Char" $ roundTripEq (undefined :: NonEmpty Char)
36+ , testProperty "Integer" $ roundTripEq (1 :: Integer)
37+ , testProperty "String" $ roundTripEq ("" :: String)
38+ , testProperty "Text" $ roundTripEq T.empty
39+ , testProperty "Lazy Text" $ roundTripEq LT.empty
40+ , testProperty "Foo" $ roundTripEq (undefined :: Foo)
41+ , testProperty "Day" $ roundTripEq (undefined :: Day)
42+ , testProperty "BCE Day" $ roundTripEq (undefined :: BCEDay)
43+ , testProperty "DotNetTime" $ roundTripEq (undefined :: Approx DotNetTime)
44+ , testProperty "LocalTime" $ roundTripEq (undefined :: LocalTime)
45+ , testProperty "TimeOfDay" $ roundTripEq (undefined :: TimeOfDay)
46+ , testProperty "UTCTime" $ roundTripEq (undefined :: UTCTime)
47+ , testProperty "ZonedTime" $ roundTripEq (undefined :: ZonedTime)
48+ , testProperty "NominalDiffTime" $ roundTripEq (undefined :: NominalDiffTime)
49+ , testProperty "DiffTime" $ roundTripEq (undefined :: DiffTime)
50+ , testProperty "Version" $ roundTripEq (undefined :: Version)
51+ , testProperty "Natural" $ roundTripEq (undefined :: Natural)
52+ , testProperty "Proxy" $ roundTripEq (undefined :: Proxy Int)
53+ , testProperty "Tagged" $ roundTripEq (undefined :: Tagged Int Char)
54+ , testProperty "Const" $ roundTripEq (undefined :: Const Int Char)
55+ , testProperty "DList" $ roundTripEq (undefined :: DList Int)
56+ , testProperty "Seq" $ roundTripEq (undefined :: Seq Int)
57+ , testProperty "Rational" $ roundTripEq (undefined :: Rational)
58+ , testProperty "Ratio Int" $ roundTripEq (undefined :: Ratio Int)
59+ , testProperty "UUID" $ roundTripEq UUID.nil
60+ , roundTripFunctorsTests
61+ , testGroup "ghcGenerics" [
62+ testProperty "OneConstructor" $ roundTripEq OneConstructor
63+ , testProperty "Product2" $ roundTripEq (undefined :: Product2 Int Bool)
64+ , testProperty "Product6" $ roundTripEq (undefined :: P6)
65+ , testProperty "Sum4" $ roundTripEq (undefined :: S4)
66+ ]
67+ ]
tests/PropertyTH.hsnew file+130
@@ -0,0 +1,130 @@
1+{-# LANGUAGE NoImplicitPrelude #-}
2+
3+module PropertyTH ( templateHaskellTests ) where
4+
5+import Prelude.Compat
6+
7+import Data.Semigroup (Option(..))
8+import Encoders
9+import Instances ()
10+import Test.Tasty (TestTree, testGroup)
11+import Test.Tasty.QuickCheck (testProperty)
12+import Test.QuickCheck ( (===) )
13+import Types
14+import PropUtils
15+
16+
17+templateHaskellTests :: TestTree
18+templateHaskellTests =
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)
26+
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)
46+
47+ , testProperty "2ElemArray unary" (toParseJSON1 thSomeTypeLiftParseJSON2ElemArray thSomeTypeLiftToJSON2ElemArray)
48+ , testProperty "TaggedObject unary" (toParseJSON1 thSomeTypeLiftParseJSONTaggedObject thSomeTypeLiftToJSONTaggedObject)
49+ , testProperty "ObjectWithSingleField unary" (toParseJSON1 thSomeTypeLiftParseJSONObjectWithSingleField thSomeTypeLiftToJSONObjectWithSingleField)
50+
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
97+
98+ , testProperty "EitherTextInt UntaggedValue" $
99+ thEitherTextIntToJSONUntaggedValue `sameAs` thEitherTextIntToEncodingUntaggedValue
100+
101+ , testProperty "SomeType2ElemArray" $
102+ thSomeTypeToJSON2ElemArray `sameAs` thSomeTypeToEncoding2ElemArray
103+ , testProperty "SomeType2ElemArray unary" $
104+ thSomeTypeLiftToJSON2ElemArray `sameAs1` thSomeTypeLiftToEncoding2ElemArray
105+ , testProperty "SomeType2ElemArray unary agree" $
106+ thSomeTypeToEncoding2ElemArray `sameAs1Agree` thSomeTypeLiftToEncoding2ElemArray
107+
108+ , testProperty "SomeTypeTaggedObject" $
109+ thSomeTypeToJSONTaggedObject `sameAs` thSomeTypeToEncodingTaggedObject
110+ , testProperty "SomeTypeTaggedObject unary" $
111+ thSomeTypeLiftToJSONTaggedObject `sameAs1` thSomeTypeLiftToEncodingTaggedObject
112+ , testProperty "SomeTypeTaggedObject unary agree" $
113+ thSomeTypeToEncodingTaggedObject `sameAs1Agree` thSomeTypeLiftToEncodingTaggedObject
114+
115+ , testProperty "SomeTypeObjectWithSingleField" $
116+ thSomeTypeToJSONObjectWithSingleField `sameAs` thSomeTypeToEncodingObjectWithSingleField
117+ , testProperty "SomeTypeObjectWithSingleField unary" $
118+ thSomeTypeLiftToJSONObjectWithSingleField `sameAs1` thSomeTypeLiftToEncodingObjectWithSingleField
119+ , testProperty "SomeTypeObjectWithSingleField unary agree" $
120+ thSomeTypeToEncodingObjectWithSingleField `sameAs1Agree` thSomeTypeLiftToEncodingObjectWithSingleField
121+
122+ , testProperty "OneConstructorDefault" $
123+ thOneConstructorToJSONDefault `sameAs` thOneConstructorToEncodingDefault
124+ , testProperty "OneConstructorTagged" $
125+ thOneConstructorToJSONTagged `sameAs` thOneConstructorToEncodingTagged
126+
127+ , testProperty "OptionField" $
128+ thOptionFieldToJSON `sameAs` thOptionFieldToEncoding
129+ ]
130+ ]