1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module UnitTests.OptionalFields (optionalFields) where
import GHC.Generics (Generic)
import Data.Maybe (isNothing)
import UnitTests.OptionalFields.Common
import UnitTests.OptionalFields.Generics (omitGenerics)
import UnitTests.OptionalFields.TH (omitTH)
import UnitTests.OptionalFields.Manual (omitManual)
optionalFields :: TestTree
optionalFields = testGroup "optional fields"
[ omitGenerics
, omitTH
, omitManual
, proofOfConcept
]
-- c.f. https://github.com/haskell/aeson/pull/839#issuecomment-782453060
data P = P
{ x :: Nullable Int -- Field is required, but can be null.
, y :: Undefineable Int -- Field is optional, but cannot be null.
, z :: NullOrUndefineable Int -- Field is optional, and can be null.
}
deriving (Eq, Show, Generic)
instance ToJSON P where
toJSON = genericToJSON opts
toEncoding = genericToEncoding opts
instance FromJSON P where
parseJSON = genericParseJSON opts
newtype Nullable a = Nullable (Maybe a)
deriving (Eq, Show, Generic)
instance ToJSON a => ToJSON (Nullable a) where
toJSON = genericToJSON opts
toEncoding = genericToEncoding opts
instance FromJSON a => FromJSON (Nullable a) where
parseJSON = genericParseJSON opts
newtype Undefineable a = Undefineable (Maybe a)
deriving (Eq, Show, Generic)
instance ToJSON a => ToJSON (Undefineable a) where
toJSON = genericToJSON opts
toEncoding = genericToEncoding opts
omitField (Undefineable a) = isNothing a
instance FromJSON a => FromJSON (Undefineable a) where
parseJSON Null = fail "Undefineable.parseJSON: expected non-null value"
parseJSON v = genericParseJSON opts v
omittedField = Just (Undefineable Nothing)
newtype NullOrUndefineable a = NullOrUndefineable (Maybe a)
deriving (Eq, Show, Generic)
instance ToJSON a => ToJSON (NullOrUndefineable a) where
toJSON = genericToJSON opts
toEncoding = genericToEncoding opts
omitField (NullOrUndefineable a) = isNothing a
instance FromJSON a => FromJSON (NullOrUndefineable a) where
parseJSON = genericParseJSON opts
omittedField = Just (NullOrUndefineable Nothing)
opts :: Options
opts = defaultOptions { omitNothingFields = True }
fullP :: P
fullP = P (Nullable $ Just 0) (Undefineable $ Just 0) (NullOrUndefineable $ Just 0)
zero :: Key -> (Key, Value)
zero k = k .= (0 :: Int)
proofOfConcept :: TestTree
proofOfConcept = testGroup "Type-directed optional fields Proof of Concept"
[ testGroup "toJSON"
[ testCase "x is not omitted when Nothing" $
let subject = fullP {x = Nullable Nothing}
expected = object ["x" .= Null, zero "y", zero "z"]
in toJSON subject @?= expected
, testCase "y is omitted when Nothing" $
let subject = fullP {y = Undefineable Nothing}
expected = object [zero "x", zero "z"]
in toJSON subject @?= expected
, testCase "z is omitted when Nothing" $
let subject = fullP {z = NullOrUndefineable Nothing}
expected = object [zero "x", zero "y"]
in toJSON subject @?= expected
]
, testGroup "parseJSON"
[ testCase "x can be null" $
let subject = object ["x" .= Null, zero "y", zero "z"]
expected = Just fullP {x = Nullable Nothing}
in decode (encode subject) @?= expected
, testCase "x cannot be omitted" $
let subject = object [zero "y", zero "z"]
expected = Nothing :: Maybe P
in decode (encode subject) @?= expected
, testCase "y can be omitted" $
let subject = object [zero "x", zero "z"]
expected = Just fullP {y = Undefineable Nothing}
in decode (encode subject) @?= expected
, testCase "y cannot be null" $
let subject = object [zero "x", "y" .= Null, zero "z"]
expected = Nothing :: Maybe P
in decode (encode subject) @?= expected
, testCase "z can be null" $
let subject = object [zero "x", zero "y", "z" .= Null]
expected = Just fullP {z = NullOrUndefineable Nothing}
in decode (encode subject) @?= expected
, testCase "z can be omitted" $
let subject = object [zero "x", zero "y"]
expected = Just fullP {z = NullOrUndefineable Nothing}
in decode (encode subject) @?= expected
]
]
|
