Source file ag_oj_mapping.ml
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
open Printf
open Atd_ast
open Ag_error
open Ag_mapping
type o = Ag_ocaml.atd_ocaml_repr
type j = Ag_json.json_repr
type oj_mapping =
(Ag_ocaml.atd_ocaml_repr, Ag_json.json_repr) Ag_mapping.mapping
type oj_def =
(Ag_ocaml.atd_ocaml_repr, Ag_json.json_repr) Ag_mapping.def
let rec mapping_of_expr (x : type_expr) : oj_mapping =
match x with
`Sum (loc, l, an) ->
let ocaml_t = `Sum (Ag_ocaml.get_ocaml_sum an) in
let json_t = `Sum in
`Sum (loc, Array.of_list (List.map mapping_of_variant l),
ocaml_t, json_t)
| `Record (loc, l, an) ->
let ocaml_t = `Record (Ag_ocaml.get_ocaml_record an) in
let ocaml_field_prefix = Ag_ocaml.get_ocaml_field_prefix an in
let json_t = `Record in
`Record (loc,
Array.of_list
(List.map (mapping_of_field ocaml_field_prefix) l),
ocaml_t, json_t)
| `Tuple (loc, l, an) ->
let ocaml_t = `Tuple in
let json_t = `Tuple in
`Tuple (loc, Array.of_list (List.map mapping_of_cell l),
ocaml_t, json_t)
| `List (loc, x, an) ->
let ocaml_t = `List (Ag_ocaml.get_ocaml_list an) in
let json_t = `List (Ag_json.get_json_list an) in
`List (loc, mapping_of_expr x, ocaml_t, json_t)
| `Option (loc, x, an) ->
let ocaml_t = `Option in
let json_t = `Option in
`Option (loc, mapping_of_expr x, ocaml_t, json_t)
| `Nullable (loc, x, an) ->
let ocaml_t = `Nullable in
let json_t = `Nullable in
`Nullable (loc, mapping_of_expr x, ocaml_t, json_t)
| `Shared (loc, x, an) ->
error loc "Sharing is not supported by the JSON interface"
| `Wrap (loc, x, an) ->
let ocaml_t = `Wrap (Ag_ocaml.get_ocaml_wrap loc an) in
let json_t = `Wrap in
`Wrap (loc, mapping_of_expr x, ocaml_t, json_t)
| `Name (loc, (loc2, s, l), an) ->
(match s with
"unit" ->
`Unit (loc, `Unit, `Unit)
| "bool" ->
`Bool (loc, `Bool, `Bool)
| "int" ->
let o = Ag_ocaml.get_ocaml_int an in
`Int (loc, `Int o, `Int)
| "float" ->
let j = Ag_json.get_json_float an in
`Float (loc, `Float, `Float j)
| "string" ->
`String (loc, `String, `String)
| s ->
`Name (loc, s, List.map mapping_of_expr l, None, None)
)
| `Tvar (loc, s) ->
`Tvar (loc, s)
and mapping_of_cell (loc, x, an) =
let default = Ag_ocaml.get_ocaml_default an in
let doc = Ag_doc.get_doc loc an in
let ocaml_t =
`Cell {
Ag_ocaml.ocaml_default = default;
ocaml_fname = "";
ocaml_mutable = false;
ocaml_fdoc = doc;
}
in
let json_t = `Cell in
{
cel_loc = loc;
cel_value = mapping_of_expr x;
cel_arepr = ocaml_t;
cel_brepr = json_t
}
and mapping_of_variant = function
`Variant (loc, (s, an), o) ->
let ocaml_cons = Ag_ocaml.get_ocaml_cons s an in
let doc = Ag_doc.get_doc loc an in
let ocaml_t =
`Variant {
Ag_ocaml.ocaml_cons = ocaml_cons;
ocaml_vdoc = doc;
}
in
let json_t =
if Ag_json.get_json_untyped an
then `Variant { Ag_json.json_cons = None; }
else
let json_cons = Ag_json.get_json_cons s an in
`Variant { Ag_json.json_cons = Some json_cons; }
in
let arg =
match o with
None -> None
| Some x -> Some (mapping_of_expr x) in
{
var_loc = loc;
var_cons = s;
var_arg = arg;
var_arepr = ocaml_t;
var_brepr = json_t
}
| `Inherit _ -> assert false
and mapping_of_field ocaml_field_prefix = function
`Field (loc, (s, fk, an), x) ->
let fvalue = mapping_of_expr x in
let ocaml_default, json_unwrapped =
match fk, Ag_ocaml.get_ocaml_default an with
`Required, None -> None, false
| `Optional, None -> Some "None", true
| (`Required | `Optional), Some _ ->
error loc "Superfluous default OCaml value"
| `With_default, Some s -> Some s, false
| `With_default, None ->
None, false
in
let ocaml_fname = Ag_ocaml.get_ocaml_fname (ocaml_field_prefix ^ s) an in
let ocaml_mutable = Ag_ocaml.get_ocaml_mutable an in
let doc = Ag_doc.get_doc loc an in
let json_fname = Ag_json.get_json_fname s an in
let json_tag_field = Ag_json.get_json_tag_field an in
{ f_loc = loc;
f_name = s;
f_kind = fk;
f_value = fvalue;
f_arepr = `Field {
Ag_ocaml.ocaml_default = ocaml_default;
ocaml_fname = ocaml_fname;
ocaml_mutable = ocaml_mutable;
ocaml_fdoc = doc;
};
f_brepr = `Field {
Ag_json.json_fname = json_fname;
json_tag_field = json_tag_field;
json_unwrapped = json_unwrapped
};
}
| `Inherit _ -> assert false
let def_of_atd (loc, (name, param, an), x) =
let ocaml_predef = Ag_ocaml.get_ocaml_predef `Json an in
let doc = Ag_doc.get_doc loc an in
let o =
match as_abstract x with
Some (loc2, an2) ->
(match Ag_ocaml.get_ocaml_module_and_t `Json name an with
None -> None
| Some (types_module, main_module, ext_name) ->
let args = List.map (fun s -> `Tvar (loc, s)) param in
Some (`External
(loc, name, args,
`External (types_module, main_module, ext_name),
`External))
)
| None -> Some (mapping_of_expr x)
in
{
def_loc = loc;
def_name = name;
def_param = param;
def_value = o;
def_arepr = `Def { Ag_ocaml.ocaml_predef = ocaml_predef;
ocaml_ddoc = doc };
def_brepr = `Def;
}
let defs_of_atd_module l =
List.map (function `Type def -> def_of_atd def) l
let defs_of_atd_modules l =
List.map (fun (is_rec, l) -> (is_rec, defs_of_atd_module l)) l