Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 427 lines (373 sloc) 14.18 kb
fccc685 Initial open-source release
MLstate authored
1 (*
4b041c8 Quentin Bourgerie [fix] compiler, database: Adding all database ident to gamma, even if no...
BourgerieQuentin authored
2 Copyright © 2011, 2012 MLstate
fccc685 Initial open-source release
MLstate authored
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 (*
19 @author Louis Gesbert
20 **)
21
709cad4 Quentin Bourgerie [fix] compiler, database: compose and partial path
BourgerieQuentin authored
22 #<Debugvar:DBGEN_DEBUG>
23
2b94068 Quentin Bourgerie [enhance] compiler/lib: (big) default value on bson unserialize + fix up...
BourgerieQuentin authored
24 module Format = BaseFormat
fccc685 Initial open-source release
MLstate authored
25
1aa37e7 Quentin Bourgerie [feature] compiler, database: Default values generator take care of sele...
BourgerieQuentin authored
26 module List = BaseList
27
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
28 module Graph = SchemaGraphLib.SchemaGraph.SchemaGraph0
29
30 module DbAst = QmlAst.Db
31
32 module C = DbGen_common
33
5fdc6b9 Quentin Bourgerie [enhance] compiler: (big) Common path typing beetween several backend + ...
BourgerieQuentin authored
34 type engine = [`db3 | `mongo]
13f7390 Quentin Bourgerie [fix] DbGen: Since database runtime was moved of outside stdlib.core tyi...
BourgerieQuentin authored
35
36 let settyp = DbGen_common.settyp
fccc685 Initial open-source release
MLstate authored
37
5fdc6b9 Quentin Bourgerie [enhance] compiler: (big) Common path typing beetween several backend + ...
BourgerieQuentin authored
38 module Args = C.Args
39
5393694 Quentin Bourgerie [fix] compiler, database: Take the default or command line backend for d...
BourgerieQuentin authored
40 let get_engine = C.get_default
41
fccc685 Initial open-source release
MLstate authored
42 module Sch = Schema_private
43 module Schema = struct
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
44
fccc685 Initial open-source release
MLstate authored
45 type t = Sch.meta_schema
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
46
47 type database = {
48 name : string;
49 ident : Ident.t;
4b041c8 Quentin Bourgerie [fix] compiler, database: Adding all database ident to gamma, even if no...
BourgerieQuentin authored
50 dbty : QmlAst.ty;
121d046 Quentin Bourgerie [enhance] compiler, database: Just change type of database options
BourgerieQuentin authored
51 options : QmlAst.Db.options;
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
52 package : ObjectFiles.package_name;
53 }
54
53b5fad Quentin Bourgerie [enhance] compiler, database: Added query options
BourgerieQuentin authored
55 type query = QmlAst.expr DbAst.query * QmlAst.expr DbAst.query_options
c197c0f Quentin Bourgerie [enhance] compiler: (big) Added more update and query node + added typin...
BourgerieQuentin authored
56
57 type set_kind =
58 | Map of QmlAst.ty * QmlAst.ty
59 | DbSet of QmlAst.ty
60
61 type node_kind =
62 | Compose of (string * string list) list
63 | Plain
ea57f3d Quentin Bourgerie [fix] mongo: (big) Fixes on mongo behind dbgen, default values, parser e...
BourgerieQuentin authored
64 | Partial of bool (* Inside sum*) * string list * string list
fb519cd Quentin Bourgerie [enhance] compiler, database: Added sub path of multi node
BourgerieQuentin authored
65 | SetAccess of set_kind * string list * (bool (*is_unique*) * query) option * QmlAst.path option
c197c0f Quentin Bourgerie [enhance] compiler: (big) Added more update and query node + added typin...
BourgerieQuentin authored
66
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
67 type node = {
68 ty : QmlAst.ty;
69 kind : node_kind;
70 database : database;
1aa37e7 Quentin Bourgerie [feature] compiler, database: Default values generator take care of sele...
BourgerieQuentin authored
71 default : ?select:QmlAst.expr DbAst.select -> QmlAst.annotmap -> (QmlAst.annotmap * QmlAst.expr);
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
72 }
73
df80d98 Quentin Bourgerie [feature] compiler, database: Just naive update of libqmlcompil (for pat...
BourgerieQuentin authored
74 let pp_query fmt = function
75 | None -> ()
76 | Some (u, (q, o)) ->
77 Format.fprintf fmt "[%a%a]/* uniq : %b */"
78 (QmlAst.Db.pp_query QmlPrint.pp#expr) q
79 (QmlAst.Db.pp_options QmlPrint.pp#expr) o
80 u
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
81
c197c0f Quentin Bourgerie [enhance] compiler: (big) Added more update and query node + added typin...
BourgerieQuentin authored
82 let pp_set_kind fmt = function
83 | DbSet ty -> Format.fprintf fmt "dbset(%a)" QmlPrint.pp#ty ty
84 | Map (kt, vt) -> Format.fprintf fmt "map(%a, %a)" QmlPrint.pp#ty kt QmlPrint.pp#ty vt
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
85
86 let pp_kind fmt kind =
87 let pp_path fmt p =
88 List.iter (Format.fprintf fmt "/%s") p;
89 Format.fprintf fmt "/";
90 in
91 match kind with
92 | Plain -> Format.fprintf fmt "plain"
ea57f3d Quentin Bourgerie [fix] mongo: (big) Fixes on mongo behind dbgen, default values, parser e...
BourgerieQuentin authored
93 | Partial (b, p0, p1) -> Format.fprintf fmt "partial (%b, %a, %a)" b pp_path p0 pp_path p1
2b94068 Quentin Bourgerie [enhance] compiler/lib: (big) default value on bson unserialize + fix up...
BourgerieQuentin authored
94 | Compose cmp ->
95 Format.fprintf fmt "compose(%a)"
96 (Format.pp_list "; " (fun fmt (f, p) -> Format.fprintf fmt "%s:[%a]" f pp_path p)) cmp
fb519cd Quentin Bourgerie [enhance] compiler, database: Added sub path of multi node
BourgerieQuentin authored
97 | SetAccess (sk, path, query, epath) ->
bb536aa Quentin Bourgerie [feature] compiler, database, mongo: Added path selection on composed pa...
BourgerieQuentin authored
98 Format.fprintf fmt "@[<hov>access to %a : %a @. with : %a @. embedded path : %a@]"
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
99 pp_path path
c197c0f Quentin Bourgerie [enhance] compiler: (big) Added more update and query node + added typin...
BourgerieQuentin authored
100 pp_set_kind sk
df80d98 Quentin Bourgerie [feature] compiler, database: Just naive update of libqmlcompil (for pat...
BourgerieQuentin authored
101 pp_query query
fb519cd Quentin Bourgerie [enhance] compiler, database: Added sub path of multi node
BourgerieQuentin authored
102 (Option.pp (DbAst.pp_path_elts QmlPrint.pp#expr)) epath
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
103
104 let pp_node fmt node =
fb519cd Quentin Bourgerie [enhance] compiler, database: Added sub path of multi node
BourgerieQuentin authored
105 Format.fprintf fmt "{@[<hov>type : %a; @. kind : %a; ...@]}"
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
106 QmlPrint.pp#ty node.ty
107 pp_kind node.kind
108
fccc685 Initial open-source release
MLstate authored
109 let mapi = Sch.mapi
110 let initial = Sch.initial
111 let is_empty = Sch.is_empty_or_unused
112 let register_path = Sch.register_path
113 let register_default = Sch.register_default
114 let register_db_declaration = Sch.register_db_declaration
115 let register_new_db_value = Sch.register_new_db_value
116 (* let get_type_of_path = get_type_of_path *)
117 (* let preprocess_path = preprocess_path *)
118 let preprocess_paths_expr = Sch.preprocess_paths_expr
119 let preprocess_paths_code_elt = Sch.preprocess_paths_code_elt
120 let preprocess_paths_ast = Sch.preprocess_paths_ast
121 let finalize = Sch.finalize
122 let of_package = Sch.of_package
123 let merge = Sch.merge
124 let map_types = Sch.map_types
125 let map_expr = Sch.map_expr
126 let fold_expr = Sch.fold_expr
127 let foldmap_expr = Sch.foldmap_expr
128 let from_gml s =
129 StringListMap.singleton []
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
130 ({ Sch.ident = Ident.next "dummy_from_gml";
4b041c8 Quentin Bourgerie [fix] compiler, database: Adding all database ident to gamma, even if no...
BourgerieQuentin authored
131 Sch.ty = C.Db.t ();
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
132 Sch.context = QmlError.Context.pos (FilePos.nopos "built from gml");
fccc685 Initial open-source release
MLstate authored
133 Sch.path_aliases = [];
121d046 Quentin Bourgerie [enhance] compiler, database: Just change type of database options
BourgerieQuentin authored
134 Sch.options = {DbAst.backend = `db3};
fccc685 Initial open-source release
MLstate authored
135 Sch.schema = Schema_io.from_gml_string s;
1b343b3 Quentin Bourgerie [fix] compiler, database: export database ident into gamma only for data...
BourgerieQuentin authored
136 Sch.package = "dummy_from_gml";
fccc685 Initial open-source release
MLstate authored
137 Sch.virtual_path = Sch.PathMap.empty;
138 })
139 let to_dot t chan =
140 StringListMap.iter
c197c0f Quentin Bourgerie [enhance] compiler: (big) Added more update and query node + added typin...
BourgerieQuentin authored
141 (fun _key db_def ->
142 (* output_string chan (String.concat "/" key); *)
143 (* output_char chan '\n'; *)
fccc685 Initial open-source release
MLstate authored
144 Schema_io.to_dot db_def.Sch.schema chan)
145 t
146
147 let find_db_def t db_ident_opt =
148 if StringListMap.size t = 1 && db_ident_opt = None
149 then StringListMap.min t
150 else
151 StringListMap.min (* may raise Not_found *)
152 (StringListMap.filter_val
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
153 (fun db_def -> db_ident_opt = Some (Ident.original_name db_def.Sch.ident))
fccc685 Initial open-source release
MLstate authored
154 t)
155 let db_to_dot t db_ident_opt chan =
156 let _, db_def = find_db_def t db_ident_opt in
157 Schema_io.to_dot db_def.Sch.schema chan
158 let db_to_gml t db_ident_opt chan =
159 let _, db_def = find_db_def t db_ident_opt in
160 Schema_io.to_gml db_def.Sch.schema chan
161
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
162 let db_declaration = Sch.db_declaration
163
4b041c8 Quentin Bourgerie [fix] compiler, database: Adding all database ident to gamma, even if no...
BourgerieQuentin authored
164 let decl_to_db name decl =
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
165 {
166 name;
4b041c8 Quentin Bourgerie [fix] compiler, database: Adding all database ident to gamma, even if no...
BourgerieQuentin authored
167 ident = decl.Sch.ident;
168 dbty = decl.Sch.ty;
169 options = decl.Sch.options;
1b343b3 Quentin Bourgerie [fix] compiler, database: export database ident into gamma only for data...
BourgerieQuentin authored
170 package = decl.Sch.package;
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
171 }
172
4b041c8 Quentin Bourgerie [fix] compiler, database: Adding all database ident to gamma, even if no...
BourgerieQuentin authored
173 let get_db_declaration schema =
174 let decls = Sch.get_db_declaration schema in
175 List.map (fun (decl, name) -> decl_to_db name decl) decls
176
177 let get_database schema name =
178 let declaration = db_declaration schema name in
179 decl_to_db name declaration
180
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
181 exception Vertex of Graph.vertex
182
183 let get_root schema = try
184 Graph.iter_vertex (fun v -> if SchemaGraphLib.is_root v then (raise (Vertex v))) schema;
185 OManager.i_error "Don't find the root node on database schema";
186 with Vertex v -> v
187
188
189 (** Get the next node on given [schema] according to the path
190 [fragment]. *)
191 let rec next schema node fragment =
192 let can_succ e =
193 match (fragment, e.C.label) with
194 | (DbAst.FldKey s0, C.Field (s1, _)) when s0 = s1 -> true
195 | (DbAst.FldKey _s0, _) -> false
196 | (DbAst.ExprKey _, C.Multi_edge _) -> true
c197c0f Quentin Bourgerie [enhance] compiler: (big) Added more update and query node + added typin...
BourgerieQuentin authored
197 | (DbAst.Query _, C.Multi_edge _) -> true
5fdc6b9 Quentin Bourgerie [enhance] compiler: (big) Common path typing beetween several backend + ...
BourgerieQuentin authored
198 | (DbAst.NewKey, _) -> true
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
199 | _ -> assert false (* TODO *)
200 in
201 let v = match (Graph.V.label node).C.nlabel with
202 | C.Sum ->
203 Graph.fold_succ
204 (fun node acc -> try
205 let e = next schema node fragment in
206 match acc with
207 | None -> Some e
208 | Some _ -> assert false
209 with Not_found -> acc)
210 schema node None
211 | _ ->
212 let edge = Graph.fold_succ_e
213 (fun edge ->
214 let (_, e, _) = edge in
215 function
216 | None when can_succ e -> Some edge
217 | Some _ when can_succ e -> assert false
218 | x -> x
219 ) schema node None
220 in Option.map Graph.E.dst edge
221 in
222 match v with
223 | None -> raise Not_found
ea57f3d Quentin Bourgerie [fix] mongo: (big) Fixes on mongo behind dbgen, default values, parser e...
BourgerieQuentin authored
224 | Some v ->
225 match (Graph.V.label v).C.nlabel with
226 | C.Hidden -> SchemaGraphLib.SchemaGraph.unique_next schema v
227 | _ -> v
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
228
ea57f3d Quentin Bourgerie [fix] mongo: (big) Fixes on mongo behind dbgen, default values, parser e...
BourgerieQuentin authored
229 let is_sum node =
230 match (Graph.V.label node).C.nlabel with
231 | C.Sum -> true
232 | _ -> false
2b94068 Quentin Bourgerie [enhance] compiler/lib: (big) default value on bson unserialize + fix up...
BourgerieQuentin authored
233
234 let get_node (schema:t) path =
709cad4 Quentin Bourgerie [fix] compiler, database: compose and partial path
BourgerieQuentin authored
235 #<If>
236 Format.eprintf "Get node : @[with path %a@]@\n" QmlPrint.pp#path_elts path;
237 #<End>;
2b94068 Quentin Bourgerie [enhance] compiler/lib: (big) default value on bson unserialize + fix up...
BourgerieQuentin authored
238 let dbname, declaration, path =
239 try
240 let dbname, path= match path with
241 | DbAst.FldKey k::path -> k, path
242 | _ -> assert false (* TODO *)
243 in
244 dbname, db_declaration schema dbname, path
245 with Not_found ->
246 "_no_name", db_declaration schema "_no_name", path
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
247 in
248 let database = get_database schema dbname in
c197c0f Quentin Bourgerie [enhance] compiler: (big) Added more update and query node + added typin...
BourgerieQuentin authored
249 let llschema = declaration.Sch.schema in
fb519cd Quentin Bourgerie [enhance] compiler, database: Added sub path of multi node
BourgerieQuentin authored
250 let find_next_step (node, kind, path) fragment =
c197c0f Quentin Bourgerie [enhance] compiler: (big) Added more update and query node + added typin...
BourgerieQuentin authored
251 let next = next llschema node fragment in
252 let get_setkind schema node =
253 match Graph.succ_e schema node with
2b94068 Quentin Bourgerie [enhance] compiler/lib: (big) default value on bson unserialize + fix up...
BourgerieQuentin authored
254 | [edge] ->
255 let next = Graph.E.dst edge in
256 begin match (Graph.E.label edge).C.label with
257 | C.Multi_edge C.Kint ->
258 Map (QmlAst.TypeConst QmlAst.TyInt, next.C.ty)
259 | C.Multi_edge C.Kstring ->
260 Map (QmlAst.TypeConst QmlAst.TyString, next.C.ty)
261 | C.Multi_edge (C.Kfields _) -> DbSet next.C.ty
262 | _ -> assert false
263 end
32e38cc Quentin Bourgerie [enhance] compiler, dbgen, mongo: enhance error message on feature which...
BourgerieQuentin authored
264 | [] -> OManager.i_error "Found any successors from a multi node"
265 | _ -> OManager.i_error "Found multiple successors from a multi node"
c197c0f Quentin Bourgerie [enhance] compiler: (big) Added more update and query node + added typin...
BourgerieQuentin authored
266 in
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
267 match fragment with
268 | DbAst.ExprKey expr ->
c197c0f Quentin Bourgerie [enhance] compiler: (big) Added more update and query node + added typin...
BourgerieQuentin authored
269 let setkind = get_setkind llschema node in
53b5fad Quentin Bourgerie [enhance] compiler, database: Added query options
BourgerieQuentin authored
270 let options = {DbAst.limit = None; skip = None; sort = None} in
fb519cd Quentin Bourgerie [enhance] compiler, database: Added sub path of multi node
BourgerieQuentin authored
271 let kind = SetAccess (setkind, path, Some (true, (DbAst.QEq expr, options)), None) in
6ada700 Quentin Bourgerie [enhance] compiler: added query ast + add node to update ast
BourgerieQuentin authored
272 (next, kind, path)
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
273
274 | DbAst.FldKey key ->
275 let kind =
276 let nlabel = Graph.V.label next in
277 match nlabel.C.nlabel with
fb519cd Quentin Bourgerie [enhance] compiler, database: Added sub path of multi node
BourgerieQuentin authored
278 | C.Multi -> SetAccess (get_setkind llschema next, key::path, None, None)
ea57f3d Quentin Bourgerie [fix] mongo: (big) Fixes on mongo behind dbgen, default values, parser e...
BourgerieQuentin authored
279 | _ ->
280 match kind, nlabel.C.plain with
281 | Compose _, true -> Plain
32e38cc Quentin Bourgerie [enhance] compiler, dbgen, mongo: enhance error message on feature which...
BourgerieQuentin authored
282 | Compose c, false -> Compose c
ea57f3d Quentin Bourgerie [fix] mongo: (big) Fixes on mongo behind dbgen, default values, parser e...
BourgerieQuentin authored
283 | Partial (sum, path, part), _ ->
284 Partial (sum && is_sum node, path, key::part)
285 | Plain, _ -> Partial (is_sum node, path, key::[])
32e38cc Quentin Bourgerie [enhance] compiler, dbgen, mongo: enhance error message on feature which...
BourgerieQuentin authored
286 | SetAccess _, _ -> raise (Base.NotImplemented "Selection inside a multi node")
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
287 in let path = key::path
288 in (next, kind, path)
53b5fad Quentin Bourgerie [enhance] compiler, database: Added query options
BourgerieQuentin authored
289 | DbAst.Query (query, options) ->
c197c0f Quentin Bourgerie [enhance] compiler: (big) Added more update and query node + added typin...
BourgerieQuentin authored
290 begin match kind with
fb519cd Quentin Bourgerie [enhance] compiler, database: Added sub path of multi node
BourgerieQuentin authored
291 | SetAccess (_k, path, None, _) ->
292 let uniq = Sch.is_uniq llschema node query in
93492b8 Quentin Bourgerie [fix] compiler, database: fixes about queries which returns uniq resultq...
BourgerieQuentin authored
293 let kind = SetAccess (get_setkind llschema node, path,
fb519cd Quentin Bourgerie [enhance] compiler, database: Added sub path of multi node
BourgerieQuentin authored
294 Some (uniq, (query, options)), None) in
c197c0f Quentin Bourgerie [enhance] compiler: (big) Added more update and query node + added typin...
BourgerieQuentin authored
295 (next, kind, path)
fb519cd Quentin Bourgerie [enhance] compiler, database: Added sub path of multi node
BourgerieQuentin authored
296 | SetAccess (_, _path, Some _, _) ->
32e38cc Quentin Bourgerie [enhance] compiler, dbgen, mongo: enhance error message on feature which...
BourgerieQuentin authored
297 raise (Base.NotImplemented "Selection inside a multi node")
298 | _ ->
299 raise (Base.NotImplemented "Query in a non multi node")
c197c0f Quentin Bourgerie [enhance] compiler: (big) Added more update and query node + added typin...
BourgerieQuentin authored
300 end
32e38cc Quentin Bourgerie [enhance] compiler, dbgen, mongo: enhance error message on feature which...
BourgerieQuentin authored
301 | DbAst.NewKey -> raise (Base.NotImplemented "New key")
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
302 in
fb519cd Quentin Bourgerie [enhance] compiler, database: Added sub path of multi node
BourgerieQuentin authored
303 let node, kind =
304 let rec find path ((node, kind, _) as x) =
305 match (path, kind) with
306 | [], _ -> node, kind
307 | _::_, SetAccess (k, p, (Some _ as q), None) -> node, SetAccess(k, p, q, Some path)
308 | t::q, _ -> find q (find_next_step x t)
1aa37e7 Quentin Bourgerie [feature] compiler, database: Default values generator take care of sele...
BourgerieQuentin authored
309 in find path (get_root llschema, Compose [], [])
fb519cd Quentin Bourgerie [enhance] compiler, database: Added sub path of multi node
BourgerieQuentin authored
310 in
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
311 let kind =
312 match kind with
313 | Compose _ -> (
314 match (Graph.V.label node).C.nlabel with
315 | C.Product ->
316 let path = List.map
317 (function
318 | DbAst.FldKey k -> k
319 | _ -> assert false) path in
320 Compose (List.map
321 (fun edge ->
322 let sname = SchemaGraphLib.fieldname_of_edge edge
2b94068 Quentin Bourgerie [enhance] compiler/lib: (big) default value on bson unserialize + fix up...
BourgerieQuentin authored
323 in sname, path @ [sname])
c197c0f Quentin Bourgerie [enhance] compiler: (big) Added more update and query node + added typin...
BourgerieQuentin authored
324 (Graph.succ_e llschema node)
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
325 )
326 | _ -> assert false
327 )
ea57f3d Quentin Bourgerie [fix] mongo: (big) Fixes on mongo behind dbgen, default values, parser e...
BourgerieQuentin authored
328 | Partial (sum, path, part) ->
329 Partial (sum, List.rev path, List.rev part)
fb519cd Quentin Bourgerie [enhance] compiler, database: Added sub path of multi node
BourgerieQuentin authored
330 | SetAccess (k, path, query, epath) ->
331 SetAccess (k, List.rev path, query, epath)
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
332 | Plain -> Plain
333 in
fa8caff Quentin Bourgerie [fix] compiler, database, mongo: Set without queries was broken, Credit:...
BourgerieQuentin authored
334 let default =
335 let node =
336 match kind with
fb519cd Quentin Bourgerie [enhance] compiler, database: Added sub path of multi node
BourgerieQuentin authored
337 | SetAccess (_, _, None, _) -> SchemaGraphLib.SchemaGraph.unique_next llschema node
fa8caff Quentin Bourgerie [fix] compiler, database, mongo: Set without queries was broken, Credit:...
BourgerieQuentin authored
338 | _ -> node
339 in
1aa37e7 Quentin Bourgerie [feature] compiler, database: Default values generator take care of sele...
BourgerieQuentin authored
340 fun ?select annotmap ->
2b94068 Quentin Bourgerie [enhance] compiler/lib: (big) default value on bson unserialize + fix up...
BourgerieQuentin authored
341 let (annotmap2, expr) =
342 DbGen_private.Default.expr
1aa37e7 Quentin Bourgerie [feature] compiler, database: Default values generator take care of sele...
BourgerieQuentin authored
343 ?select
2b94068 Quentin Bourgerie [enhance] compiler/lib: (big) default value on bson unserialize + fix up...
BourgerieQuentin authored
344 annotmap
345 llschema
346 node
347 in
348 QmlAnnotMap.merge annotmap annotmap2, expr
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
349 in
2b94068 Quentin Bourgerie [enhance] compiler/lib: (big) default value on bson unserialize + fix up...
BourgerieQuentin authored
350 let r = {
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
351 database; kind; default;
352 ty = node.DbGen_common.ty;
2b94068 Quentin Bourgerie [enhance] compiler/lib: (big) default value on bson unserialize + fix up...
BourgerieQuentin authored
353 } in
709cad4 Quentin Bourgerie [fix] compiler, database: compose and partial path
BourgerieQuentin authored
354 #<If>
355 Format.eprintf "@[Got : %a@]@\n" pp_node r;
356 #<End>;
2b94068 Quentin Bourgerie [enhance] compiler/lib: (big) default value on bson unserialize + fix up...
BourgerieQuentin authored
357 r
358
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
359
fccc685 Initial open-source release
MLstate authored
360 module HacksForPositions = Sch.HacksForPositions
361 end
362
1aa37e7 Quentin Bourgerie [feature] compiler, database: Default values generator take care of sele...
BourgerieQuentin authored
363 module Utils = struct
364
365 let rec type_of_selected gamma ty select =
366 let res = match select with
367 | DbAst.SNil | DbAst.SStar | DbAst.SSlice _ -> ty
ecce968 Quentin Bourgerie [feature] compiler, database: Added typing of id update/select
BourgerieQuentin authored
368 | DbAst.SId (_id, s) ->
369 begin match QmlTypesUtils.Inspect.follow_alias_noopt_private ~until:"ordered_map" gamma ty with
370 | QmlAst.TypeName ([_; dty; _], _) -> type_of_selected gamma dty s
371 | ty2 -> OManager.i_error "Try to select an id on %a %a" QmlPrint.pp#ty ty QmlPrint.pp#ty ty2
372 end
373
1aa37e7 Quentin Bourgerie [feature] compiler, database: Default values generator take care of sele...
BourgerieQuentin authored
374 | DbAst.SFlds sflds ->
40c9b40 Quentin Bourgerie [fix] compiler, database: Don't follow allias if it's not needed by the ...
BourgerieQuentin authored
375 let ty = QmlTypesUtils.Inspect.follow_alias_noopt_private gamma ty in
1aa37e7 Quentin Bourgerie [feature] compiler, database: Default values generator take care of sele...
BourgerieQuentin authored
376 match ty with
377 | QmlAst.TypeRecord (QmlAst.TyRow (rflds, rv)) ->
378 QmlAst.TypeRecord
379 (QmlAst.TyRow
380 ((List.filter_map
381 (fun (rfld, ty) ->
382 match List.find_map
383 (fun (sfld, s) -> if sfld = [rfld] then Some s else None)
384 sflds
385 with | None -> None
386 | Some s -> Some (rfld, type_of_selected gamma ty s)
387 )
388 rflds)
389 , rv)
390 )
391 | ty -> OManager.i_error "Try to select fields on %a" QmlPrint.pp#ty ty
392 in
393 #<If>
394 Format.eprintf "@[Type selection : %a.%a => %a@]@\n"
395 QmlPrint.pp#ty ty
396 (QmlAst.Db.pp_select (fun _ _ -> ())) select
397 QmlPrint.pp#ty res;
398 #<End>;
399 res
400
401
402 end
403
fccc685 Initial open-source release
MLstate authored
404 module type S = sig include DbGenByPass.S end
405
406 type dbinfo = DbGen_private.dbinfo
407
408 let merge_dbinfo = DbGen_private.merge_dbinfo
409
410 module DbGen ( Arg : DbGenByPass.S ) = struct
411
412 module Access = DbGen_private.DatabaseAccess (Arg)
413 let initialize = Access.initialize
28521d4 Quentin Bourgerie [enhance] compiler: (big) Added Update Ast, Added plain node, Added more...
BourgerieQuentin authored
414
fccc685 Initial open-source release
MLstate authored
415 let replace_path_exprs = Access.replace_path_exprs
416 let replace_path_code_elt = Access.replace_path_code_elt
417 let replace_path_ast = Access.replace_path_ast
418 end
419
420 module DbGenByPass = DbGenByPass
421
422 let warning_set =
423 WarningClass.Set.create_from_list [
424 WarningClass.dbgen;
425 WarningClass.dbgen_schema;
426 ]
Something went wrong with that request. Please try again.