@@ -403,44 +403,27 @@ isNullary :: Con -> Bool
403403isNullary (NormalC _ []) = True
404404isNullary _ = False
405405
406−sumToValue :: Options -> Bool -> Name -> Q Exp -> Q Exp
407−sumToValue opts multiCons conName exp
406+sumToValue :: Options -> Bool -> Bool -> Name -> Q Exp -> Q Exp
407+sumToValue opts multiCons nullary conName exp
408408 | multiCons =
409409 case sumEncoding opts of
410410 TwoElemArray ->
411411 [|Array|] `appE` ([|V.fromList|] `appE` listE [conStr opts conName, exp])
412412 TaggedObject{tagFieldName, contentsFieldName} ->
413− [|A.object|] `appE` listE
414− [ infixApp [|T.pack tagFieldName|] [|(.=)|] (conStr opts conName)
415− , infixApp [|T.pack contentsFieldName|] [|(.=)|] exp
416− ]
413+ let tag = infixApp [|T.pack tagFieldName|] [|(.=)|] (conStr opts conName)
414+ contents = infixApp [|T.pack contentsFieldName|] [|(.=)|] exp
415+ in
416+ [|A.object|] `appE` listE (if nullary then [tag] else [tag, contents])
417417 ObjectWithSingleField ->
418418 [|A.object|] `appE` listE
419419 [ infixApp (conTxt opts conName) [|(.=)|] exp
420420 ]
421+ UntaggedValue | nullary -> conStr opts conName
421422 UntaggedValue -> exp
422423 | otherwise = exp
423424
424−nullarySumToValue :: Options -> Bool -> Name -> Q Exp
425−nullarySumToValue opts multiCons conName =
426− case sumEncoding opts of
427− TaggedObject{tagFieldName} ->
428− [|A.object|] `appE` listE
429− [ infixApp [|T.pack tagFieldName|] [|(.=)|] (conStr opts conName)
430− ]
431− UntaggedValue -> conStr opts conName
432− _ -> sumToValue opts multiCons conName [e|toJSON ([] :: [()])|]
433−
434425-- | Generates code to generate the JSON encoding of a single constructor.
435426argsToValue :: JSONClass -> [(Name, Name)] -> Options -> Bool -> Con -> Q Match
436−-- Nullary constructors. Generates code that explicitly matches against the
437−-- constructor even though it doesn't contain data. This is useful to prevent
438−-- type errors.
439−argsToValue jc tjs opts multiCons (NormalC conName []) = do
440− ([], _) <- reifyConTys jc tjs conName
441− match (conP conName [])
442− (normalB (nullarySumToValue opts multiCons conName))
443− []
444427
445428-- Polyadic constructors with special case for unary constructors.
446429argsToValue jc tjs opts multiCons (NormalC conName ts) = do
@@ -471,7 +454,7 @@ argsToValue jc tjs opts multiCons (NormalC conName ts) = do
471454 (varE 'V.create `appE`
472455 doE (newMV:stmts++[ret]))
473456 match (conP conName $ map varP args)
474− (normalB $ sumToValue opts multiCons conName js)
457+ (normalB $ sumToValue opts multiCons (null ts) conName js)
475458 []
476459
477460-- Records.
@@ -538,7 +521,7 @@ argsToValue jc tjs opts multiCons (InfixC _ conName _) = do
538521 ar <- newName "argR"
539522 match (infixP (varP al) conName (varP ar))
540523 ( normalB
541− $ sumToValue opts multiCons conName
524+ $ sumToValue opts multiCons False conName
542525 $ [|toJSON|] `appE` listE [ dispatchToJSON jc conName tvMap aTy
543526 `appE` varE a
544527 | (a, aTy) <- [(al,alTy), (ar,arTy)]
@@ -580,41 +563,27 @@ array exp = [|E.wrapArray|] `appE` exp
580563object :: ExpQ -> ExpQ
581564object exp = [|E.wrapObject|] `appE` exp
582565
583−sumToEncoding :: Options -> Bool -> Name -> Q Exp -> Q Exp
584−sumToEncoding opts multiCons conName exp
566+sumToEncoding :: Options -> Bool -> Bool -> Name -> Q Exp -> Q Exp
567+sumToEncoding opts multiCons nullary conName exp
585568 | multiCons =
586569 let fexp = exp in
587570 case sumEncoding opts of
588571 TwoElemArray ->
589572 array (encStr opts conName <%> fexp)
590573 TaggedObject{tagFieldName, contentsFieldName} ->
591− object $
592− ([|E.text (T.pack tagFieldName)|] <:> encStr opts conName) <%>
593− ([|E.text (T.pack contentsFieldName)|] <:> fexp)
574+ let tag = [|E.text (T.pack tagFieldName)|] <:> encStr opts conName
575+ contents = [|E.text (T.pack contentsFieldName)|] <:> fexp
576+ in
577+ object $
578+ if nullary then tag else tag <%> contents
594579 ObjectWithSingleField ->
595580 object (encStr opts conName <:> fexp)
581+ UntaggedValue | nullary -> encStr opts conName
596582 UntaggedValue -> exp
597583 | otherwise = exp
598584
599−nullarySumToEncoding :: Options -> Bool -> Name -> Q Exp
600−nullarySumToEncoding opts multiCons conName =
601− case sumEncoding opts of
602− TaggedObject{tagFieldName} ->
603− object $
604− [|E.text (T.pack tagFieldName)|] <:> encStr opts conName
605− UntaggedValue -> encStr opts conName
606− _ -> sumToEncoding opts multiCons conName [e|toEncoding ([] :: [()])|]
607−
608585-- | Generates code to generate the JSON encoding of a single constructor.
609586argsToEncoding :: JSONClass -> [(Name, Name)] -> Options -> Bool -> Con -> Q Match
610−-- Nullary constructors. Generates code that explicitly matches against the
611−-- constructor even though it doesn't contain data. This is useful to prevent
612−-- type errors.
613−argsToEncoding jc tes opts multiCons (NormalC conName []) = do
614− ([], _) <- reifyConTys jc tes conName
615− match (conP conName [])
616− (normalB (nullarySumToEncoding opts multiCons conName))
617− []
618587
619588-- Polyadic constructors with special case for unary constructors.
620589argsToEncoding jc tes opts multiCons (NormalC conName ts) = do
@@ -622,6 +591,9 @@ argsToEncoding jc tes opts multiCons (NormalC conName ts) = do
622591 let len = length ts
623592 args <- newNameList "arg" len
624593 js <- case zip args argTys of
594+ -- Nullary constructors are converted to an empty array.
595+ [] -> return [| E.emptyArray_ |]
596+
625597 -- Single argument is directly converted.
626598 [(e,eTy)] -> return (dispatchToEncoding jc conName tvMap eTy
627599 `appE` varE e)
@@ -632,7 +604,7 @@ argsToEncoding jc tes opts multiCons (NormalC conName ts) = do
632604 | (x,xTy) <- es
633605 ]))
634606 match (conP conName $ map varP args)
635− (normalB $ sumToEncoding opts multiCons conName js)
607+ (normalB $ sumToEncoding opts multiCons (null ts) conName js)
636608 []
637609
638610-- Records.
@@ -701,7 +673,7 @@ argsToEncoding jc tes opts multiCons (InfixC _ conName _) = do
701673 ([alTy,arTy], tvMap) <- reifyConTys jc tes conName
702674 match (infixP (varP al) conName (varP ar))
703675 ( normalB
704− $ sumToEncoding opts multiCons conName
676+ $ sumToEncoding opts multiCons False conName
705677 $ array (foldr1 (<%>) [ dispatchToEncoding jc conName tvMap aTy
706678 `appE` varE a
707679 | (a,aTy) <- [(al,alTy), (ar,arTy)]