[enhance] compiler, database: Added sub path of multi node

libqmlcompil/dbGen/dbGen_private.ml

@@ -1916,14 +1916,10 @@ module CodeGenerator ( Arg : DbGenByPass.S ) = struct
       let r = match virtual_ with
         | `virtualset (_, wty, false, _) ->
             make_virtualset_fullpath  ~context db_def.Schema_private.schema dbinfo gamma node path kind wty
-        | `virtualset (_, wty, true, record) ->
-            begin match record with
-            | Some record -> make_virtualset_partialpath
-                db_def.Schema_private.schema dbinfo gamma node path kind wty record
-            | None ->
-                match kind with
-                | Db.Ref -> make_ref_path db_def.Schema_private.schema dbinfo gamma node path
-                | _ -> get_path_expr db_def.Schema_private.schema dbinfo gamma node path kind
+        | `virtualset (_, _wty, true, _) ->
+            begin match kind with
+            | Db.Ref -> make_ref_path db_def.Schema_private.schema dbinfo gamma node path
+            | _ -> get_path_expr db_def.Schema_private.schema dbinfo gamma node path kind
             end
         | `virtualpath (ident, rty, wty) ->
             make_virtualpath db_def.Schema_private.schema dbinfo gamma node path kind ident rty wty

libqmlcompil/dbGen/schema_private.ml

@@ -1022,7 +1022,7 @@ let rec convert_dbpath ~context t gamma node kind select path0 path =
         let new_annots, epath = convert_dbpath ~context t gamma (SchemaGraph.unique_next t node) kind select path0 path in
         new_annots, Db.NewKey :: epath
 
-    | Db.Query (query, options)::[] ->
+    | Db.Query (query, options)::path ->
         let new_annots, (query, options) =
           let ty =
             match SchemaGraphLib.type_of_node node with
@@ -1035,9 +1035,8 @@ let rec convert_dbpath ~context t gamma node kind select path0 path =
           in
           coerce_query_element ~context gamma ty (query, options)
         in
-        new_annots, [Db.Query (query, options)]
-
-    | Db.Query _::_path -> QmlError.error context "sub path after query is not handler yet"
+        let new_annots', epath = convert_dbpath ~context t gamma (SchemaGraph.unique_next t node) kind select path0 path in
+        new_annots @ new_annots', (Db.Query (query, options))::epath
 
 let get_virtual_path vpath epath =
   let rec aux acc = function
@@ -1079,7 +1078,7 @@ let rec find_exprpath_aux ?context t ?(node=SchemaGraphLib.get_root t) ?(kind=Db
       match node.C.ty with
       | Q.TypeName ([setparam;_], name) when Q.TypeIdent.to_string name = "dbset" ->
           let ty = C.Db.set setparam in
-          ty, node, `virtualset (setparam, ty, true, None)
+          ty, node, `virtualset (setparam, ty, true, (fun t -> C.Db.set t))
       | ty -> ty, node, `realpath
     )
   | [],_ -> node.C.ty, node, `realpath
@@ -1095,23 +1094,23 @@ let rec find_exprpath_aux ?context t ?(node=SchemaGraphLib.get_root t) ?(kind=Db
       find_exprpath_aux ~context t ~node:next ~kind ~epath0 vpath epath
   | (Db.Query (query, _))::epath, C.Multi ->
       let setty = node.C.ty in
-      (match epath with
-       | [] -> ()
-       | _ -> QmlError.error context "Path after queries is not yet allowed");
+      let dataty, dnode, _ = 
+        find_exprpath_aux ~context t ~node:(SchemaGraph.unique_next t node) 
+          ~kind ~epath0 vpath epath
+      in
       (match setty with
-       | Q.TypeName ([setparam; _], name) when Q.TypeIdent.to_string name = "dbset" ->
-           let setty = C.Db.set setparam in
-           let node, partial, tyread = node, not (is_uniq t node query), setty in
-           setty, node, `virtualset (setparam, tyread, partial, None)
+       | Q.TypeName ([_setparam; _], name) when Q.TypeIdent.to_string name = "dbset" ->
+           let setty = C.Db.set dataty in
+           let partial = not (is_uniq t node query) in
+           setty, dnode, `virtualset (dataty, dataty, partial, (fun t -> C.Db.set t))
        | _ ->
            let keyty = SchemaGraphLib.type_of_key t node in
            let partial = not (is_uniq t node query) in
-           let valty, node, _x =
-             find_exprpath_aux ~context t ~node:(SchemaGraph.unique_next t node)
-               ~kind ~epath0 vpath []
-           in Q.TypeName ([keyty; valty], Q.TypeIdent.of_string Opacapi.Types.map), node,
-           `virtualset (valty, valty, partial, None)
-      )
+           let rebuildt dataty = 
+             Q.TypeName ([keyty; dataty], Q.TypeIdent.of_string Opacapi.Types.map)
+           in
+           rebuildt dataty, node, `virtualset (dataty, dataty, partial, rebuildt)
+      ) 
 
   | (Db.ExprKey _e)::epath, C.Multi ->
       find_exprpath_aux ~context t ~node:(SchemaGraph.unique_next t node) ~kind ~epath0 vpath epath

libqmlcompil/qmlAst.ml

@@ -322,8 +322,11 @@ struct
     | NewKey -> pp f "[?]"
     | Query (q, o) -> pp f "[%a%a]" (pp_query pp_expr) q (pp_options pp_expr) o
 
+  let pp_path_elts pp_expr fmt elts =
+      pp fmt "%a" (BaseFormat.pp_list "" (pp_path_elt pp_expr)) elts
+
   let pp_path pp_expr f (el, knd, select) =
-    let pp_el fmt () = pp fmt "%a" (BaseFormat.pp_list "" (pp_path_elt pp_expr)) el in
+    let pp_el fmt () = pp_path_elts pp_expr fmt el in
     match knd with
     | Update u -> pp f "%a.%a <- %a" pp_el () (pp_select pp_expr) select (pp_update pp_expr) u
     | _ ->

libqmlcompil/qmlDbGen.ml

@@ -60,7 +60,7 @@ module Schema = struct
     | Compose of (string * string list) list
     | Plain
     | Partial of bool (* Inside sum*) * string list * string list
-    | SetAccess of set_kind * string list * (bool (*is_unique*) * query) option
+    | SetAccess of set_kind * string list * (bool (*is_unique*) * query) option * QmlAst.path option
 
   type node = {
     ty : QmlAst.ty;
@@ -92,14 +92,15 @@ module Schema = struct
     | Compose cmp ->
         Format.fprintf fmt "compose(%a)"
           (Format.pp_list "; " (fun fmt (f, p) -> Format.fprintf fmt "%s:[%a]" f pp_path p)) cmp
-    | SetAccess (sk, path, query) ->
-        Format.fprintf fmt "@[<hov>access to %a : %a with %a@]"
+    | SetAccess (sk, path, query, epath) ->
+        Format.fprintf fmt "@[<hov>access to %a : %a @. with %a @. embedded path : %a@]"
           pp_path path
           pp_set_kind sk
           pp_query query
+          (Option.pp (DbAst.pp_path_elts QmlPrint.pp#expr)) epath
 
   let pp_node fmt node =
-    Format.fprintf fmt "{@[<hov>type : %a; kind : %a; ...@]}"
+    Format.fprintf fmt "{@[<hov>type : %a; @. kind : %a; ...@]}"
       QmlPrint.pp#ty node.ty
       pp_kind node.kind
 
@@ -244,7 +245,7 @@ module Schema = struct
     in
     let database = get_database schema dbname in
     let llschema = declaration.Sch.schema in
-    let f (node, kind, path) fragment =
+    let find_next_step (node, kind, path) fragment =
       let next = next llschema node fragment in
       let get_setkind schema node =
         match Graph.succ_e schema node with
@@ -265,14 +266,14 @@ module Schema = struct
       | DbAst.ExprKey expr ->
           let setkind = get_setkind llschema node in
           let options = {DbAst.limit = None; skip = None; sort = None} in
-          let kind = SetAccess (setkind, path, Some (true, (DbAst.QEq expr, options))) in
+          let kind = SetAccess (setkind, path, Some (true, (DbAst.QEq expr, options)), None) in
           (next, kind, path)
 
       | DbAst.FldKey key ->
           let kind =
             let nlabel = Graph.V.label next in
             match nlabel.C.nlabel with
-            | C.Multi -> SetAccess (get_setkind llschema next, key::path, None)
+            | C.Multi -> SetAccess (get_setkind llschema next, key::path, None, None)
             | _ ->
                 match kind, nlabel.C.plain with
                 | Compose _, true -> Plain
@@ -285,20 +286,26 @@ module Schema = struct
           in (next, kind, path)
       | DbAst.Query (query, options) ->
           begin match kind with
-          | SetAccess (_k, path, None) ->
-              let partial = Sch.is_uniq llschema node query in
+          | SetAccess (_k, path, None, _) ->
+              let uniq = Sch.is_uniq llschema node query in
               let kind = SetAccess (get_setkind llschema node, path,
-                                    Some (partial, (query, options))) in
+                                    Some (uniq, (query, options)), None) in
               (next, kind, path)
-          | SetAccess (_, _path, Some _) ->
+          | SetAccess (_, _path, Some _, _) ->
               raise (Base.NotImplemented "Selection inside a multi node")
           | _ ->
               raise (Base.NotImplemented "Query in a non multi node")
           end
       | DbAst.NewKey -> raise (Base.NotImplemented "New key")
     in
-    let (node, kind, _path) =
-      List.fold_left f (get_root llschema, Compose [], []) path in
+    let node, kind =
+      let rec find path ((node, kind, _) as x) =
+        match (path, kind) with
+        | [], _ -> node, kind
+        | _::_, SetAccess (k, p, (Some _ as q), None) -> node, SetAccess(k, p, q, Some path)
+        | t::q, _ -> find q (find_next_step x t)
+      in find path (get_root llschema, Compose [], []) 
+    in
     let kind =
       match kind with
       | Compose _ -> (
@@ -318,14 +325,14 @@ module Schema = struct
         )
       | Partial (sum, path, part) ->
           Partial (sum, List.rev path, List.rev part)
-      | SetAccess (k, path, query) ->
-          SetAccess (k, List.rev path, query)
+      | SetAccess (k, path, query, epath) ->
+          SetAccess (k, List.rev path, query, epath)
       | Plain -> Plain
     in
     let default =
       let node =
         match kind with
-        | SetAccess (_, _, None) -> SchemaGraphLib.SchemaGraph.unique_next llschema node
+        | SetAccess (_, _, None, _) -> SchemaGraphLib.SchemaGraph.unique_next llschema node
         | _ -> node
       in
       fun annotmap ->

libqmlcompil/qmlDbGen.mli

@@ -68,7 +68,7 @@ module Schema: sig
     | Compose of (string * string list) list
     | Plain
     | Partial of bool * string list * string list
-    | SetAccess of set_kind * string list * (bool * query) option (*bool == unique*)
+    | SetAccess of set_kind * string list * (bool * query) option (*bool == unique*) * QmlAst.path option
 
   type node = {
     ty : QmlAst.ty;