-
Notifications
You must be signed in to change notification settings - Fork 22
/
Json.hs
318 lines (294 loc) · 14.4 KB
/
Json.hs
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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
{-# LANGUAGE OverloadedStrings #-}
module ADL.Compiler.Backends.Java.Json(
generateStructJson,
generateNewtypeJson,
generateUnionJson,
generateEnumJson
) where
import Control.Monad(when)
import Data.Foldable(for_,fold)
import Data.Maybe(isJust)
import Data.Monoid
import Data.String(IsString(..))
import Data.Traversable(for)
import qualified Data.Text as T
import ADL.Compiler.AST
import ADL.Compiler.Processing
import ADL.Compiler.Primitive
import ADL.Compiler.Backends.Java.Internal
import ADL.Utils.IndentedCode
import ADL.Utils.Format
generateStructJson :: CodeGenProfile -> CDecl -> Struct CResolvedType -> [FieldDetails] -> CState ()
generateStructJson cgp decl struct fieldDetails = do
let typeArgs = case s_typeParams struct of
[] -> ""
args -> "<" <> commaSep (map unreserveWord args) <> ">"
className = unreserveWord (d_name decl) <> typeArgs
factoryI <- addImport (javaClass (cgp_runtimePackage cgp) "Factory")
lazyC <- addImport (javaClass (cgp_runtimePackage cgp) "Lazy")
jsonBindingI <- addImport (javaClass (cgp_runtimePackage cgp) "JsonBinding")
jsonBindingsI <- addImport (javaClass (cgp_runtimePackage cgp) "JsonBindings")
jsonElementI <- addImport "com.google.gson.JsonElement"
jsonObjectI <- addImport "com.google.gson.JsonObject"
jsonBindings <- mapM (genJsonBindingExpr cgp . f_type . fd_field) fieldDetails
let bindingArgs = commaSep [template "$1<$2> $3" [jsonBindingI,arg,"binding" <> arg] | arg <- s_typeParams struct]
let factory =
cblock (template "public static$1 $2<$3> jsonBinding($4)" [typeArgs,jsonBindingI,className,bindingArgs]) (
clineN
[ template "final $1<$2<$3>> $4 = new $1<>(() -> $5);" [lazyC,jsonBindingI,fd_boxedTypeExprStr fd,fd_varName fd,binding]
| (fd,binding) <- zip fieldDetails jsonBindings]
<>
clineN
[ template "final $1<$2> factory$2 = binding$2.factory();" [factoryI,typeParam]
| typeParam <- s_typeParams struct]
<>
case s_typeParams struct of
[] -> ctemplate "final $1<$2> _factory = FACTORY;" [factoryI,className]
tparams -> ctemplate "final $1<$2> _factory = factory($3);" [factoryI,className,commaSep [template "binding$1.factory()" [i] | i <-tparams ]]
<>
cline ""
<>
cblock1 (template "return new $1<$2>()" [jsonBindingI,className]) (
cblock (template "public $1<$2> factory()" [factoryI,className]) (
cline "return _factory;"
)
<>
cline ""
<>
cblock (template "public $1 toJson($2 _value)" [jsonElementI,className]) (
ctemplate "$1 _result = new $1();" [jsonObjectI]
<>
clineN
[ template "_result.add(\"$1\", $2.get().toJson(_value.$3));" [fd_serializedName fd,fd_varName fd,fd_memberVarName fd]
| fd <- fieldDetails]
<>
cline "return _result;"
)
<>
cline ""
<>
cblock (template "public $1 fromJson($2 _json)" [className,jsonElementI]) (
ctemplate "$1 _obj = $2.objectFromJson(_json);" [jsonObjectI,jsonBindingsI]
<>
( ctemplate "return new $1(" [className]
<>
indent (
let terminators = replicate (length fieldDetails-1) "," <> [""]
requiredField fd terminator =
template "$2.fieldFromJson(_obj, \"$1\", $3.get())$4"
[fd_serializedName fd,jsonBindingsI, fd_varName fd,terminator]
optionalField fd terminator =
template "_obj.has(\"$1\") ? $2.fieldFromJson(_obj, \"$1\", $3.get()) : $4$5"
[fd_serializedName fd,jsonBindingsI, fd_varName fd,fd_defValue fd,terminator]
in
clineN
[ if isJust (f_default (fd_field fd))
then optionalField fd terminator
else requiredField fd terminator
| (fd,terminator) <- zip fieldDetails terminators]
)
<>
cline ");"
)
)
)
)
addMethod (cline "/* Json serialization */")
addMethod factory
generateNewtypeJson :: CodeGenProfile -> CDecl -> Newtype CResolvedType -> Ident -> CState ()
generateNewtypeJson cgp decl newtype_ memberVarName = do
let typeArgs = case n_typeParams newtype_ of
[] -> ""
args -> "<" <> commaSep (map unreserveWord args) <> ">"
className = unreserveWord (d_name decl) <> typeArgs
factoryI <- addImport (javaClass (cgp_runtimePackage cgp) "Factory")
jsonBindingI <- addImport (javaClass (cgp_runtimePackage cgp) "JsonBinding")
jsonElementI <- addImport "com.google.gson.JsonElement"
jsonObjectI <- addImport "com.google.gson.JsonObject"
jsonBinding <- genJsonBindingExpr cgp (n_typeExpr newtype_)
boxedTypeExprStr <- genTypeExprB TypeBoxed (n_typeExpr newtype_)
let bindingArgs = commaSep [template "$1<$2> $3" [jsonBindingI,arg,"binding" <> arg] | arg <- n_typeParams newtype_]
let factory =
cblock (template "public static$1 $2<$3> jsonBinding($4)" [typeArgs,jsonBindingI,className,bindingArgs]) (
ctemplate "final $1<$2> _binding = $3;" [jsonBindingI,boxedTypeExprStr,jsonBinding]
<>
case n_typeParams newtype_ of
[] -> ctemplate "final $1<$2> _factory = FACTORY;" [factoryI,className]
tparams -> ctemplate "final $1<$2> _factory = factory($3);" [factoryI,className,commaSep [template "binding$1.factory()" [i] | i <-tparams ]]
<>
cline ""
<>
cblock1 (template "return new $1<$2>()" [jsonBindingI,className]) (
cblock (template "public $1<$2> factory()" [factoryI,className]) (
cline "return _factory;"
)
<>
cline ""
<>
cblock (template "public $1 toJson($2 _value)" [jsonElementI,className]) (
ctemplate "return _binding.toJson(_value.$1);" [memberVarName]
)
<>
cline ""
<>
cblock (template "public $1 fromJson($2 _json)" [className,jsonElementI]) (
ctemplate "return new $1(_binding.fromJson(_json));" [className]
)
)
)
addMethod (cline "/* Json serialization */")
addMethod factory
generateUnionJson :: CodeGenProfile -> CDecl -> Union CResolvedType -> [FieldDetails] -> CState ()
generateUnionJson cgp decl union fieldDetails = do
let typeArgs = case u_typeParams union of
[] -> ""
args -> "<" <> commaSep (map unreserveWord args) <> ">"
className0 = unreserveWord (d_name decl)
className = className0 <> typeArgs
factoryI <- addImport (javaClass (cgp_runtimePackage cgp) "Factory")
lazyC <- addImport (javaClass (cgp_runtimePackage cgp) "Lazy")
jsonBindingI <- addImport (javaClass (cgp_runtimePackage cgp) "JsonBinding")
jsonBindingsI <- addImport (javaClass (cgp_runtimePackage cgp) "JsonBindings")
jsonElementI <- addImport "com.google.gson.JsonElement"
jsonObjectI <- addImport "com.google.gson.JsonObject"
jsonPrimitiveI <- addImport "com.google.gson.JsonPrimitive"
mapI <- addImport "java.util.Map"
jsonBindings <- mapM (genJsonBindingExpr cgp . f_type . fd_field) fieldDetails
let bindingArgs = commaSep [template "$1<$2> $3" [jsonBindingI,arg,"binding" <> arg] | arg <- u_typeParams union]
let factory =
cblock (template "public static$1 $2<$3> jsonBinding($4)" [typeArgs,jsonBindingI,className,bindingArgs]) (
clineN
[ template "final $1<$2<$3>> $4 = new $1<>(() -> $5);" [lazyC,jsonBindingI,fd_boxedTypeExprStr fd,fd_varName fd,binding]
| (fd,binding) <- zip fieldDetails jsonBindings]
<>
clineN
[ template "final $1<$2> factory$2 = binding$2.factory();" [factoryI,typeParam]
| typeParam <- u_typeParams union]
<>
case u_typeParams union of
[] -> ctemplate "final $1<$2> _factory = FACTORY;" [factoryI,className]
tparams -> ctemplate "final $1<$2> _factory = factory($3);" [factoryI,className,commaSep [template "binding$1.factory()" [i] | i <-tparams ]]
<>
cline ""
<>
cblock1 (template "return new $1<$2>()" [jsonBindingI,className]) (
cblock (template "public $1<$2> factory()" [factoryI,className]) (
cline "return _factory;"
)
<>
cline ""
<>
cblock (template "public $1 toJson($2 _value)" [jsonElementI,className]) (
cblock "switch (_value.getDisc())" (
mconcat [
ctemplate "case $1:" [discriminatorName fd]
<>
indent (
if isVoidType (f_type (fd_field fd))
then ctemplate "return $1.unionToJson(\"$2\", null, null);"
[jsonBindingsI, fd_serializedName fd]
else ctemplate "return $1.unionToJson(\"$2\", _value.$3, $4.get());"
[jsonBindingsI, fd_serializedName fd, fd_accessExpr fd, fd_varName fd]
)
| fd <- fieldDetails ]
)
<>
cline "return null;"
)
<>
cline ""
<>
cblock (template "public $1 fromJson($2 _json)" [className,jsonElementI]) (
ctemplate "String _key = $1.unionNameFromJson(_json);" [jsonBindingsI]
<>
let returnStatements = [
if isVoidType (f_type (fd_field fd))
then ctemplate "return $1.$2$3();" [className0,typeArgs,fd_unionCtorName fd]
else ctemplate "return $1.$2$3($4.unionValueFromJson(_json, $5.get()));" [className0,typeArgs,fd_unionCtorName fd, jsonBindingsI, fd_varName fd]
| fd <- fieldDetails]
in ctemplate "if (_key.equals(\"$1\")) {" [fd_serializedName (head fieldDetails)]
<>
indent (head returnStatements)
<>
mconcat [
cline "}"
<>
ctemplate "else if (_key.equals(\"$1\")) {" [fd_serializedName fd]
<>
indent returnCase
| (fd,returnCase) <- zip (tail fieldDetails) (tail returnStatements)]
<>
cline "}"
<>
cline "throw new IllegalStateException();"
)
)
)
addMethod (cline "/* Json serialization */")
addMethod factory
generateEnumJson :: CodeGenProfile -> CDecl -> Union CResolvedType -> [FieldDetails] -> CState ()
generateEnumJson cgp decl union fieldDetails = do
factoryI <- addImport (javaClass (cgp_runtimePackage cgp) "Factory")
jsonBindingI <- addImport (javaClass (cgp_runtimePackage cgp) "JsonBinding")
jsonElementI <- addImport "com.google.gson.JsonElement"
jsonPrimitiveI <- addImport "com.google.gson.JsonPrimitive"
jsonParseExceptionI <- addImport (javaClass (cgp_runtimePackage cgp) "JsonParseException")
let className = unreserveWord (d_name decl)
factory = cblock (template "public static $1<$2> jsonBinding()" [jsonBindingI,className])
( cblock1 (template "return new $1<$2>()" [jsonBindingI,className])
( cblock (template "public $1<$2> factory()" [factoryI,className])
( cline "return FACTORY;"
)
<> cline ""
<> cblock (template "public $1 toJson($2 _value)" [jsonElementI,className])
( ctemplate "return new $1(_value.toString());" [jsonPrimitiveI]
)
<> cline ""
<> cblock (template "public $1 fromJson($2 _json)" [className,jsonElementI])
( cline "try {"
<> indent (cline "return fromString(_json.getAsString());")
<> cline "} catch (IllegalArgumentException e) {"
<> indent (ctemplate "throw new $1(e.getMessage());" [jsonParseExceptionI])
<> cline "}"
)
)
)
addMethod (cline "/* Json serialization */")
addMethod factory
genJsonBindingExpr :: CodeGenProfile -> TypeExpr CResolvedType -> CState T.Text
genJsonBindingExpr cgp (TypeExpr rt params) = do
bparams <- mapM (genJsonBindingExpr cgp) params
case rt of
(RT_Named (scopedName,Decl{d_customType=mct})) -> do
fscope <- case mct of
Nothing -> genScopedName scopedName
(Just ct) -> getHelpers ct
return (template "$1.jsonBinding($2)" [fscope,commaSep bparams])
(RT_Param ident) -> return ("binding" <> ident)
(RT_Primitive pt) -> do
prim <- primJsonBinding cgp pt
case bparams of
[] -> return prim
_ -> return (template "$1($2)" [prim,commaSep bparams])
primJsonBinding :: CodeGenProfile -> PrimitiveType -> CState T.Text
primJsonBinding cgp pt = do
jsonBindingsI <- addImport (javaClass (cgp_runtimePackage cgp) "JsonBindings")
return (jsonBindingsI <> "." <> bindingName pt)
where
bindingName P_Void = "VOID"
bindingName P_Bool = "BOOLEAN"
bindingName P_Int8 = "BYTE"
bindingName P_Int16 = "SHORT"
bindingName P_Int32 = "INTEGER"
bindingName P_Int64 = "LONG"
bindingName P_Word8 = "BYTE"
bindingName P_Word16 = "SHORT"
bindingName P_Word32 = "INTEGER"
bindingName P_Word64 = "LONG"
bindingName P_Float = "FLOAT"
bindingName P_Double = "DOUBLE"
bindingName P_ByteVector = "BYTE_ARRAY"
bindingName P_String = "STRING"
bindingName P_Vector = "arrayList"
bindingName P_StringMap = "stringMap"
bindingName P_Sink = "SINK"