Skip to content

Instantly share code, notes, and snippets.

@andreypopp
Created July 2, 2021 12:08
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save andreypopp/74b6079c0b73f5a8141f0c033d4511d0 to your computer and use it in GitHub Desktop.
open Import
(** Database catalogue. *)
module Catalog = struct
type schema = string
and table = {
schema: schema;
name: string;
columns: column list;
}
and column = string
[@@deriving sexp_of, compare]
type t = schema
let pp_table ppf table = Fmt.pf ppf "%s.%s" table.schema table.name
end
(** Represent OCaml values. *)
module Value = struct
type t =
| String of string
| Int of int
| Float of float
| Bool of bool
[@@deriving sexp_of, compare]
let bool v = Bool v
let string v = String v
let int v = Int v
let float v = Float v
end
(** Binary operators. *)
module Bin_op = struct
type t =
| EQ
| NEQ
| AND
| OR
| MUL
| ADD
| SUB
| DIV
[@@deriving sexp_of, compare]
end
(** SQL Abstract Syntax Tree, used for codegen. *)
module Sql = struct
type select = {
fields : (expr * string option) list;
from : from;
where : expr option;
group_by : expr list option;
}
and expr =
| Expr_column of (string option * string)
| Expr_value of Value.t
| Expr_binop of Bin_op.t * expr * expr
| Expr_exists of select
| Expr_call of string * expr list
and from_one =
| From_table of Catalog.table * string option
| From_select of select * string option
and from =
| From of from_one
| From_join of from * from_one * expr
let rec ppsql_select ppf select =
Fmt.hovbox (fun ppf {fields; from; where; group_by;} ->
Fmt.pf ppf
"SELECT@ %a%a%a%a"
ppsql_fields fields
ppsql_from from
(Fmt.option ppsql_where) where
(Fmt.option ppsql_group_by) group_by
) ppf select
and ppsql_from ppf =
function
| From from_one ->
Fmt.pf ppf "@ FROM %a" ppsql_from_one from_one
| From_join (base, join, expr) ->
Fmt.pf ppf
"%a@ JOIN %a@ ON %a"
ppsql_from base
ppsql_from_one join
ppsql_expr expr
and ppsql_from_one ppf =
function
| From_table (table, alias) ->
let alias = Option.value alias ~default:"__query" in
Fmt.pf ppf "%a%a" ppsql_table table ppsql_alias alias
| From_select (select, alias) ->
let alias = Option.value alias ~default:"__query" in
Fmt.pf ppf "(%a)%a" ppsql_select select ppsql_alias alias
and ppsql_where ppf expr =
Fmt.pf ppf "@ WHERE %a" ppsql_expr expr
and ppsql_group_by ppf = function
| [] -> Fmt.pf ppf "@ GROUP BY ()"
| exprs -> Fmt.pf ppf "@ GROUP BY %a" Fmt.(list ppsql_expr) exprs
and ppsql_fields ppf =
let ppsql_field ppf (expr, alias) =
ppsql_expr ppf expr;
(Fmt.option ppsql_alias) ppf alias
in
let sep ppf () = Fmt.pf ppf ", " in
Fmt.(list ~sep ppsql_field) ppf
and ppsql_expr ppf = function
| Expr_value value -> ppsql_value ppf value
| Expr_column (qual, name) ->
let qual = Option.value qual ~default:"__query" in
Fmt.pf ppf "%a.%a" Fmt.(quote string) qual Fmt.(quote string) name
| Expr_binop (op, a, b) ->
Fmt.pf ppf "(%a %a %a)" ppsql_expr a ppsql_binop op ppsql_expr b
| Expr_exists select ->
Fmt.pf ppf "EXISTS (%a)" ppsql_select select
| Expr_call ("count" as name, []) ->
Fmt.pf ppf "%s(*)" name
| Expr_call (name, args) ->
Fmt.pf ppf "%s(%a)" name Fmt.(list ppsql_expr) args
and ppsql_binop ppf binop =
let v =
match binop with
| Bin_op.EQ -> "="
| NEQ -> "!="
| AND -> "AND"
| OR -> "OR"
| MUL -> "*"
| ADD -> "+"
| SUB -> "-"
| DIV -> "/"
in
Fmt.(const string) v ppf ()
and ppsql_value ppf = function
| Value.String v -> Fmt.(quote ~mark:"'" string) ppf v
| Bool v -> Fmt.bool ppf v
| Int v -> Fmt.int ppf v
| Float v -> Fmt.float ppf v
and ppsql_table ppf table =
Fmt.pf ppf "%s.%s" table.Catalog.schema table.Catalog.name
and ppsql_alias ppf alias =
Fmt.pf ppf " AS %a" Fmt.(quote string) alias
let ppsql = ppsql_select
end
(** Query Language. *)
module Syntax = struct
type t = rel
(* Relational operators ... *)
and rel =
| From of Catalog.table
| Where of rel * expr
| Select of rel * (expr * string) list
| Name of rel * string
| Join of rel * rel * expr
| Define of rel * (expr * string) list
| Group of rel * (expr * string) list
(* ... and expressions. *)
and expr =
| Exists of rel
| Bin_op of Bin_op.t * expr * expr
| Value of Value.t
| Get of string
| Qual of string * expr
| Param of string
| Agg of string * expr list
| Call of string * expr list
[@@deriving sexp_of, compare]
let rec pp ppf syn =
match syn with
| From table -> Fmt.pf ppf "FROM %a" Catalog.pp_table table
| Name (base, alias) ->
Fmt.pf ppf "%a@ AS %s" pp base alias
| Join (base, join, expr) ->
Fmt.pf ppf "%a@ JOIN %a@ ON %a" pp base pp join pp_expr expr
| Where (base, expr) ->
Fmt.pf ppf "%a@ WHERE %a" pp base pp_expr expr
| Select (base, fields) ->
Fmt.pf ppf "%a@ SELECT %a" pp base pp_fields fields
| Define (base, fields) ->
Fmt.pf ppf "%a@ DEFINE %a" pp base pp_fields fields
| Group (base, fields) ->
Fmt.pf ppf "%a@ GROUP BY %a" pp base pp_fields fields
and pp_expr ppf = function
| Value value -> Sql.ppsql_value ppf value
| Bin_op (binop, a, b) ->
Fmt.pf ppf "%a %a %a" pp_expr a Sql.ppsql_binop binop pp_expr b
| Exists rel -> Fmt.pf ppf "EXISTS(%a)" pp rel
| Call (name, args) ->
Fmt.pf ppf "%s(%a)" name Fmt.(list pp_expr) args
| Agg (name, args) ->
Fmt.pf ppf "%s(%a)" name Fmt.(list pp_expr) args
| Get name -> Fmt.string ppf name
| Param name -> Fmt.pf ppf "$%s" name
| Qual (q, (Get _ as e)) -> Fmt.pf ppf "%s.%a" q pp_expr e
| Qual (q, e) -> Fmt.pf ppf "%s.(%a)" q pp_expr e
and pp_fields ppf fields =
Fmt.(list ~sep:comma) pp_field ppf fields
and pp_field ppf (e, label) =
Fmt.pf ppf "%a AS %s" pp_expr e label
end
(**
Scope requests.
This represents what could be requested to be fetched/computed from the
relation.
*)
module Req = struct
type t =
| N of string (* Columns: username *)
| A of string * Syntax.expr list (* Aggregations: MAX(value) *)
| Q of string * t (* Qualified requests: u.username, c.count() *)
[@@deriving sexp_of, compare]
let qual q req = Q (q, req)
include Comparator.Make(struct
type nonrec t = t
let compare = compare
let sexp_of_t = sexp_of_t
end)
let rec pp ppf = function
| N n -> Fmt.string ppf n
| Q (q, n) -> Fmt.pf ppf "%s.%a" q pp n
| A (name, args) -> Syntax.pp_expr ppf (Syntax.Call (name, args))
end
(**
Desugared query pipelines.
*)
module Pipeline = struct
type t = info * rel
and rel =
| From of Catalog.table
| Where of t * expr
| Select of t * (expr * string) list
| Join of t * t * expr
| Group of t * (expr * string) list
and expr =
| Exists of t
| Bin_op of Bin_op.t * expr * expr
| Value of Value.t
| Qual of string * expr
| Call of string * expr list
| Lookup of Req.t
and info = {
scope : scope;
name : string option;
}
and scope = (Req.t, value * string, Req.comparator_witness) Map.t
and value =
| C of col
| E of expr * scope
and col = string option * string
let syntax (_, syn) = syn
let name ({name; _}, _) = name
let scope ({scope; _}, _) = scope
let rec pp ppf (_, syn) =
match syn with
| From table -> Fmt.pf ppf "FROM %a" Catalog.pp_table table
| Join (base, join, expr) ->
Fmt.pf ppf "%a@ JOIN %a@ ON %a" pp base pp join pp_expr expr
| Where (base, expr) ->
Fmt.pf ppf "%a@ WHERE %a" pp base pp_expr expr
| Select (base, fields) ->
Fmt.pf ppf "%a@ SELECT %a" pp base pp_fields fields
| Group (base, fields) ->
Fmt.pf ppf "%a@ GROUP BY %a" pp base pp_fields fields
and pp_expr ppf = function
| Value value -> Sql.ppsql_value ppf value
| Bin_op (binop, a, b) ->
Fmt.pf ppf "%a %a %a" pp_expr a Sql.ppsql_binop binop pp_expr b
| Exists rel -> Fmt.pf ppf "EXISTS(%a)" pp rel
| Call (name, args) ->
Fmt.pf ppf "%s(%a)" name Fmt.(list pp_expr) args
| Lookup req ->
Fmt.pf ppf "REQ %a" Req.pp req
| Qual (q, e) -> Fmt.pf ppf "%s.(%a)" q pp_expr e
and pp_fields ppf fields =
Fmt.(list ~sep:comma) pp_field ppf fields
and pp_field ppf (e, label) =
Fmt.pf ppf "%a AS %s" pp_expr e label
end
(**
Sets of requests [Req.t].
*)
module Req_set = struct
type t = (Req.t, Req.comparator_witness) Set.t
let empty = Set.empty (module Req)
let pp fmt seq =
Fmt.pf fmt "{%a}" Fmt.(sequence ~sep:comma Req.pp) (Set.to_sequence seq)
[@@ocaml.warning "-32"]
let qualify q names =
Set.map (module Req) names ~f:(Req.qual q)
let unqualify q names =
Set.fold names
~init:empty
~f:(fun req name ->
match name with
| Req.Q (q', n) when String.(q = q') -> Set.add req n
| Req.Q _
| Req.A _
| Req.N _ -> req
)
(** [of_expr e] returns a set of names mentioned in [e] expression. *)
let of_expr expr =
let rec of_expr' found = function
| Syntax.Bin_op (_, a, b) ->
of_expr' (of_expr' found a) b
| Get n ->
Set.add found (Req.N n)
| Exists _ (* Only uncorrelated subqueries for now *)
| Param _
| Value _ -> found
| Qual (n, e) ->
qualify n (of_expr' empty e)
| Call (_name, args) ->
List.fold_left args ~init:found ~f:of_expr'
| Agg (name, args) ->
Set.add found (Req.A (name, args))
in of_expr' empty expr
end
(**
Scope maps names [Req.t] into columns (C) or other expressions with own
scopes (E).
*)
module Scope = struct
type t = Pipeline.scope
let empty = Map.empty (module Req)
let add scope name v =
match Map.add scope ~key:name ~data:v with
| `Ok scope -> scope
| `Duplicate -> scope
let add_name scope name v =
add scope (Req.N name) v
let resolve scope req =
Option.map (Map.find scope req) ~f:fst
let pp_col ppf = function
| None, name -> Fmt.string ppf name
| Some q, name -> Fmt.pf ppf "%s.%s" q name
(**
Sealed scopes are like scopes but map requests to compiled columns only.
*)
module Sealed = struct
type t = (Req.t, Pipeline.col, Req.comparator_witness) Map.t
let combine a b =
let prefix_col qual name =
let alias =
match qual with
| None -> name
| Some qual -> qual ^ "__" ^ name
in
Pipeline.C (qual, name), alias
in
Map.merge a b ~f:(fun ~key:_ c ->
match c with
| `Left (alias, name)
| `Right (alias, name)
| `Both ((alias, name), _) -> Some (prefix_col alias name)
)
let to_scope scope =
Map.fold scope
~init:(Map.empty (module Req))
~f:(fun ~key:req ~data:(alias, name) export ->
let data = Pipeline.C (alias, name), name in
add export req data
)
let of_scope ~name:qual scope =
Map.fold scope
~init:(Map.empty (module Req))
~f:(fun ~key:req ~data:(_, name) export ->
let data = qual, name in
add export req data
)
let pp ppf scope =
let pp_item ppf (k, col) =
Fmt.pf ppf "%a -> %a" Req.pp k pp_col col
in
Fmt.pf ppf
"@[<hov>{%a}@]"
Fmt.(sequence ~sep:comma pp_item) (Map.to_sequence scope)
[@@ocaml.warning "-32"]
end
let seal ~name scope : t =
Sealed.(to_scope (of_scope ~name scope))
let filter_req ~req scope =
Map.fold scope
~init:empty
~f:(fun ~key ~data export ->
if Set.mem req key
then add export key data
else export)
let merge a b : t =
Map.merge a b ~f:(fun ~key:_ -> function
| `Left v | `Right v | `Both (v, _) -> Some v
)
let qualify q scope =
Map.fold
scope
~init:empty
~f:(fun ~key ~data map -> add map (Req.qual q key) data)
let of_table table : t =
List.fold_left
table.Catalog.columns
~init:empty
~f:(fun scope colname ->
let r = Req.N colname in
let c = Pipeline.C (None, colname), colname in
add scope r c)
let rec pp ppf scope =
let pp_item ppf (k, (expr, alias)) =
match expr with
| Pipeline.C col ->
Fmt.pf ppf "%a -> C %a AS %s" Req.pp k pp_col col alias
| E (e, s) ->
Fmt.pf ppf "%a -> E %a AT %a AS %s" Req.pp k Pipeline.pp_expr e pp s alias
in
Fmt.pf ppf
"@[<hov>{%a}@]"
Fmt.(sequence ~sep:comma pp_item) (Map.to_sequence scope)
[@@ocaml.warning "-32"]
end
exception Plan_error of string
(** [plan syn] produces a [Pipeline.t] out of [Syntax.t] *)
let plan ~lookup_param (syn : Syntax.t) : Pipeline.t =
let sealed_base_scope ?(req=None) base =
let scope = Pipeline.scope base in
let scope = Scope.seal ~name:(Pipeline.name base) scope in
match req with
| None -> scope
| Some req -> Scope.filter_req ~req scope
in
let rec plan_rel ~all ~(req : Req_set.t) (syn : Syntax.t) : Pipeline.t =
match syn with
| From table ->
let scope =
let scope = Scope.of_table table in
if all then scope else Scope.filter_req ~req scope
in
{scope; name = None;}, From table
| Where (base, expr) ->
let base =
let req = Set.union req (Req_set.of_expr expr) in
plan_rel ~all ~req base
in
let expr = plan_expr expr in
let scope = sealed_base_scope ~req:(if all then None else Some req) base in
{scope; name = None;}, Where (base, expr)
| Select (base, select) ->
let select, this_req =
List.fold_left select
~init:([], Req_set.empty)
~f:(fun (select, this_req) (expr, alias) ->
if all || Set.mem req (Req.N alias)
then
let this_req = Set.union this_req (Req_set.of_expr expr) in
(plan_expr expr, alias)::select, this_req
else select, this_req
)
in
let base = plan_rel ~all:false ~req:this_req base in
let scope =
let base_scope = sealed_base_scope base in
List.fold_left
select
~init:(Map.empty (module Req))
~f:(fun export (expr, alias) ->
Scope.add_name export alias (Pipeline.E (expr, base_scope), alias))
in
{scope; name = None;}, Select (base, List.rev select)
| Define (base, select) ->
let select, this_req =
List.fold_left select
~init:([], Req_set.empty)
~f:(fun (select, this_req) (expr, alias) ->
if Set.mem req (Req.N alias)
then
let this_req = Set.(union this_req (Req_set.of_expr expr)) in
(plan_expr expr, alias)::select, this_req
else select, this_req
)
in
let base =
plan_rel
~all
~req:(Set.union req this_req)
base
in
let scope =
let scope = Pipeline.scope base in
List.fold_left
select
~init:scope
~f:(fun newscope (expr, alias) ->
let v = Pipeline.E (expr, scope), alias in
Scope.add_name newscope alias v
)
in
{scope; name = Pipeline.name base}, Pipeline.syntax base
| Name (base, name) ->
let base =
(* Produce plan for [base] by only passing unqualified requests. *)
let req = Req_set.unqualify name req in
plan_rel ~all ~req base
in
let scope =
(* Before constructing the export scope we qualify base scope back. *)
let available = Pipeline.scope base in
Scope.qualify name available
in
{scope; name = Some name}, Pipeline.syntax base
| Join (base, join, expr) ->
let this_req = Set.union (Req_set.of_expr expr) req in
let base = plan_rel ~all ~req:this_req base in
let join = plan_rel ~all ~req:this_req join in
let expr = plan_expr expr in
let scope =
let seal node =
Scope.Sealed.of_scope
~name:(Pipeline.name node)
(Pipeline.scope node)
in
Scope.Sealed.combine (seal base) (seal join)
in
{scope; name = None;}, Join (base, join, expr)
| Group (base, fields) ->
let fields, this_req =
List.fold_left fields
~init:([], Req_set.empty)
~f:(fun (fields, req) (expr, name) ->
let field = plan_expr expr, name in
let req = Set.union req (Req_set.of_expr expr) in
field::fields, req
)
in
let aggregates, this_req =
Set.fold req
~init:([], this_req)
~f:(fun (aggregates, this_req) req ->
match req with
| Req.A (name, args) ->
let expr = Syntax.Call (name, args) in
let this_req = Set.union this_req (Req_set.of_expr expr) in
let aggregates = (plan_expr expr, req)::aggregates in
aggregates, this_req
| Req.N _ | Req.Q _ ->
aggregates, Set.add this_req req
)
in
let base =
plan_rel ~all:false ~req:this_req base
in
let scope =
let base_scope = sealed_base_scope base in
let scope = Scope.empty in
let scope =
List.fold_left
fields
~init:scope
~f:(fun export (expr, alias) ->
Scope.add_name export alias (Pipeline.E (expr, base_scope), alias))
in
let scope, _ =
List.fold_left
aggregates
~init:(scope, 1)
~f:(fun (newscope, n) (expr, req) ->
let alias = "agg__" ^ Int.to_string n in
Scope.add newscope req (Pipeline.E (expr, base_scope), alias), n + 1)
in
scope
in
{scope; name = None;}, Group (base, List.rev fields)
and plan_expr = function
| Syntax.Exists rel ->
Pipeline.Exists (plan_rel ~all:true ~req:Req_set.empty rel)
| Bin_op (op, a, b) ->
Bin_op (op, plan_expr a, plan_expr b)
| Value v -> Value v
| Param name ->
begin match lookup_param name with
| None -> raise (Plan_error ("no such param provided: " ^ name))
| Some v -> Value v
end
| Get name -> Lookup (Req.N name)
| Qual (name, e) -> Qual (name, plan_expr e)
| Call (name, args) ->
let args = List.map args ~f:plan_expr in
Call (name, args)
| Agg (name, args) ->
Lookup (Req.A (name, args))
in
plan_rel ~all:true ~req:Req_set.empty syn
exception Translation_error of string
let rec translate (rel : Pipeline.t) =
translate_rel rel
and translate_rel (info, rel) =
let names (info, _ : Pipeline.t) =
Scope.seal ~name:info.name info.scope
in
match rel with
| From table ->
let fields = translate_export info.scope in
let from = Sql.From (From_table (table, None)) in
{Sql. fields; from; where = None; group_by = None;}
| Where (base, expr) ->
let alias = Pipeline.name base in
let fields = translate_export info.scope in
let where = translate_expr ~names:(names base) expr in
let from = Sql.From (From_select (translate_rel base, alias)) in
{Sql. fields; from; where = Some where; group_by = None;}
| Select (base, select) ->
let fields = translate_select ~names:(names base) select in
let alias = Pipeline.name base in
let from = Sql.From (From_select (translate_rel base, alias)) in
{Sql. fields; from; where = None; group_by = None;}
| Group (base, group) ->
let fields = translate_export info.scope in
let from =
let alias = Pipeline.name base in
Sql.From (From_select (translate_rel base, alias))
in
let group_by =
List.map group ~f:(fun (e, _) -> translate_expr ~names:(names base) e)
in
{Sql. fields; from; where = None; group_by = Some group_by;}
| Join (base, join, expr) ->
let names =
Scope.merge
(names base)
(names join)
in
let fields = translate_export info.scope in
let from =
Sql.From_join (
From (From_select (translate_rel base, Pipeline.name base)),
(From_select (translate_rel join, Pipeline.name join)),
translate_expr ~names expr
)
in
{Sql. fields; from; where = None; group_by = None;}
and translate_expr ~(names : Pipeline.scope) expr =
let rec translate_expr' qual expr =
match expr with
| Pipeline.Bin_op (op, a, b) ->
Sql.Expr_binop (op, translate_expr' qual a, translate_expr' qual b)
| Value v -> Sql.Expr_value v
| Exists rel -> Sql.Expr_exists (translate_rel rel)
| Qual (name, e) ->
let qual = name::qual in
translate_expr' qual e
| Call (name, args) ->
let args = List.map args ~f:(translate_expr' qual) in
Expr_call (name, args)
| Lookup req ->
let req =
List.fold_left qual
~init:req
~f:(fun req q -> Req.qual q req)
in
begin match Scope.resolve names req with
| Some C col -> Sql.Expr_column col
| Some E (expr, names) -> translate_expr ~names expr
| None ->
let msg =
Fmt.strf
"unable to find request %a in scope %a"
Req.pp req Scope.pp names
in
raise (Translation_error msg)
end
in
translate_expr' [] expr
and translate_select ~(names : Pipeline.scope) select =
List.map select ~f:(fun (expr, alias) -> translate_expr ~names expr, Some alias)
and translate_export (scope : Pipeline.scope) =
Map.fold scope
~init:[]
~f:(fun ~key:_ ~data fields ->
let field =
match data with
| C c, alias -> Sql.Expr_column c, Some alias
| E (expr, names), alias -> translate_expr ~names expr, Some alias
in
field::fields
)
(** PUBLIC API *)
type expr = Syntax.expr
let get name = Syntax.Get name
let qual name expr = Syntax.Qual (name, expr)
let param name = Syntax.Param name
let agg name args = Syntax.Agg (name, args)
let call name args = Syntax.Call (name, args)
let exists rel = Syntax.Exists rel
let bool v = Syntax.Value (Value.Bool v)
let string v = Syntax.Value (Value.String v)
let int v = Syntax.Value (Value.Int v)
let float v = Syntax.Value (Value.Float v)
let (+) a b = Syntax.Bin_op (ADD, a, b)
let (-) a b = Syntax.Bin_op (SUB, a, b)
let ( * ) a b = Syntax.Bin_op (MUL, a, b)
let ( / ) a b = Syntax.Bin_op (DIV, a, b)
let (&&) a b = Syntax.Bin_op (AND, a, b)
let (||) a b = Syntax.Bin_op (OR, a, b)
let ( == ) a b = Syntax.Bin_op (EQ, a, b)
let ( != ) a b = Syntax.Bin_op (NEQ, a, b)
let pp_expr = Syntax.pp_expr
let show_expr = Fmt.strf "%a" pp_expr
type rel = Syntax.t
let from table = Syntax.From table
let where expr base = Syntax.Where (base, expr)
let select select base = Syntax.Select (base, select)
let define select base = Syntax.Define (base, select)
let name name base = Syntax.Name (base, name)
let join join expr base = Syntax.Join (base, join, expr)
let group fields base = Syntax.Group (base, fields)
let pp_rel = Syntax.pp
let show_rel = Fmt.strf "%a" pp_rel
let no_params _ = None
let tosql ?(lookup_param=no_params) q =
let q = plan ~lookup_param q in
let sql = translate q in
try Ok (Fmt.strf "%a" Sql.ppsql sql)
with
| Plan_error err -> Error err
| Translation_error err -> Error err
(**
Rel is a composable query language which compiles to SQL.
*)
(** {1 Database Catalogue}
Database Catalogue contiains information about tables and columns in the
database. This information is needed to properly resolve names.
*)
module Catalog : sig
type t = schema
and schema = string
and table = {
schema: schema;
name: string;
columns: column list;
}
and column = string
end
(** {1 Expression Language}
Expression Language is used to define computations over relations: fields to
select, filter conditions, group by fields and etc.
*)
type expr
(** Type of Expression Language terms. *)
(** {2 Basic expressions} *)
val get : string -> expr
(** [get n] expressions refers to a name [n] in the current scope. *)
val qual : string -> expr -> expr
(** [qual n e] qualifies expression [e] with [n] namespace. *)
val param : string -> expr
(** [param n] creates a named parameter. *)
val call : string -> expr list -> expr
(** [call n args] calls a function [n] with [args]. *)
val agg : string -> expr list -> expr
(** [agg n args] calls an aggregate function [n] with [args].
Aggregate functions are always evaluated in the context of the closest
group relation (created with {!val:group}).
*)
(** {2 Operators} *)
val ( && ) : expr -> expr -> expr
val ( || ) : expr -> expr -> expr
val ( == ) : expr -> expr -> expr
val ( != ) : expr -> expr -> expr
val ( + ) : expr -> expr -> expr
val ( - ) : expr -> expr -> expr
val ( * ) : expr -> expr -> expr
val ( / ) : expr -> expr -> expr
(** {2 Values}
Combinators below allow to create new {!type:expr} terms from OCaml values.
*)
val bool : bool -> expr
(** [bool v] constructs an {!type:expr} out of {!type:bool}. *)
val int : int -> expr
(** [int v] constructs an {!type:expr} out of {!type:int}. *)
val string : string -> expr
(** [string v] constructs an {!type:expr} out of {!type:string}. *)
val float : float -> expr
(** [float v] constructs an {!type:expr} out of {!type:float}. *)
(** {2 Other} *)
val pp_expr : expr Fmt.t
(** Pretty printer for {!type:expr}. *)
val show_expr : expr -> string
(** {1 Relational Language}
Relational Language is used to define relational structure. Such structure
has tree-like shape (because of {!val:join} combinator) with a hierarchical
namespaces (introduced via {!val:name} combinator).
The API is structured so it's convenient to use {!val:|>} operator to
compose multiple relational terms together: [q1 |> where ... |> select [...]].
*)
type rel
(** Type of Relational Language terms. *)
(** {2 Combinators} *)
val from : Catalog.table -> rel
(** [from table] queries [table], all columns of the [table] are selected. *)
val where : expr -> rel -> rel
(** [q |> where e] filters [q] with condition specified by [e]. *)
val select : (expr * string) list -> rel -> rel
(** [q |> select fields] selects only specified [fields] from [q]. *)
val define : (expr * string) list -> rel -> rel
(** [q |> define fields] defines additional [fields] in [q].
This works similar to {!val:select} but doesn't add fields in the output.
Such fields can be used by downstream rel terms.
*)
val name : string -> rel -> rel
(** [q |> name n] puts [q] under name [n]. *)
val join : rel -> expr -> rel -> rel
(** [q |> join q' e] joins [q] and [q'] using condition [e].
The resulting term has scope merged from both [q] and [q'] relations. To
prevent clashes {!val:name} can be used to lift one (or both) of the
relations into a namespace:
{[
q
|> join (q' |> name "join") (...)
|> select [
get "name", "name"; (* select from q *)
qual "join" @@ get "name", "join_name"; (* select from q' *)
]
]}
*)
val group : (expr * string) list -> rel -> rel
(** [q |> group fields] groups [q] using expressions in [fields].
All expressions in [fields] are available in the scope.
*)
(** {2 Other} *)
val pp_rel : rel Fmt.t
(** Pretty printer for {!type:rel}. *)
val show_rel : rel -> string
(** {1 Compilation} *)
(** Values.
Values are used to fill the parameters with concrete values.
*)
module Value : sig
type t
val bool : bool -> t
val int : int -> t
val string : string -> t
val float : float -> t
end
val tosql : ?lookup_param:(string -> Value.t option) -> rel -> (string, string) Result.t
(** [tosql q] compiles [q] into an SQL string.
The [lookup_param] argument can be provided to resolve parameters (see
{!val:param}) to values.
*)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment