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