[enhance] compiler, database: Added query options

libqmlcompil/dbGen/schema_private.ml

@@ -827,12 +827,45 @@ let rec dots gamma field ty =
                       | Some msg -> Format.fprintf fmt "\n@{<bright>Hint@} : %s" msg) ())
                 )
 
-let coerce_query_element ~context gamma ty query =
-  let rec aux new_annots ty query =
-    let coerce wrap ty expr =
-      let e = QmlAstCons.UntypedExpr.coerce expr ty in
-      Q.QAnnot.expr e::new_annots, wrap e
+let coerce_query_element ~context gamma ty (query, options) =
+  let coerce new_annots wrap ty expr =
+    let e = QmlAstCons.UntypedExpr.coerce expr ty in
+    Q.QAnnot.expr e::new_annots, wrap e
+  in
+  let a, options =
+    let a = [] in
+    let optmap f a o = match o with
+    | None -> a, None
+    | Some o -> let x, y = f a o in x, Some y in
+    let a, limit =
+      optmap
+        (fun a -> coerce a (fun x -> x) (Q.TypeConst Q.TyInt))
+        a options.Db.limit
+    in let a, skip =
+      optmap
+        (fun a -> coerce a (fun x -> x) (Q.TypeConst Q.TyInt))
+        a options.Db.skip
+    in let a, sort =
+      let ty =
+        Q.TypeRecord (
+          let void = Q.TypeRecord (QmlAstCons.Type.Row.make []) in
+          QmlAstCons.Type.Row.make [
+            ("up", void);
+            ("down", void);
+          ]
+        )
+      in
+      optmap
+        (fun a fields ->
+           List.fold_left_map
+             (fun a (flds, e) -> coerce a (fun e -> (flds, e)) ty e)
+             a fields
+        ) a options.Db.sort
     in
+    (a, {Db.limit; skip; sort})
+  in
+  let rec aux new_annots ty query =
+    let coerce = coerce new_annots in
     let aux2 wrap ty (q1, q2) =
       let new_annots, q1 = aux new_annots ty q1 in
       let new_annots, q2 = aux new_annots ty q2 in
@@ -867,7 +900,8 @@ let coerce_query_element ~context gamma ty query =
         with Formatted p ->
           QmlError.error context "This querying is invalid because %a\n%!" p ()
 
-  in aux [] ty query
+  in let a, query = aux a ty query in
+  a, (query, options)
 
 (** @return (new_annots_list, pppath) *)
 let rec convert_dbpath ~context t gamma node kind path0 path =
@@ -952,16 +986,16 @@ let rec convert_dbpath ~context t gamma node kind path0 path =
         let new_annots, epath = convert_dbpath ~context t gamma (SchemaGraph.unique_next t node) kind path0 path in
         new_annots, Db.NewKey :: epath
 
-    | Db.Query query::[] ->
-        let new_annots, query =
+    | Db.Query (query, options)::[] ->
+        let new_annots, (query, options) =
           let ty =
             match SchemaGraphLib.type_of_node node with
             | Q.TypeName ([setparam], name) when Q.TypeIdent.to_string name = "dbset" -> setparam
             | _ ->  SchemaGraphLib.type_of_key t node
           in
-          coerce_query_element ~context gamma ty query
+          coerce_query_element ~context gamma ty (query, options)
         in
-        new_annots, [Db.Query query]
+        new_annots, [Db.Query (query, options)]
 
     | Db.Query _::_path -> QmlError.error context "sub path after query is not handler yet"
 
@@ -1018,7 +1052,7 @@ let rec find_exprpath_aux ?context t ?(node=SchemaGraphLib.get_root t) ?(kind=Db
             QmlPrint.pp#path_elts epath0
       in
       find_exprpath_aux ~context t ~node:next ~kind ~epath0 vpath epath
-  | (Db.Query _q)::epath, C.Multi ->
+  | (Db.Query (_, _))::epath, C.Multi ->
       let setty = node.C.ty in
       (match setty with
        | Q.TypeName ([setparam], name)

libqmlcompil/qmlAst.ml

@@ -144,6 +144,12 @@ struct
     | QNot  of 'expr query
     | QFlds of 'expr query fields
 
+  type 'expr query_options = {
+    limit : 'expr option;
+    skip  : 'expr option;
+    sort  : 'expr fields option;
+  }
+
   type 'expr update =
     (* Record updating*)
     | UFlds of 'expr update fields
@@ -192,7 +198,7 @@ struct
     | FldKey of string
     | ExprKey of 'expr
     | NewKey
-    | Query of 'expr query
+    | Query of 'expr query * 'expr query_options
 
   type 'expr path = 'expr path_elt list
 
@@ -406,11 +412,28 @@ struct
           (fun fields -> QFlds fields)
           (TU.sub_list (TU.sub_2 TU.sub_ignore (sub_db_query sub_e sub_ty)) flds)
 
+  let sub_db_query_options sub_e _sub_ty opt =
+    let (sub_fields: ('a fields, _, _, 'b fields) TU.sub) = fun flds ->
+      TU.wrap
+        (fun fields -> fields)
+        (TU.sub_list (TU.sub_2 TU.sub_ignore sub_e) flds)
+    in
+    TU.wrap
+      (fun (limit, skip, sort) -> {limit; skip; sort})
+      (TU.sub_3 (TU.sub_option sub_e) (TU.sub_option sub_e) (TU.sub_option sub_fields)
+         (opt.limit, opt.skip, (opt.sort : 'expr fields option))
+      )
+
   let sub_path_elt sub_e sub_ty = function
     | FldKey _
     | NewKey as v -> TU.sub_ignore v
     | ExprKey e -> TU.wrap (fun x -> ExprKey x) (sub_e e)
-    | Query query -> TU.wrap (fun q -> Query q) (sub_db_query sub_e sub_ty query)
+    | Query (q, o) ->
+        TU.wrap
+          (fun (q, o) -> Query (q, o))
+          (TU.sub_2 (sub_db_query sub_e sub_ty) (sub_db_query_options sub_e sub_ty)
+             (q, o)
+          )
 
   let foldmap_expr f acc dbdef =
     let cons, subs = sub_db_def TU.sub_current TU.sub_ignore dbdef in

libqmlcompil/qmlDbGen.ml

@@ -44,7 +44,7 @@ module Schema = struct
     package : ObjectFiles.package_name;
   }
 
-  type query = QmlAst.expr QmlAst.Db.query
+  type query = QmlAst.expr DbAst.query * QmlAst.expr DbAst.query_options
 
   type set_kind =
     | Map of QmlAst.ty * QmlAst.ty
@@ -54,7 +54,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 * query) option (*bool == unique*)
+    | SetAccess of set_kind * string list * (bool (*is_unique*) * query) option
 
   type node = {
     ty : QmlAst.ty;
@@ -241,7 +241,8 @@ module Schema = struct
       match fragment with
       | DbAst.ExprKey expr ->
           let setkind = get_setkind llschema node in
-          let kind = SetAccess (setkind, path, Some (true, DbAst.QEq expr)) in
+          let options = {DbAst.limit = None; skip = None; sort = None} in
+          let kind = SetAccess (setkind, path, Some (true, (DbAst.QEq expr, options))) in
           (next, kind, path)
 
       | DbAst.FldKey key ->
@@ -259,10 +260,10 @@ module Schema = struct
                 | SetAccess _, _ -> raise (Base.NotImplemented "Selection inside a multi node")
           in let path = key::path
           in (next, kind, path)
-      | DbAst.Query query ->
+      | DbAst.Query (query, options) ->
           begin match kind with
           | SetAccess (_k, path, None) ->
-              let kind = SetAccess (get_setkind llschema node, path, Some (false, query)) in
+              let kind = SetAccess (get_setkind llschema node, path, Some (false, (query, options))) in
               (next, kind, path)
           | SetAccess (_, _path, Some _) ->
               raise (Base.NotImplemented "Selection inside a multi node")

libqmlcompil/qmlDbGen.mli

@@ -53,7 +53,7 @@ module Schema: sig
     package : ObjectFiles.package_name;
   }
 
-  type query = QmlAst.expr QmlAst.Db.query
+  type query = QmlAst.expr QmlAst.Db.query * QmlAst.expr QmlAst.Db.query_options
 
   type set_kind =
     | Map of QmlAst.ty * QmlAst.ty

opa/pass_MongoAccessGeneration.ml

@@ -430,13 +430,13 @@ module Generator = struct
     let uniq, nb, query =
       match query0 with
       | None -> false, 0, None
-      | Some ((uniq, query) as x) ->
+      | Some ((uniq, (query, _opt)) as _x) ->
           uniq,
           (if uniq then 1 else 5000),
           Some (
             match setkind with
             | DbSchema.Map _ -> uniq, DbAst.QFlds [(["_id"], query)]
-            | _ -> x)
+            | _ -> uniq, query)
     in
     (* DbSet.build *)
     let (annotmap, build, query, args) =