New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
TaggedObject encoding for Nullary constructor includes "contents" #300
Comments
Below is a patch that changes the behavior of the generic implementation for Nullary constructors in the TaggedObject SumEncoding. Referring to my example above, it should encode Does this make sense? I am pretty new to Haskell, so sorry if it doesn't. diff --git a/Data/Aeson/Types/Generic.hs b/Data/Aeson/Types/Generic.hs
index 965fe30..669ee1b 100644
--- a/Data/Aeson/Types/Generic.hs
+++ b/Data/Aeson/Types/Generic.hs
@@ -344,6 +344,13 @@ instance (Selector s, ToJSON a) => RecordTo (S1 s (K1 i (Maybe a))) where
recordToEncoding opts m1 = fieldToEncoding opts m1
{-# INLINE recordToEncoding #-}
+instance RecordTo U1 where
+ recordToPairs _ U1 = empty
+ {-# INLINE recordToPairs #-}
+
+ recordToEncoding _ U1 = mempty
+ {-# INLINE recordToEncoding #-}
+
fieldToPair :: (Selector s, GToJSON a) => Options -> S1 s a p -> DList Pair
fieldToPair opts m1 = pure ( pack $ fieldLabelModifier opts $ selName m1
, gToJSON opts (unM1 m1)
@@ -663,6 +670,10 @@ instance (Selector s, FromJSON a) => FromRecord (S1 s (K1 i (Maybe a))) where
selName (undefined :: t s (K1 i (Maybe a)) p)
{-# INLINE parseRecord #-}
+instance FromRecord U1 where
+ parseRecord _ _ obj = return U1
+ {-# INLINE parseRecord #-}
+
--------------------------------------------------------------------------------
class ProductSize f where
@@ -727,7 +738,7 @@ instance (IsRecord f isRecord) => IsRecord (f :*: g) isRecord
instance IsRecord (M1 S NoSelector f) False
instance (IsRecord f isRecord) => IsRecord (M1 S c f) isRecord
instance IsRecord (K1 i c) True
-instance IsRecord U1 False
+instance IsRecord U1 True
where isUnary = const False
--------------------------------------------------------------------------------
diff --git a/tests/Properties.hs b/tests/Properties.hs
index 03c2640..6f25e38 100644
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -95,6 +95,9 @@ isTaggedObjectValue (Object obj) = "tag" `H.member` obj &&
"contents" `H.member` obj
isTaggedObjectValue _ = False
+isNullaryTaggedObject :: Value -> Bool
+isNullaryTaggedObject obj = isTaggedObject obj && isObjectWithSingleField obj
+
isTaggedObject :: Value -> Bool
isTaggedObject (Object obj) = "tag" `H.member` obj
isTaggedObject _ = False
@@ -142,12 +145,26 @@ tests = testGroup "properties" [
, testGroup "failure messages" [
testProperty "modify failure" modifyFailureProp
]
+ , testGroup "generic" [
+ testGroup "toJSON" [
+ testGroup "Nullary" [
+ testProperty "2ElemArray" (is2ElemArray . gNullaryToJSON2ElemArray)
+ , testProperty "TaggedObject" (isNullaryTaggedObject . gNullaryToJSONTaggedObject)
+ ]
+ , testGroup "SomeType" [
+ testProperty "2ElemArray" (is2ElemArray . gSomeTypeToJSON2ElemArray)
+ , testProperty "TaggedObject" (isTaggedObject . gSomeTypeToJSONTaggedObject)
+ , testProperty "ObjectWithSingleField" (isObjectWithSingleField . gSomeTypeToJSONObjectWithSingleField)
+ ]
+ ]
+ ]
, testGroup "template-haskell" [
testGroup "toJSON" [
testGroup "Nullary" [
testProperty "string" (isString . thNullaryToJSONString)
, testProperty "2ElemArray" (is2ElemArray . thNullaryToJSON2ElemArray)
- , testProperty "TaggedObject" (isTaggedObjectValue . thNullaryToJSONTaggedObject)
+ , testProperty "TaggedObject" (isTaggedObject . thNullaryToJSONTaggedObject)
+ -- , testProperty "TaggedObject" (isNullaryTaggedObject . thNullaryToJSONTaggedObject)
, testProperty "ObjectWithSingleField" (isObjectWithSingleField . thNullaryToJSONObjectWithSingleField)
, testGroup "roundTrip" [
|
I agree it's nicer if the encoding of nullary constructors doesn't contain the "contents" field. It would be great if you can prepare a pull request which not only changes the GHC Generics implementation (like you've already done) but also the corresponding Template Haskell implementation. We always want these to match up. |
Merged as 0ee8f79 |
Suppose I want to encode the following type as JSON using TaggedObject SumEncoding.
The output of converting
One "bla"
to JSON is{ "tag": "One", "contents": ["bla"] }
, which is sensible.However, when converting
Zero
to JSON, you get{ "tag": "Zero", "contents": [] }
. While technically correct, the "contents" key is completely unnecessary. Worse even, the "contents" key is required for the type to be parsed again.This is awkward if one wants to use the JSON format as an external interface. Of course, it is possible to manually implement the FromJSON and ToJSON instances for that type, but that is tedious work.
I cannot imagine a case where one would like the empty "contents" key to be there. Is this intended behavior? Is there something I am missing?
The text was updated successfully, but these errors were encountered: