aboutsummaryrefslogtreecommitdiff
path: root/lib/expression/filters.ml
diff options
context:
space:
mode:
Diffstat (limited to 'lib/expression/filters.ml')
-rw-r--r--lib/expression/filters.ml193
1 files changed, 193 insertions, 0 deletions
diff --git a/lib/expression/filters.ml b/lib/expression/filters.ml
new file mode 100644
index 0000000..42c794b
--- /dev/null
+++ b/lib/expression/filters.ml
@@ -0,0 +1,193 @@
+(** This module evaluate the sql query to use in order to filter an expression
+
+ The result is built over [Query] except for the group function, which are
+ translated into a CTE in sql
+ *)
+
+open StdLabels
+module Q = Query
+
+type 'a result = {
+ repr : Format.formatter -> nested:Query.QueryParameter.t -> unit;
+ group : 'a T.t option;
+}
+
+module Filter = struct
+ type 'a repr = {
+ repr : 'a Q.Query.repr;
+ with_group : 'a T.t option;
+ }
+
+ type 'a obs = 'a result
+ type 'a path_repr = 'a Q.Query.path_repr
+
+ let observe : 'a Ast.obs * 'a repr -> 'a obs =
+ fun (_, v) -> { repr = Q.Query.observe v.repr; group = v.with_group }
+
+ let empty : 'a Ast.obs -> 'a repr =
+ fun _ -> { repr = Q.Query.empty (); with_group = None }
+
+ let expr : 'a Ast.obs * 'a repr -> 'a Ast.obs -> 'a repr =
+ fun (_, expr) _ ->
+ { repr = Q.Query.expr expr.repr; with_group = expr.with_group }
+
+ let path : 'a path_repr -> 'a -> 'a Ast.obs -> 'a repr =
+ fun repr p _ -> { repr = Q.Query.path repr p; with_group = None }
+
+ let literal : string -> 'a Ast.obs -> 'a repr =
+ fun l _ -> { repr = Q.Query.literal l; with_group = None }
+
+ let integer : string -> 'a Ast.obs -> 'a repr =
+ fun l _ -> { repr = Q.Query.integer l; with_group = None }
+
+ let nvl : ('a Ast.obs * 'a repr) list -> 'a Ast.obs -> 'a repr =
+ fun expression _ ->
+ let expr_repr = List.map ~f:(fun v -> (snd v).repr) expression in
+ let with_group =
+ List.find_map ~f:(fun v -> (snd v).with_group) expression
+ in
+ match with_group with
+ | None -> { repr = Q.Query.nvl expr_repr; with_group }
+ | Some _ -> raise ImportErrors.MisplacedWindow
+
+ let concat : ('a Ast.obs * 'a repr) list -> 'a Ast.obs -> 'a repr =
+ fun expression _ ->
+ let expr_repr = List.map ~f:(fun v -> (snd v).repr) expression in
+ let with_group =
+ List.find_map ~f:(fun v -> (snd v).with_group) expression
+ in
+ match with_group with
+ | None -> { repr = Q.Query.concat expr_repr; with_group }
+ | Some _ -> raise ImportErrors.MisplacedWindow
+
+ let join : string -> ('a Ast.obs * 'a repr) list -> 'a Ast.obs -> 'a repr =
+ fun sep expression _ ->
+ let expr_repr = List.map ~f:(fun v -> (snd v).repr) expression
+ and with_group =
+ List.find_map ~f:(fun v -> (snd v).with_group) expression
+ in
+ match with_group with
+ | None -> { repr = Q.Query.join sep expr_repr; with_group }
+ | Some _ -> raise ImportErrors.MisplacedWindow
+
+ let boperator :
+ T.binary_operator ->
+ 'a Ast.obs * 'a repr ->
+ 'a Ast.obs * 'a repr ->
+ 'a Ast.obs ->
+ 'a repr =
+ fun name (_, e1) (_, e2) _ ->
+ let with_group =
+ match (e1.with_group, e2.with_group) with
+ | Some e, None -> Some e
+ | None, Some e -> Some e
+ | None, None -> None
+ | _ -> raise ImportErrors.MisplacedWindow
+ in
+ { repr = Q.Query.boperator name e1.repr e2.repr; with_group }
+
+ let gequality :
+ T.binary_operator ->
+ 'a Ast.obs * 'a repr ->
+ ('a Ast.obs * 'a repr) list ->
+ 'a Ast.obs ->
+ 'a repr =
+ fun name (_, e1) group _ ->
+ let group_repr = List.map ~f:(fun v -> (snd v).repr) group
+ and with_group = List.find_map ~f:(fun v -> (snd v).with_group) group in
+
+ match with_group with
+ | None ->
+ {
+ repr = Q.Query.gequality name e1.repr group_repr;
+ with_group = e1.with_group;
+ }
+ | _ -> raise ImportErrors.MisplacedWindow
+
+ let funct : string -> ('a Ast.obs * 'a repr) list -> 'a Ast.obs -> 'a repr =
+ fun name expressions _ ->
+ let expr_repr = List.map ~f:(fun v -> (snd v).repr) expressions in
+ let with_group =
+ List.find_map ~f:(fun v -> (snd v).with_group) expressions
+ in
+ match with_group with
+ | None -> { repr = Q.Query.funct name expr_repr; with_group }
+ | Some _ -> raise ImportErrors.MisplacedWindow
+
+ let function' :
+ T.funct -> ('a Ast.obs * 'a repr) list -> 'a Ast.obs -> 'a repr =
+ fun name expressions _ ->
+ let expr_repr = List.map ~f:(fun v -> (snd v).repr) expressions in
+ let with_group =
+ List.find_map ~f:(fun v -> (snd v).with_group) expressions
+ in
+ match with_group with
+ | None ->
+ { repr = Q.Query.funct (T.name_of_function name) expr_repr; with_group }
+ | Some _ -> raise ImportErrors.MisplacedWindow
+
+ (** Window functions are not handled in the filters, we save them as an AST
+ in order to process them in a separated handler.
+
+ It is not allowed to build nested window functions. *)
+ let window :
+ ('a Ast.obs * 'a repr) T.window ->
+ ('a Ast.obs * 'a repr) list ->
+ ('a Ast.obs * 'a repr) list ->
+ 'a Ast.obs ->
+ 'a repr =
+ fun name expressions order ast ->
+ ignore name;
+ let with_group_expr =
+ List.find_map ~f:(fun v -> (snd v).with_group) expressions
+ and with_group_order =
+ List.find_map ~f:(fun v -> (snd v).with_group) order
+ in
+ match (with_group_expr, with_group_order) with
+ | Some _, _ | _, Some _ -> raise ImportErrors.MisplacedWindow
+ | None, None ->
+ (* The column name used with the cte. The name is fixed here, and used
+ as is in [Analysers.Query.build_cte] and
+ [Analysers.Query.eval_filters] *)
+ let q = "cte.group0" in
+ {
+ with_group = Some ast;
+ repr = Q.Query.funct "expr" [ Q.Query.literal q ];
+ }
+end
+
+module ASTBuilder =
+ Compose.Expression
+ (Ast)
+ (struct
+ let v = ()
+ end)
+
+module F :
+ Sym.SYM_EXPR
+ with type 'a obs = 'a result
+ and type 'a path_repr = Format.formatter -> 'a -> unit =
+ ASTBuilder.Make (Filter)
+
+module M = Sym.M (F)
+
+let query_of_expression :
+ type b.
+ b Q.binded_query ->
+ Format.formatter ->
+ (Format.formatter -> 'a -> unit) ->
+ 'a T.t ->
+ b * 'a T.t option =
+ fun parameter formatter printer expr ->
+ let repr = M.eval ~path_repr:printer expr in
+ match parameter with
+ | BindParam ->
+ let p = Queue.create () in
+ let parameter = Q.QueryParameter.Queue p in
+ let value = F.observe repr in
+ value.repr ~nested:parameter formatter;
+ (p, value.group)
+ | NoParam ->
+ let value = F.observe repr in
+ value.repr ~nested:Literal formatter;
+ ((), value.group)
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-23 19:01:22 +0000