git.iko.soy/typeable/aeson
on 1.2.0.0 help sign in
typeable/aeson/tests/Properties.hs
511 lines 26 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE FlexibleContexts #-} -- For arbitrary Compose
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE RankNTypes #-}
5{-# LANGUAGE ScopedTypeVariables #-}
7module Properties where
9import Prelude ()
10import Prelude.Compat
12import Control.Applicative (Const)
13import Data.Aeson (eitherDecode, encode)
14import Data.Aeson.Encoding (encodingToLazyByteString)
15import Data.Aeson.Internal (IResult(..), formatError, ifromJSON, iparse)
16import Data.Aeson.Parser (value)
17import Data.Aeson.Types
18import Data.DList (DList)
19import Data.Functor.Compose (Compose (..))
20import Data.HashMap.Strict (HashMap)
21import Data.Hashable (Hashable)
22import Data.Int (Int8)
23import Data.List.NonEmpty (NonEmpty)
24import Data.Map (Map)
25import Data.Proxy (Proxy)
26import Data.Ratio (Ratio)
27import Data.Sequence (Seq)
28import Data.Tagged (Tagged)
29import Data.Time (Day, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
30import Data.Version (Version)
31import Encoders
32import Instances ()
33import Numeric.Natural (Natural)
34import Test.Framework (Test, testGroup)
35import Test.Framework.Providers.QuickCheck2 (testProperty)
36import Test.QuickCheck (Arbitrary(..), Property, Testable, (===), (.&&.), counterexample)
37import Types
38import qualified Data.Attoparsec.Lazy as L
39import qualified Data.ByteString.Lazy.Char8 as L
40import qualified Data.HashMap.Strict as H
41import qualified Data.Map as Map
42import qualified Data.Text as T
43import qualified Data.Text.Lazy as LT
44import qualified Data.UUID.Types as UUID
45import qualified Data.Vector as V
47encodeDouble :: Double -> Double -> Property
48encodeDouble num denom
49 | isInfinite d || isNaN d = encode d === "null"
50 | otherwise = (read . L.unpack . encode) d === d
51 where d = num / denom
53encodeInteger :: Integer -> Property
54encodeInteger i = encode i === L.pack (show i)
56toParseJSON :: (Eq a, Show a) =>
57 (Value -> Parser a) -> (a -> Value) -> a -> Property
58toParseJSON parsejson tojson x =
59 case iparse parsejson . tojson $ x of
60 IError path msg -> failure "parse" (formatError path msg) x
61 ISuccess x' -> x === x'
63toParseJSON1
64 :: (Eq (f Int), Show (f Int))
65 => (forall a. LiftParseJSON f a)
66 -> (forall a. LiftToJSON f a)
67 -> f Int
68 -> Property
69toParseJSON1 parsejson1 tojson1 = toParseJSON parsejson tojson
70 where
71 parsejson = parsejson1 parseJSON (listParser parseJSON)
72 tojson = tojson1 toJSON (listValue toJSON)
74roundTripEnc :: (FromJSON a, ToJSON a, Show a) =>
75 (a -> a -> Property) -> a -> a -> Property
76roundTripEnc eq _ i =
77 case fmap ifromJSON . L.parse value . encode $ i of
78 L.Done _ (ISuccess v) -> v `eq` i
79 L.Done _ (IError path err) -> failure "fromJSON" (formatError path err) i
80 L.Fail _ _ err -> failure "parse" err i
82roundTripNoEnc :: (FromJSON a, ToJSON a, Show a) =>
83 (a -> a -> Property) -> a -> a -> Property
84roundTripNoEnc eq _ i =
85 case ifromJSON . toJSON $ i of
86 (ISuccess v) -> v `eq` i
87 (IError path err) -> failure "fromJSON" (formatError path err) i
89roundTripEq :: (Eq a, FromJSON a, ToJSON a, Show a) => a -> a -> Property
90roundTripEq x y = roundTripEnc (===) x y .&&. roundTripNoEnc (===) x y
92-- We test keys by encoding HashMap and Map with it
93roundTripKey
94 :: (Ord a, Hashable a, FromJSONKey a, ToJSONKey a, Show a)
95 => a -> HashMap a Int -> Map a Int -> Property
96roundTripKey _ h m = roundTripEq h h .&&. roundTripEq m m
98infix 4 ==~
99(==~) :: (ApproxEq a, Show a) => a -> a -> Property
100x ==~ y =
101 counterexample (show x ++ " /= " ++ show y) (x =~ y)
103toFromJSON :: (Arbitrary a, Eq a, FromJSON a, ToJSON a, Show a) => a -> Property
104toFromJSON x = case ifromJSON (toJSON x) of
105 IError path err -> failure "fromJSON" (formatError path err) x
106 ISuccess x' -> x === x'
108modifyFailureProp :: String -> String -> Bool
109modifyFailureProp orig added =
110 result == Error (added ++ orig)
111 where
112 parser = const $ modifyFailure (added ++) $ fail orig
113 result :: Result ()
114 result = parse parser ()
116-- | Perform a structural comparison of the results of two encoding
117-- methods. Compares decoded values to account for HashMap-driven
118-- variation in JSON object key ordering.
119sameAs :: (a -> Value) -> (a -> Encoding) -> a -> Property
120sameAs toVal toEnc v =
121 eitherDecode (encodingToLazyByteString (toEnc v)) === Right (toVal v)
123sameAs1
124 :: (forall a. LiftToJSON f a)
125 -> (forall a. LiftToEncoding f a)
126 -> f Int
127 -> Property
128sameAs1 toVal1 toEnc1 v = lhs === rhs
129 where
130 rhs = Right $ toVal1 toJSON (listValue toJSON) v
131 lhs = eitherDecode . encodingToLazyByteString $
132 toEnc1 toEncoding (listEncoding toEncoding) v
134sameAs1Agree
135 :: ToJSON a
136 => (f a -> Encoding)
137 -> (forall b. LiftToEncoding f b)
138 -> f a
139 -> Property
140sameAs1Agree toEnc toEnc1 v = rhs === lhs
141 where
142 rhs = encodingToLazyByteString $ toEnc v
143 lhs = encodingToLazyByteString $ toEnc1 toEncoding (listEncoding toEncoding) v
145type P6 = Product6 Int Bool String (Approx Double) (Int, Approx Double) ()
146type S4 = Sum4 Int8 ZonedTime T.Text (Map.Map String Int)
148--------------------------------------------------------------------------------
149-- Value properties
150--------------------------------------------------------------------------------
152-- | Add the formatted @Value@ to the printed counterexample when the property
153-- fails.
154checkValue :: Testable a => (Value -> a) -> Value -> Property
155checkValue prop v = counterexample (L.unpack (encode v)) (prop v)
157isString :: Value -> Bool
158isString (String _) = True
159isString _ = False
161is2ElemArray :: Value -> Bool
162is2ElemArray (Array v) = V.length v == 2 && isString (V.head v)
163is2ElemArray _ = False
165isTaggedObjectValue :: Value -> Bool
166isTaggedObjectValue (Object obj) = "tag" `H.member` obj &&
167 "contents" `H.member` obj
168isTaggedObjectValue _ = False
170isNullaryTaggedObject :: Value -> Bool
171isNullaryTaggedObject obj = isTaggedObject' obj && isObjectWithSingleField obj
173isTaggedObject :: Value -> Property
174isTaggedObject = checkValue isTaggedObject'
176isTaggedObject' :: Value -> Bool
177isTaggedObject' (Object obj) = "tag" `H.member` obj
178isTaggedObject' _ = False
180isObjectWithSingleField :: Value -> Bool
181isObjectWithSingleField (Object obj) = H.size obj == 1
182isObjectWithSingleField _ = False
184-- | is untaggedValue of EitherTextInt
185isUntaggedValueETI :: Value -> Bool
186isUntaggedValueETI (String s)
187 | s == "nonenullary" = True
188isUntaggedValueETI (Bool _) = True
189isUntaggedValueETI (Number _) = True
190isUntaggedValueETI (Array a) = length a == 2
191isUntaggedValueETI _ = False
193isEmptyArray :: Value -> Property
194isEmptyArray = checkValue isEmptyArray'
196isEmptyArray' :: Value -> Bool
197isEmptyArray' = (Array mempty ==)
200--------------------------------------------------------------------------------
203tests :: Test
204tests = testGroup "properties" [
205 testGroup "encode" [
206 testProperty "encodeDouble" encodeDouble
207 , testProperty "encodeInteger" encodeInteger
208 ]
209 , testGroup "roundTrip" [
210 testProperty "Bool" $ roundTripEq True
211 , testProperty "Double" $ roundTripEq (1 :: Approx Double)
212 , testProperty "Int" $ roundTripEq (1 :: Int)
213 , testProperty "NonEmpty Char" $ roundTripEq (undefined :: NonEmpty Char)
214 , testProperty "Integer" $ roundTripEq (1 :: Integer)
215 , testProperty "String" $ roundTripEq ("" :: String)
216 , testProperty "Text" $ roundTripEq T.empty
217 , testProperty "Lazy Text" $ roundTripEq LT.empty
218 , testProperty "Foo" $ roundTripEq (undefined :: Foo)
219 , testProperty "Day" $ roundTripEq (undefined :: Day)
220 , testProperty "BCE Day" $ roundTripEq (undefined :: BCEDay)
221 , testProperty "DotNetTime" $ roundTripEq (undefined :: Approx DotNetTime)
222 , testProperty "LocalTime" $ roundTripEq (undefined :: LocalTime)
223 , testProperty "TimeOfDay" $ roundTripEq (undefined :: TimeOfDay)
224 , testProperty "UTCTime" $ roundTripEq (undefined :: UTCTime)
225 , testProperty "ZonedTime" $ roundTripEq (undefined :: ZonedTime)
226 , testProperty "NominalDiffTime" $ roundTripEq (undefined :: NominalDiffTime)
227 , testProperty "Version" $ roundTripEq (undefined :: Version)
228 , testProperty "Natural" $ roundTripEq (undefined :: Natural)
229 , testProperty "Proxy" $ roundTripEq (undefined :: Proxy Int)
230 , testProperty "Tagged" $ roundTripEq (undefined :: Tagged Int Char)
231 , testProperty "Const" $ roundTripEq (undefined :: Const Int Char)
232 , testProperty "DList" $ roundTripEq (undefined :: DList Int)
233 , testProperty "Seq" $ roundTripEq (undefined :: Seq Int)
234 , testProperty "Rational" $ roundTripEq (undefined :: Rational)
235 , testProperty "Ratio Int" $ roundTripEq (undefined :: Ratio Int)
236 , testProperty "UUID" $ roundTripEq UUID.nil
237 , testGroup "functors"
238 [ testProperty "Identity Char" $ roundTripEq (undefined :: I Int)
240 , testProperty "Identity Char" $ roundTripEq (undefined :: I Char)
241 , testProperty "Identity [Char]" $ roundTripEq (undefined :: I String)
242 , testProperty "[Identity Char]" $ roundTripEq (undefined :: [I Char])
244 , testProperty "Compose I I Int" $ roundTripEq (undefined :: LogScaled (Compose I I Int))
245 , testProperty "Compose [] I Int" $ roundTripEq (undefined :: LogScaled (Compose [] I Int))
246 , testProperty "Compose I [] Int" $ roundTripEq (undefined :: LogScaled (Compose I [] Int))
247 , testProperty "Compose [] [] Int" $ roundTripEq (undefined :: LogScaled (Compose [] [] Int))
249 , testProperty "Compose I I Char" $ roundTripEq (undefined :: LogScaled (Compose I I Char))
250 , testProperty "Compose [] I Char" $ roundTripEq (undefined :: LogScaled (Compose [] I Char))
251 , testProperty "Compose I [] Char" $ roundTripEq (undefined :: LogScaled (Compose I [] Char))
252 , testProperty "Compose [] [] Char" $ roundTripEq (undefined :: LogScaled (Compose [] [] Char))
254 , testProperty "Compose3 I I I Char" $ roundTripEq (undefined :: LogScaled (Compose3 I I I Char))
255 , testProperty "Compose3 I [] I Char" $ roundTripEq (undefined :: LogScaled (Compose3 I [] I Char))
256 , testProperty "Compose3 I I [] Char" $ roundTripEq (undefined :: LogScaled (Compose3 I I [] Char))
257 , testProperty "Compose3 I [] [] Char" $ roundTripEq (undefined :: LogScaled (Compose3 I [] [] Char))
258 , testProperty "Compose3 [] I I Char" $ roundTripEq (undefined :: LogScaled (Compose3 [] I I Char))
259 , testProperty "Compose3 [] [] I Char" $ roundTripEq (undefined :: LogScaled (Compose3 [] [] I Char))
260 , testProperty "Compose3 [] I [] Char" $ roundTripEq (undefined :: LogScaled (Compose3 [] I [] Char))
261 , testProperty "Compose3 [] [] [] Char" $ roundTripEq (undefined :: LogScaled (Compose3 [] [] [] Char))
263 , testProperty "Compose3' I I I Char" $ roundTripEq (undefined :: LogScaled (Compose3' I I I Char))
264 , testProperty "Compose3' I [] I Char" $ roundTripEq (undefined :: LogScaled (Compose3' I [] I Char))
265 , testProperty "Compose3' I I [] Char" $ roundTripEq (undefined :: LogScaled (Compose3' I I [] Char))
266 , testProperty "Compose3' I [] [] Char" $ roundTripEq (undefined :: LogScaled (Compose3' I [] [] Char))
267 , testProperty "Compose3' [] I I Char" $ roundTripEq (undefined :: LogScaled (Compose3' [] I I Char))
268 , testProperty "Compose3' [] [] I Char" $ roundTripEq (undefined :: LogScaled (Compose3' [] [] I Char))
269 , testProperty "Compose3' [] I [] Char" $ roundTripEq (undefined :: LogScaled (Compose3' [] I [] Char))
270 , testProperty "Compose3' [] [] [] Char" $ roundTripEq (undefined :: LogScaled (Compose3' [] [] [] Char))
271 ]
272 , testGroup "ghcGenerics" [
273 testProperty "OneConstructor" $ roundTripEq OneConstructor
274 , testProperty "Product2" $ roundTripEq (undefined :: Product2 Int Bool)
275 , testProperty "Product6" $ roundTripEq (undefined :: P6)
276 , testProperty "Sum4" $ roundTripEq (undefined :: S4)
277 ]
278 ]
279 , testGroup "roundTrip Key"
280 [ testProperty "Bool" $ roundTripKey True
281 , testProperty "Text" $ roundTripKey (undefined :: T.Text)
282 , testProperty "String" $ roundTripKey (undefined :: String)
283 , testProperty "Int" $ roundTripKey (undefined :: Int)
284 , testProperty "[Text]" $ roundTripKey (undefined :: LogScaled [T.Text])
285 , testProperty "(Int,Char)" $ roundTripKey (undefined :: (Int,Char))
286 , testProperty "Integer" $ roundTripKey (undefined :: Integer)
287 , testProperty "Natural" $ roundTripKey (undefined :: Natural)
288 , testProperty "Float" $ roundTripKey (undefined :: Float)
289 , testProperty "Double" $ roundTripKey (undefined :: Double)
290#if MIN_VERSION_base(4,7,0)
291 , testProperty "Day" $ roundTripKey (undefined :: Day)
292 , testProperty "LocalTime" $ roundTripKey (undefined :: LocalTime)
293 , testProperty "TimeOfDay" $ roundTripKey (undefined :: TimeOfDay)
294 , testProperty "UTCTime" $ roundTripKey (undefined :: UTCTime)
295#endif
296 , testProperty "Version" $ roundTripKey (undefined :: Version)
297 , testProperty "Lazy Text" $ roundTripKey (undefined :: LT.Text)
298 , testProperty "UUID" $ roundTripKey UUID.nil
299 ]
300 , testGroup "toFromJSON" [
301 testProperty "Integer" (toFromJSON :: Integer -> Property)
302 , testProperty "Double" (toFromJSON :: Double -> Property)
303 , testProperty "Maybe Integer" (toFromJSON :: Maybe Integer -> Property)
304 , testProperty "Either Integer Double" (toFromJSON :: Either Integer Double -> Property)
305 , testProperty "Either Integer Integer" (toFromJSON :: Either Integer Integer -> Property)
306 ]
307 , testGroup "failure messages" [
308 testProperty "modify failure" modifyFailureProp
309 ]
310 , testGroup "generic" [
311 testGroup "toJSON" [
312 testGroup "Nullary" [
313 testProperty "string" (isString . gNullaryToJSONString)
314 , testProperty "2ElemArray" (is2ElemArray . gNullaryToJSON2ElemArray)
315 , testProperty "TaggedObject" (isNullaryTaggedObject . gNullaryToJSONTaggedObject)
316 , testProperty "ObjectWithSingleField" (isObjectWithSingleField . gNullaryToJSONObjectWithSingleField)
317 , testGroup "roundTrip" [
318 testProperty "string" (toParseJSON gNullaryParseJSONString gNullaryToJSONString)
319 , testProperty "2ElemArray" (toParseJSON gNullaryParseJSON2ElemArray gNullaryToJSON2ElemArray)
320 , testProperty "TaggedObject" (toParseJSON gNullaryParseJSONTaggedObject gNullaryToJSONTaggedObject)
321 , testProperty "ObjectWithSingleField" (toParseJSON gNullaryParseJSONObjectWithSingleField gNullaryToJSONObjectWithSingleField)
322 ]
323 ]
324 , testGroup "EitherTextInt" [
325 testProperty "UntaggedValue" (isUntaggedValueETI . gEitherTextIntToJSONUntaggedValue)
326 , testProperty "roundtrip" (toParseJSON gEitherTextIntParseJSONUntaggedValue gEitherTextIntToJSONUntaggedValue)
327 ]
328 , testGroup "SomeType" [
329 testProperty "2ElemArray" (is2ElemArray . gSomeTypeToJSON2ElemArray)
330 , testProperty "TaggedObject" (isTaggedObject . gSomeTypeToJSONTaggedObject)
331 , testProperty "ObjectWithSingleField" (isObjectWithSingleField . gSomeTypeToJSONObjectWithSingleField)
332 , testGroup "roundTrip" [
333 testProperty "2ElemArray" (toParseJSON gSomeTypeParseJSON2ElemArray gSomeTypeToJSON2ElemArray)
334 , testProperty "TaggedObject" (toParseJSON gSomeTypeParseJSONTaggedObject gSomeTypeToJSONTaggedObject)
335 , testProperty "ObjectWithSingleField" (toParseJSON gSomeTypeParseJSONObjectWithSingleField gSomeTypeToJSONObjectWithSingleField)
337#if __GLASGOW_HASKELL__ >= 706
338 , testProperty "2ElemArray unary" (toParseJSON1 gSomeTypeLiftParseJSON2ElemArray gSomeTypeLiftToJSON2ElemArray)
339 , testProperty "TaggedObject unary" (toParseJSON1 gSomeTypeLiftParseJSONTaggedObject gSomeTypeLiftToJSONTaggedObject)
340 , testProperty "ObjectWithSingleField unary" (toParseJSON1 gSomeTypeLiftParseJSONObjectWithSingleField gSomeTypeLiftToJSONObjectWithSingleField)
341#endif
342 ]
343 ]
344 , testGroup "OneConstructor" [
345 testProperty "default" (isEmptyArray . gOneConstructorToJSONDefault)
346 , testProperty "Tagged" (isTaggedObject . gOneConstructorToJSONTagged)
347 , testGroup "roundTrip" [
348 testProperty "default" (toParseJSON gOneConstructorParseJSONDefault gOneConstructorToJSONDefault)
349 , testProperty "Tagged" (toParseJSON gOneConstructorParseJSONTagged gOneConstructorToJSONTagged)
350 ]
351 ]
352 ]
353 , testGroup "toEncoding" [
354 testProperty "NullaryString" $
355 gNullaryToJSONString `sameAs` gNullaryToEncodingString
356 , testProperty "Nullary2ElemArray" $
357 gNullaryToJSON2ElemArray `sameAs` gNullaryToEncoding2ElemArray
358 , testProperty "NullaryTaggedObject" $
359 gNullaryToJSONTaggedObject `sameAs` gNullaryToEncodingTaggedObject
360 , testProperty "NullaryObjectWithSingleField" $
361 gNullaryToJSONObjectWithSingleField `sameAs`
362 gNullaryToEncodingObjectWithSingleField
363 -- , testProperty "ApproxUnwrap" $
364 -- gApproxToJSONUnwrap `sameAs` gApproxToEncodingUnwrap
365 , testProperty "ApproxDefault" $
366 gApproxToJSONDefault `sameAs` gApproxToEncodingDefault
368 , testProperty "EitherTextInt UntaggedValue" $
369 gEitherTextIntToJSONUntaggedValue `sameAs` gEitherTextIntToEncodingUntaggedValue
371 , testProperty "SomeType2ElemArray" $
372 gSomeTypeToJSON2ElemArray `sameAs` gSomeTypeToEncoding2ElemArray
373#if __GLASGOW_HASKELL__ >= 706
374 , testProperty "SomeType2ElemArray unary" $
375 gSomeTypeLiftToJSON2ElemArray `sameAs1` gSomeTypeLiftToEncoding2ElemArray
376 , testProperty "SomeType2ElemArray unary agree" $
377 gSomeTypeToEncoding2ElemArray `sameAs1Agree` gSomeTypeLiftToEncoding2ElemArray
378#endif
380 , testProperty "SomeTypeTaggedObject" $
381 gSomeTypeToJSONTaggedObject `sameAs` gSomeTypeToEncodingTaggedObject
382#if __GLASGOW_HASKELL__ >= 706
383 , testProperty "SomeTypeTaggedObject unary" $
384 gSomeTypeLiftToJSONTaggedObject `sameAs1` gSomeTypeLiftToEncodingTaggedObject
385 , testProperty "SomeTypeTaggedObject unary agree" $
386 gSomeTypeToEncodingTaggedObject `sameAs1Agree` gSomeTypeLiftToEncodingTaggedObject
387#endif
389 , testProperty "SomeTypeObjectWithSingleField" $
390 gSomeTypeToJSONObjectWithSingleField `sameAs` gSomeTypeToEncodingObjectWithSingleField
391#if __GLASGOW_HASKELL__ >= 706
392 , testProperty "SomeTypeObjectWithSingleField unary" $
393 gSomeTypeLiftToJSONObjectWithSingleField `sameAs1` gSomeTypeLiftToEncodingObjectWithSingleField
394 , testProperty "SomeTypeObjectWithSingleField unary agree" $
395 gSomeTypeToEncodingObjectWithSingleField `sameAs1Agree` gSomeTypeLiftToEncodingObjectWithSingleField
396#endif
398 , testProperty "SomeTypeOmitNothingFields" $
399 gSomeTypeToJSONOmitNothingFields `sameAs` gSomeTypeToEncodingOmitNothingFields
401 , testProperty "OneConstructorDefault" $
402 gOneConstructorToJSONDefault `sameAs` gOneConstructorToEncodingDefault
403 , testProperty "OneConstructorTagged" $
404 gOneConstructorToJSONTagged `sameAs` gOneConstructorToEncodingTagged
405 ]
406 ]
407 , testGroup "template-haskell" [
408 testGroup "toJSON" [
409 testGroup "Nullary" [
410 testProperty "string" (isString . thNullaryToJSONString)
411 , testProperty "2ElemArray" (is2ElemArray . thNullaryToJSON2ElemArray)
412 , testProperty "TaggedObject" (isNullaryTaggedObject . thNullaryToJSONTaggedObject)
413 , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thNullaryToJSONObjectWithSingleField)
415 , testGroup "roundTrip" [
416 testProperty "string" (toParseJSON thNullaryParseJSONString thNullaryToJSONString)
417 , testProperty "2ElemArray" (toParseJSON thNullaryParseJSON2ElemArray thNullaryToJSON2ElemArray)
418 , testProperty "TaggedObject" (toParseJSON thNullaryParseJSONTaggedObject thNullaryToJSONTaggedObject)
419 , testProperty "ObjectWithSingleField" (toParseJSON thNullaryParseJSONObjectWithSingleField thNullaryToJSONObjectWithSingleField)
420 ]
421 ]
422 , testGroup "EitherTextInt" [
423 testProperty "UntaggedValue" (isUntaggedValueETI . thEitherTextIntToJSONUntaggedValue)
424 , testProperty "roundtrip" (toParseJSON thEitherTextIntParseJSONUntaggedValue thEitherTextIntToJSONUntaggedValue)
425 ]
426 , testGroup "SomeType" [
427 testProperty "2ElemArray" (is2ElemArray . thSomeTypeToJSON2ElemArray)
428 , testProperty "TaggedObject" (isTaggedObject . thSomeTypeToJSONTaggedObject)
429 , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thSomeTypeToJSONObjectWithSingleField)
430 , testGroup "roundTrip" [
431 testProperty "2ElemArray" (toParseJSON thSomeTypeParseJSON2ElemArray thSomeTypeToJSON2ElemArray)
432 , testProperty "TaggedObject" (toParseJSON thSomeTypeParseJSONTaggedObject thSomeTypeToJSONTaggedObject)
433 , testProperty "ObjectWithSingleField" (toParseJSON thSomeTypeParseJSONObjectWithSingleField thSomeTypeToJSONObjectWithSingleField)
435 , testProperty "2ElemArray unary" (toParseJSON1 thSomeTypeLiftParseJSON2ElemArray thSomeTypeLiftToJSON2ElemArray)
436 , testProperty "TaggedObject unary" (toParseJSON1 thSomeTypeLiftParseJSONTaggedObject thSomeTypeLiftToJSONTaggedObject)
437 , testProperty "ObjectWithSingleField unary" (toParseJSON1 thSomeTypeLiftParseJSONObjectWithSingleField thSomeTypeLiftToJSONObjectWithSingleField)
439 ]
440 ]
441 , testGroup "Approx" [
442 testProperty "string" (isString . thApproxToJSONUnwrap)
443 , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thApproxToJSONDefault)
444 , testGroup "roundTrip" [
445 testProperty "string" (toParseJSON thApproxParseJSONUnwrap thApproxToJSONUnwrap)
446 , testProperty "ObjectWithSingleField" (toParseJSON thApproxParseJSONDefault thApproxToJSONDefault)
447 ]
448 ]
449 , testGroup "GADT" [
450 testProperty "string" (isString . thGADTToJSONUnwrap)
451 , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thGADTToJSONDefault)
452 , testGroup "roundTrip" [
453 testProperty "string" (toParseJSON thGADTParseJSONUnwrap thGADTToJSONUnwrap)
454 , testProperty "ObjectWithSingleField" (toParseJSON thGADTParseJSONDefault thGADTToJSONDefault)
455 ]
456 ]
457 , testGroup "OneConstructor" [
458 testProperty "default" (isEmptyArray . thOneConstructorToJSONDefault)
459 , testProperty "Tagged" (isTaggedObject . thOneConstructorToJSONTagged)
460 , testGroup "roundTrip" [
461 testProperty "default" (toParseJSON thOneConstructorParseJSONDefault thOneConstructorToJSONDefault)
462 , testProperty "Tagged" (toParseJSON thOneConstructorParseJSONTagged thOneConstructorToJSONTagged)
463 ]
464 ]
465 ]
466 , testGroup "toEncoding" [
467 testProperty "NullaryString" $
468 thNullaryToJSONString `sameAs` thNullaryToEncodingString
469 , testProperty "Nullary2ElemArray" $
470 thNullaryToJSON2ElemArray `sameAs` thNullaryToEncoding2ElemArray
471 , testProperty "NullaryTaggedObject" $
472 thNullaryToJSONTaggedObject `sameAs` thNullaryToEncodingTaggedObject
473 , testProperty "NullaryObjectWithSingleField" $
474 thNullaryToJSONObjectWithSingleField `sameAs`
475 thNullaryToEncodingObjectWithSingleField
476 , testProperty "ApproxUnwrap" $
477 thApproxToJSONUnwrap `sameAs` thApproxToEncodingUnwrap
478 , testProperty "ApproxDefault" $
479 thApproxToJSONDefault `sameAs` thApproxToEncodingDefault
481 , testProperty "EitherTextInt UntaggedValue" $
482 thEitherTextIntToJSONUntaggedValue `sameAs` thEitherTextIntToEncodingUntaggedValue
484 , testProperty "SomeType2ElemArray" $
485 thSomeTypeToJSON2ElemArray `sameAs` thSomeTypeToEncoding2ElemArray
486 , testProperty "SomeType2ElemArray unary" $
487 thSomeTypeLiftToJSON2ElemArray `sameAs1` thSomeTypeLiftToEncoding2ElemArray
488 , testProperty "SomeType2ElemArray unary agree" $
489 thSomeTypeToEncoding2ElemArray `sameAs1Agree` thSomeTypeLiftToEncoding2ElemArray
491 , testProperty "SomeTypeTaggedObject" $
492 thSomeTypeToJSONTaggedObject `sameAs` thSomeTypeToEncodingTaggedObject
493 , testProperty "SomeTypeTaggedObject unary" $
494 thSomeTypeLiftToJSONTaggedObject `sameAs1` thSomeTypeLiftToEncodingTaggedObject
495 , testProperty "SomeTypeTaggedObject unary agree" $
496 thSomeTypeToEncodingTaggedObject `sameAs1Agree` thSomeTypeLiftToEncodingTaggedObject
498 , testProperty "SomeTypeObjectWithSingleField" $
499 thSomeTypeToJSONObjectWithSingleField `sameAs` thSomeTypeToEncodingObjectWithSingleField
500 , testProperty "SomeTypeObjectWithSingleField unary" $
501 thSomeTypeLiftToJSONObjectWithSingleField `sameAs1` thSomeTypeLiftToEncodingObjectWithSingleField
502 , testProperty "SomeTypeObjectWithSingleField unary agree" $
503 thSomeTypeToEncodingObjectWithSingleField `sameAs1Agree` thSomeTypeLiftToEncodingObjectWithSingleField
505 , testProperty "OneConstructorDefault" $
506 thOneConstructorToJSONDefault `sameAs` thOneConstructorToEncodingDefault
507 , testProperty "OneConstructorTagged" $
508 thOneConstructorToJSONTagged `sameAs` thOneConstructorToEncodingTagged
509 ]
510 ]
511 ]