git.iko.soy/typeable/aeson
on master help sign in
Tests for OneConstructor and tagSingleConstructors
commit235d387c486b66ff5bd51010f15198d1cb992be8 authorlyxia <lysxia@gmail.com> dateSat 18 Mar 2017, 18:09 (10 years ago) parent4494374
3 files changed+59−5
compare with master
unifiedsplit
tests/Encoders.hs+28 tests/Options.hs+6 tests/Properties.hs+25−5
tests/Encoders.hs+28
@@ -354,3 +354,31 @@ thOneConstructorToEncodingDefault = $(mkToEncoding defaultOptions ''OneConstruct
354354
355355thOneConstructorParseJSONDefault :: Value -> Parser OneConstructor
356356thOneConstructorParseJSONDefault = $(mkParseJSON defaultOptions ''OneConstructor)
357+
358+thOneConstructorToJSONTagged :: OneConstructor -> Value
359+thOneConstructorToJSONTagged = $(mkToJSON optsTagSingleConstructors ''OneConstructor)
360+
361+thOneConstructorToEncodingTagged :: OneConstructor -> Encoding
362+thOneConstructorToEncodingTagged = $(mkToEncoding optsTagSingleConstructors ''OneConstructor)
363+
364+thOneConstructorParseJSONTagged :: Value -> Parser OneConstructor
365+thOneConstructorParseJSONTagged = $(mkParseJSON optsTagSingleConstructors ''OneConstructor)
366+
367+
368+gOneConstructorToJSONDefault :: OneConstructor -> Value
369+gOneConstructorToJSONDefault = genericToJSON defaultOptions
370+
371+gOneConstructorToEncodingDefault :: OneConstructor -> Encoding
372+gOneConstructorToEncodingDefault = genericToEncoding defaultOptions
373+
374+gOneConstructorParseJSONDefault :: Value -> Parser OneConstructor
375+gOneConstructorParseJSONDefault = genericParseJSON defaultOptions
376+
377+gOneConstructorToJSONTagged :: OneConstructor -> Value
378+gOneConstructorToJSONTagged = genericToJSON optsTagSingleConstructors
379+
380+gOneConstructorToEncodingTagged :: OneConstructor -> Encoding
381+gOneConstructorToEncodingTagged = genericToEncoding optsTagSingleConstructors
382+
383+gOneConstructorParseJSONTagged :: Value -> Parser OneConstructor
384+gOneConstructorParseJSONTagged = genericParseJSON optsTagSingleConstructors
tests/Options.hs+6
@@ -42,3 +42,9 @@ optsUntaggedValue :: Options
4242optsUntaggedValue = optsDefault
4343 { sumEncoding = UntaggedValue
4444 }
45+
46+optsTagSingleConstructors :: Options
47+optsTagSingleConstructors = optsDefault
48+ { tagSingleConstructors = True
49+ , allNullaryToStringTag = False
50+ }
tests/Properties.hs+25−5
@@ -168,11 +168,14 @@ isTaggedObjectValue (Object obj) = "tag" `H.member` obj &&
168168isTaggedObjectValue _ = False
169169
170170isNullaryTaggedObject :: Value -> Bool
171−isNullaryTaggedObject obj = isTaggedObject obj && isObjectWithSingleField obj
171+isNullaryTaggedObject obj = isTaggedObject' obj && isObjectWithSingleField obj
172172
173−isTaggedObject :: Value -> Bool
174−isTaggedObject (Object obj) = "tag" `H.member` obj
175−isTaggedObject _ = False
173+isTaggedObject :: Value -> Property
174+isTaggedObject = checkValue isTaggedObject'
175+
176+isTaggedObject' :: Value -> Bool
177+isTaggedObject' (Object obj) = "tag" `H.member` obj
178+isTaggedObject' _ = False
176179
177180isObjectWithSingleField :: Value -> Bool
178181isObjectWithSingleField (Object obj) = H.size obj == 1
@@ -338,6 +341,14 @@ tests = testGroup "properties" [
338341#endif
339342 ]
340343 ]
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+ ]
341352 ]
342353 , testGroup "toEncoding" [
343354 testProperty "NullaryString" $
@@ -386,6 +397,11 @@ tests = testGroup "properties" [
386397
387398 , testProperty "SomeTypeOmitNothingFields" $
388399 gSomeTypeToJSONOmitNothingFields `sameAs` gSomeTypeToEncodingOmitNothingFields
400+
401+ , testProperty "OneConstructorDefault" $
402+ gOneConstructorToJSONDefault `sameAs` gOneConstructorToEncodingDefault
403+ , testProperty "OneConstructorTagged" $
404+ gOneConstructorToJSONTagged `sameAs` gOneConstructorToEncodingTagged
389405 ]
390406 ]
391407 , testGroup "template-haskell" [
@@ -440,8 +456,10 @@ tests = testGroup "properties" [
440456 ]
441457 , testGroup "OneConstructor" [
442458 testProperty "default" (isEmptyArray . thOneConstructorToJSONDefault)
459+ , testProperty "Tagged" (isTaggedObject . thOneConstructorToJSONTagged)
443460 , testGroup "roundTrip" [
444461 testProperty "default" (toParseJSON thOneConstructorParseJSONDefault thOneConstructorToJSONDefault)
462+ , testProperty "Tagged" (toParseJSON thOneConstructorParseJSONTagged thOneConstructorToJSONTagged)
445463 ]
446464 ]
447465 ]
@@ -484,8 +502,10 @@ tests = testGroup "properties" [
484502 , testProperty "SomeTypeObjectWithSingleField unary agree" $
485503 thSomeTypeToEncodingObjectWithSingleField `sameAs1Agree` thSomeTypeLiftToEncodingObjectWithSingleField
486504
487− , testProperty "OneConstructor" $
505+ , testProperty "OneConstructorDefault" $
488506 thOneConstructorToJSONDefault `sameAs` thOneConstructorToEncodingDefault
507+ , testProperty "OneConstructorTagged" $
508+ thOneConstructorToJSONTagged `sameAs` thOneConstructorToEncodingTagged
489509 ]
490510 ]
491511 ]