git.iko.soy/typeable/aeson
on master help sign in
Merge pull request #684 from kquick/testcompile

Bump QuickCheck + base-orphan; faster test compilation

commit2532376dac5300f7b79000b2e7d7e5b4b7b3cf53 authorAdam Bergmark <adam@bergmark.nl> dateFri 4 Jan 2019, 14:01 (8 years ago) parentc3d04183f553c4
10 files changed+646−531
compare with master
unifiedsplit
.gitignore+3 aeson.cabal+8−2 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
.gitignore+3
@@ -13,6 +13,9 @@ cabal.sandbox.config
1313.\#*
1414\#*
1515
16+# Emacs backup files
17+*~
18+
1619benchmarks/AesonEncode
1720
1821tests/qc
aeson.cabal+8−2
@@ -197,20 +197,26 @@ 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
204210 UnitTests.NullaryConstructors
205211
206212 build-depends:
207− QuickCheck >= 2.10.0.1 && < 2.12,
213+ QuickCheck >= 2.10.0.1 && < 2.13,
208214 aeson,
209215 integer-logarithms >= 1 && <1.1,
210216 attoparsec,
211217 base,
212218 base-compat,
213− base-orphans >= 0.5.3 && <0.8,
219+ base-orphans >= 0.5.3 && <0.9,
214220 base16-bytestring,
215221 containers,
216222 directory,
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+ ]