git.iko.soy/typeable/aeson
on master help sign in
Add tests for OneConstructor

See issue #517

commit1d70e25e5d0da0b3591ceba584085b6e157ea583 authorlyxia <lysxia@gmail.com> dateSat 18 Mar 2017, 09:46 (10 years ago) parentaf7dc86
2 files changed+34−1
compare with master
unifiedsplit
tests/Encoders.hs+13 tests/Properties.hs+21−1
tests/Encoders.hs+13
@@ -341,3 +341,16 @@ thGADTToEncodingDefault = $(mkToEncoding defaultOptions ''GADT)
341341
342342thGADTParseJSONDefault :: Value -> Parser (GADT String)
343343thGADTParseJSONDefault = $(mkParseJSON defaultOptions ''GADT)
344+
345+--------------------------------------------------------------------------------
346+-- OneConstructor encoders/decoders
347+--------------------------------------------------------------------------------
348+
349+thOneConstructorToJSONDefault :: OneConstructor -> Value
350+thOneConstructorToJSONDefault = $(mkToJSON defaultOptions ''OneConstructor)
351+
352+thOneConstructorToEncodingDefault :: OneConstructor -> Encoding
353+thOneConstructorToEncodingDefault = $(mkToEncoding defaultOptions ''OneConstructor)
354+
355+thOneConstructorParseJSONDefault :: Value -> Parser OneConstructor
356+thOneConstructorParseJSONDefault = $(mkParseJSON defaultOptions ''OneConstructor)
tests/Properties.hs+21−1
@@ -33,7 +33,7 @@ import Instances ()
3333import Numeric.Natural (Natural)
3434import Test.Framework (Test, testGroup)
3535import Test.Framework.Providers.QuickCheck2 (testProperty)
36−import Test.QuickCheck (Arbitrary(..), Property, (===), (.&&.), counterexample)
36+import Test.QuickCheck (Arbitrary(..), Property, Testable, (===), (.&&.), counterexample)
3737import Types
3838import qualified Data.Attoparsec.Lazy as L
3939import qualified Data.ByteString.Lazy.Char8 as L
@@ -149,6 +149,11 @@ type S4 = Sum4 Int8 ZonedTime T.Text (Map.Map String Int)
149149-- Value properties
150150--------------------------------------------------------------------------------
151151
152+-- | Add the formatted @Value@ to the printed counterexample when the property
153+-- fails.
154+checkValue :: Testable a => (Value -> a) -> Value -> Property
155+checkValue prop v = counterexample (L.unpack (encode v)) (prop v)
156+
152157isString :: Value -> Bool
153158isString (String _) = True
154159isString _ = False
@@ -182,6 +187,12 @@ isUntaggedValueETI (Number _) = True
182187isUntaggedValueETI (Array a) = length a == 2
183188isUntaggedValueETI _ = False
184189
190+isEmptyArray :: Value -> Property
191+isEmptyArray = checkValue isEmptyArray'
192+
193+isEmptyArray' :: Value -> Bool
194+isEmptyArray' = (Array mempty ==)
195+
185196
186197--------------------------------------------------------------------------------
187198
@@ -427,6 +438,12 @@ tests = testGroup "properties" [
427438 , testProperty "ObjectWithSingleField" (toParseJSON thGADTParseJSONDefault thGADTToJSONDefault)
428439 ]
429440 ]
441+ , testGroup "OneConstructor" [
442+ testProperty "default" (isEmptyArray . thOneConstructorToJSONDefault)
443+ , testGroup "roundTrip" [
444+ testProperty "default" (toParseJSON thOneConstructorParseJSONDefault thOneConstructorToJSONDefault)
445+ ]
446+ ]
430447 ]
431448 , testGroup "toEncoding" [
432449 testProperty "NullaryString" $
@@ -466,6 +483,9 @@ tests = testGroup "properties" [
466483 thSomeTypeLiftToJSONObjectWithSingleField `sameAs1` thSomeTypeLiftToEncodingObjectWithSingleField
467484 , testProperty "SomeTypeObjectWithSingleField unary agree" $
468485 thSomeTypeToEncodingObjectWithSingleField `sameAs1Agree` thSomeTypeLiftToEncodingObjectWithSingleField
486+
487+ , testProperty "OneConstructor" $
488+ thOneConstructorToJSONDefault `sameAs` thOneConstructorToEncodingDefault
469489 ]
470490 ]
471491 ]