From 9773d4a03cdfbc6da479b2343254010fc194f2b8 Mon Sep 17 00:00:00 2001 From: TJ DeVries Date: Tue, 8 Aug 2023 23:54:05 -0400 Subject: [PATCH] feat: add Query.table for joins directly on a table --- .gitignore | 3 ++- lib/petrol.mli | 7 +++++-- lib/query.ml | 37 ++++++++++++++++++++++++++----------- lib/types.ml | 22 +++++++++++++++++----- 4 files changed, 50 insertions(+), 19 deletions(-) diff --git a/.gitignore b/.gitignore index c6a151b..876b9e3 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,2 @@ -_build/ \ No newline at end of file +_build/ +_opam/ diff --git a/lib/petrol.mli b/lib/petrol.mli index 1166736..f51132d 100644 --- a/lib/petrol.mli +++ b/lib/petrol.mli @@ -941,7 +941,7 @@ module Query : sig type ('a, 'b, 'd, 'c) join_fun = ?op:join_op -> on:bool Expr.t -> ('b, 'd) t -> ('c, 'a) t -> ('c, 'a) t - constraint 'a = [< `SELECT_CORE ] constraint 'd = [< `SELECT_CORE | `SELECT ] + constraint 'a = [< `SELECT_CORE ] constraint 'd = [< `SELECT_CORE | `SELECT | `TABLE] (** [('a,'b,'c,'d) join_fun] defines the type of an SQL function that corresponds to SQL's JOIN clause. *) @@ -985,7 +985,7 @@ module Query : sig val having : ([< `SELECT | `SELECT_CORE ], 'c) having_fun (** [having fields expr] corresponds to the SQL [{expr} HAVING {fields}]. *) - val join : ([ `SELECT_CORE ], 'b, [< `SELECT_CORE | `SELECT ], 'c) join_fun + val join : ([ `SELECT_CORE ], 'b, [< `SELECT_CORE | `SELECT | `TABLE], 'c) join_fun (** [join ?op ~on oexpr expr] corresponds to the SQL [{expr} {op} JOIN {oexpr} ON {expr}]. The ordering of the last two arguments has been chosen to allow @@ -1002,6 +1002,9 @@ module Query : sig int Expr.t -> ('a, [< `SELECT | `SELECT_CORE ]) t -> ('a, [> `SELECT ]) t (** [limit count expr] corresponds to the SQL [{expr} LIMIT {count}]. *) + val table : table_name -> (_, [> `TABLE]) t + (** Make a table for a join *) + val offset : int Expr.t -> ('a, [< `SELECT | `SELECT_CORE ]) t -> ('a, [> `SELECT ]) t (** [offset count expr] corresponds to the SQL [{expr} OFFSET {fields}]. *) diff --git a/lib/query.ml b/lib/query.ml index d8acd8c..4b13d32 100644 --- a/lib/query.ml +++ b/lib/query.ml @@ -19,7 +19,7 @@ type ('a,'c) having_fun = type ('a,'b,'d,'c) join_fun = ?op:Types.join_op -> on:bool Expr.t -> - ('b, [< `SELECT_CORE | `SELECT ] as 'd) t + ('b, [< `SELECT_CORE | `SELECT | `TABLE ] as 'd) t -> ('c, 'a) t -> ('c, 'a) t constraint 'a = ([< `SELECT_CORE]) as 'a @@ -53,6 +53,7 @@ let query_ret_ty: 'a 'b. ('a,'b) t -> 'a Type.ty_list = | DELETE { returning; _ } -> Expr.ty_expr_list returning | UPDATE { returning; _ } -> Expr.ty_expr_list returning | INSERT { returning; _ } -> Expr.ty_expr_list returning + | TABLE _ -> invalid_arg "TABLE is not a valid query_ret_ty" let select exprs ~from:table_name = Types.SELECT_CORE { @@ -86,6 +87,7 @@ let where : ('a,'c) where_fun let where = update_where where by in UPDATE { query with where } | Types.INSERT _ -> invalid_arg "where on insert clause not supported" + | Types.TABLE _ -> invalid_arg "where on table clause not supported" let group_by : ('a,'b,'c) group_by_fun = fun by (type a b) (table : (b, a) t) : (b, a) t -> @@ -96,7 +98,8 @@ let group_by : ('a,'b,'c) group_by_fun = SELECT { core=SELECT_CORE { exprs; table; join; where; group_by=Some by; having }; order_by; limit; offset } | Types.DELETE _ | Types.UPDATE _ - | Types.INSERT _ -> invalid_arg "group by only supported on select clause" + | Types.INSERT _ + | Types.TABLE _ -> invalid_arg "group by only supported on select clause" let having : ('a,'c) having_fun = fun having (type a b) (table : (b, a) t) : (b, a) t -> @@ -107,7 +110,8 @@ let having : ('a,'c) having_fun = SELECT { core=SELECT_CORE { exprs; table; join; where; group_by; having=Some having }; order_by; limit; offset } | Types.DELETE _ | Types.UPDATE _ - | Types.INSERT _ -> invalid_arg "group by only supported on select clause" + | Types.INSERT _ + | Types.TABLE _ -> invalid_arg "group by only supported on select clause" let join : ('a,'b,'d,'c) join_fun = fun ?(op=INNER) ~on (type a b c) (ot: (b, _) t) @@ -126,7 +130,8 @@ let join : ('a,'b,'d,'c) join_fun = | Types.SELECT _ | Types.DELETE _ | Types.UPDATE _ - | Types.INSERT _ -> + | Types.INSERT _ + | Types.TABLE _ -> invalid_arg "group by only supported on select clause" let on_err : 'a . [`ABORT | `FAIL | `IGNORE | `REPLACE | `ROLLBACK ] -> ('c, 'a) t -> ('c, 'a) t = @@ -134,7 +139,8 @@ let on_err : 'a . [`ABORT | `FAIL | `IGNORE | `REPLACE | `ROLLBACK ] -> ('c, 'a) match table with | Types.SELECT_CORE _ | Types.SELECT _ - | Types.DELETE _ -> invalid_arg "on_err only supported for update and insert" + | Types.DELETE _ + | Types.TABLE _ -> invalid_arg "on_err only supported for update and insert" | Types.UPDATE query -> UPDATE { query with on_err = Some on_err } | Types.INSERT query -> @@ -146,11 +152,16 @@ let on_conflict : 'a . [ `DO_NOTHING ] -> ('c, 'a) t -> ('c, 'a) t = | Types.SELECT_CORE _ | Types.SELECT _ | Types.UPDATE _ - | Types.DELETE _ -> invalid_arg "on_conflict only supported for insert" + | Types.DELETE _ + | Types.TABLE _ -> invalid_arg "on_conflict only supported for insert" | Types.INSERT query -> INSERT { query with on_conflict = Some on_conflict } + +let table (table: Types.table_name) : (_, [>`TABLE]) t = + Types.TABLE { table } + let limit : 'a 'i . int Types.expr -> ('a, [< `SELECT | `SELECT_CORE ] as 'i) t -> @@ -163,7 +174,8 @@ let limit : SELECT { core; order_by; limit=Some by; offset } | DELETE _ | UPDATE _ - | INSERT _ -> invalid_arg "limit only supported for select" + | INSERT _ + | TABLE _ -> invalid_arg "limit only supported for select" let offset : 'a 'i . @@ -177,7 +189,8 @@ let offset : SELECT { core; order_by; limit; offset=Some by } | DELETE _ | UPDATE _ - | INSERT _ -> invalid_arg "offset only supported for select" + | INSERT _ + | TABLE _ -> invalid_arg "offset only supported for select" let order_by : 'a 'b. ?direction:[ `ASC | `DESC ] -> @@ -191,7 +204,8 @@ let order_by : SELECT { core; order_by= Some(direction,Expr.[field]); limit; offset } | DELETE _ | UPDATE _ - | INSERT _ -> invalid_arg "order by only supported for select" + | INSERT _ + | TABLE _ -> invalid_arg "order by only supported for select" let order_by_ : 'a 'b. ?direction:[ `ASC | `DESC ] -> @@ -205,7 +219,8 @@ let order_by_ : SELECT { core; order_by= Some(direction,field); limit; offset } | DELETE _ | UPDATE _ - | INSERT _ -> invalid_arg "order by only supported for select" + | INSERT _ + | TABLE _ -> invalid_arg "order by only supported for select" let returning : _ Types.expr_list -> @@ -216,4 +231,4 @@ let returning : | Types.DELETE query -> DELETE { query with returning } | UPDATE query -> UPDATE { query with returning } | INSERT query -> INSERT { query with returning } - | SELECT_CORE _ | SELECT _ -> invalid_arg "returning not supported for select" \ No newline at end of file + | SELECT_CORE _ | SELECT _ | TABLE _ -> invalid_arg "returning not supported for select" diff --git a/lib/types.ml b/lib/types.ml index 9958666..f2d90ea 100644 --- a/lib/types.ml +++ b/lib/types.ml @@ -72,9 +72,12 @@ and (_, !'res) query = set: wrapped_assign list; returning: 'a expr_list; } -> ('a, [> `INSERT] as 'res) query + | TABLE : { + table: table_name; + } -> ('a, [> `TABLE]) query and join = MkJoin: { - table: ('r, [< `SELECT_CORE | `SELECT ]) query; + table: ('r, [< `SELECT_CORE | `SELECT | `TABLE ]) query; on: bool expr; join_op: join_op; } -> join @@ -270,13 +273,21 @@ and pp_query: 'a 'b. Format.formatter -> set (pp_opt pp_on_conflict) on_conflict pp_returning returning + | TABLE { table } -> Format.fprintf fmt "%s" (snd table) ) and pp_join : int -> Format.formatter -> join -> unit = fun n fmt (MkJoin { table; on; join_op }) -> - Format.fprintf fmt "%a (%a) AS join_tmp_%d ON %a" - pp_join_op join_op - pp_query table n - pp_expr on + match table with + | TABLE { table } -> + Format.fprintf fmt "%a %s ON %a" + pp_join_op join_op + (snd table) + pp_expr on + | _ -> + Format.fprintf fmt "%a (%a) AS join_tmp_%d ON %a" + pp_join_op join_op + pp_query table n + pp_expr on and pp_join_list : Format.formatter -> join list -> unit = fun fmt ls -> match ls with @@ -338,6 +349,7 @@ and query_values : 'a 'b. wrapped_value list -> ('a,'b) query -> wrapped_value l values_expr acc expr) acc set in let acc = values_expr_list acc returning in acc + | TABLE _ -> invalid_arg "unable to coerce TABLE to value" module Common = struct