git.iko.soy/typeable/aeson
on master help sign in
Tests for OneConstructor and tagSingleConstructors
235d387lyxia
tests/Encoders.hs+28
compare with master
unifiedsplit
@@ -354,3 +354,31 @@ thOneConstructorToEncodingDefault = $(mkToEncoding defaultOptions ''OneConstruct
354
354
355thOneConstructorParseJSONDefault :: Value -> Parser OneConstructor
355thOneConstructorParseJSONDefault :: Value -> Parser OneConstructor
356thOneConstructorParseJSONDefault = $(mkParseJSON defaultOptions ''OneConstructor)
356thOneConstructorParseJSONDefault = $(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
42optsUntaggedValue = optsDefault
42optsUntaggedValue = optsDefault
43 { sumEncoding = UntaggedValue
43 { sumEncoding = UntaggedValue
44 }
44 }
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 &&
168isTaggedObjectValue _ = False
168isTaggedObjectValue _ = False
169
169
170isNullaryTaggedObject :: Value -> Bool
170isNullaryTaggedObject :: Value -> Bool
171−isNullaryTaggedObject obj = isTaggedObject obj && isObjectWithSingleField obj
171+isNullaryTaggedObject obj = isTaggedObject' obj && isObjectWithSingleField obj
172
172
173−isTaggedObject :: Value -> Bool
173+isTaggedObject :: Value -> Property
174+isTaggedObject = checkValue isTaggedObject'
175+
176+isTaggedObject' :: Value -> Bool
174−isTaggedObject (Object obj) = "tag" `H.member` obj
177+isTaggedObject' (Object obj) = "tag" `H.member` obj
175−isTaggedObject _ = False
178+isTaggedObject' _ = False
176
179
177isObjectWithSingleField :: Value -> Bool
180isObjectWithSingleField :: Value -> Bool
178isObjectWithSingleField (Object obj) = H.size obj == 1
181isObjectWithSingleField (Object obj) = H.size obj == 1
@@ -338,6 +341,14 @@ tests = testGroup "properties" [
338#endif
341#endif
339 ]
342 ]
340 ]
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+ ]
341 ]
352 ]
342 , testGroup "toEncoding" [
353 , testGroup "toEncoding" [
343 testProperty "NullaryString" $
354 testProperty "NullaryString" $
@@ -386,6 +397,11 @@ tests = testGroup "properties" [
386
397
387 , testProperty "SomeTypeOmitNothingFields" $
398 , testProperty "SomeTypeOmitNothingFields" $
388 gSomeTypeToJSONOmitNothingFields `sameAs` gSomeTypeToEncodingOmitNothingFields
399 gSomeTypeToJSONOmitNothingFields `sameAs` gSomeTypeToEncodingOmitNothingFields
400+
401+ , testProperty "OneConstructorDefault" $
402+ gOneConstructorToJSONDefault `sameAs` gOneConstructorToEncodingDefault
403+ , testProperty "OneConstructorTagged" $
404+ gOneConstructorToJSONTagged `sameAs` gOneConstructorToEncodingTagged
389 ]
405 ]
390 ]
406 ]
391 , testGroup "template-haskell" [
407 , testGroup "template-haskell" [
@@ -440,8 +456,10 @@ tests = testGroup "properties" [
440 ]
456 ]
441 , testGroup "OneConstructor" [
457 , testGroup "OneConstructor" [
442 testProperty "default" (isEmptyArray . thOneConstructorToJSONDefault)
458 testProperty "default" (isEmptyArray . thOneConstructorToJSONDefault)
459+ , testProperty "Tagged" (isTaggedObject . thOneConstructorToJSONTagged)
443 , testGroup "roundTrip" [
460 , testGroup "roundTrip" [
444 testProperty "default" (toParseJSON thOneConstructorParseJSONDefault thOneConstructorToJSONDefault)
461 testProperty "default" (toParseJSON thOneConstructorParseJSONDefault thOneConstructorToJSONDefault)
462+ , testProperty "Tagged" (toParseJSON thOneConstructorParseJSONTagged thOneConstructorToJSONTagged)
445 ]
463 ]
446 ]
464 ]
447 ]
465 ]
@@ -484,8 +502,10 @@ tests = testGroup "properties" [
484 , testProperty "SomeTypeObjectWithSingleField unary agree" $
502 , testProperty "SomeTypeObjectWithSingleField unary agree" $
485 thSomeTypeToEncodingObjectWithSingleField `sameAs1Agree` thSomeTypeLiftToEncodingObjectWithSingleField
503 thSomeTypeToEncodingObjectWithSingleField `sameAs1Agree` thSomeTypeLiftToEncodingObjectWithSingleField
486
504
487− , testProperty "OneConstructor" $
505+ , testProperty "OneConstructorDefault" $
488 thOneConstructorToJSONDefault `sameAs` thOneConstructorToEncodingDefault
506 thOneConstructorToJSONDefault `sameAs` thOneConstructorToEncodingDefault
507+ , testProperty "OneConstructorTagged" $
508+ thOneConstructorToJSONTagged `sameAs` thOneConstructorToEncodingTagged
489 ]
509 ]
490 ]
510 ]
491 ]
511 ]