From 5e1a15358fa78abbc3f2956fb53b4f8429121bfe Mon Sep 17 00:00:00 2001 From: ygrek Date: Sun, 19 Jul 2015 17:24:36 -0700 Subject: [PATCH] pass environment for table name resolution, quick hack to fix #22 --- lib/syntax.ml | 50 +++++++++++++++++++++++++++++++------------------- lib/tables.ml | 5 +++-- src/cli.ml | 10 ++-------- test/out/subquery.xml | 19 +++++++++++++++++++ test/subquery.sql | 19 +++++++++++++++++++ 5 files changed, 74 insertions(+), 29 deletions(-) create mode 100644 test/out/subquery.xml create mode 100644 test/subquery.sql diff --git a/lib/syntax.ml b/lib/syntax.ml index 1cdda84..366a9a9 100644 --- a/lib/syntax.ml +++ b/lib/syntax.ml @@ -4,6 +4,10 @@ open Printf open Prelude open Sql +type env = { tables : Tables.table list; } + +let empty_env = { tables = [] } + let collect f l = List.flatten (List.map f l) (* FIXME *) @@ -62,6 +66,11 @@ let split_column_assignments tables l = (** replace every Column with Value of corresponding type *) let rec resolve_columns tables joined_schema expr = +(* + eprintf "\nRESOLVE COLUMNS\n%s\n%!" (expr_to_string expr); + Tables.print stderr tables; + Sql.Schema.print joined_schema; +*) let schema_of_table name = name |> Tables.get_from tables |> snd in let rec each e = match e with @@ -71,7 +80,7 @@ let rec resolve_columns tables joined_schema expr = `Value attr.domain | Param x -> `Param x | Fun (r,l,select) -> - let p = params_of_select select in + let p = params_of_select {tables} select in `Func (r,p @ List.map each l) in each expr @@ -159,7 +168,7 @@ and get_params_opt tables j_s = function and get_params_l tables j_s l = collect (get_params tables j_s) l -and do_join (tables,params,schema) ((table1,params1),kind) = +and do_join env (tables,params,schema) ((table1,params1),kind) = let (_,schema1) = table1 in let tables = tables @ [table1] in let schema = match kind with @@ -171,12 +180,14 @@ and do_join (tables,params,schema) ((table1,params1),kind) = in let p = match kind with | `Cross | `Default | `Natural | `Using _ -> [] - | `Search e -> get_params tables schema e + | `Search e -> get_params env.tables schema e in tables,params @ params1 @ p , schema -and join ((t0,p0),joins) = - let (tables,params,joined_schema) = List.fold_left do_join ([t0],p0,snd t0) joins in +and join env ((t0,p0),joins) = + let all_tables = List.fold_left (fun acc ((table,_),_) -> table::acc) [t0] joins in + let env = {tables = env.tables @ all_tables} in + let (tables,params,joined_schema) = List.fold_left (do_join env) ([t0],p0,snd t0) joins in (* let joined_schema = tables |> List.map snd |> List.flatten in *) (tables,params,joined_schema) @@ -195,12 +206,13 @@ and ensure_simple_expr = function | Fun (x,l,`None) -> `Func (x,List.map ensure_simple_expr l) (* FIXME *) | Fun (_,_,_) -> failwith "not implemented : ensure_simple_expr with SELECT" -and eval_select { columns; from; where; group; having; } = +and eval_select env { columns; from; where; group; having; } = let (tbls,p2,joined_schema) = match from with - | Some (t,l) -> join (resolve_source t, List.map (fun (x,k) -> resolve_source x, k) l) + | Some (t,l) -> join env (resolve_source env t, List.map (fun (x,k) -> resolve_source env x, k) l) | None -> [], [], [] in + let tbls = env.tables @ tbls in let singlerow = group = [] && test_all_grouping columns in let singlerow2 = where = None && group = [] && test_all_const columns in let p1 = params_of_columns tbls joined_schema columns in @@ -211,18 +223,18 @@ and eval_select { columns; from; where; group; having; } = if singlerow2 then `Zero_one else `Nat in (infer_schema columns tbls joined_schema, p1 @ p2 @ p3 @ p4 @ p5, tbls, cardinality) -and resolve_source (x,alias) = +and resolve_source env (x,alias) = let src = match x with - | `Select select -> let (s,p,_,_) = eval_select select in ("",s), p + | `Select select -> let (s,p,_,_) = eval_select env select in ("",s), p | `Table s -> Tables.get s, [] in match alias with | Some name -> let ((_,s),p) = src in ((name,s),p) | None -> src -and eval_select_full (select,other,order,limit) = - let (s1,p1,tbls,cardinality) = eval_select select in - let (s2l,p2l) = List.split (List.map (fun (s,p,_,_) -> s,p) @@ List.map eval_select other) in +and eval_select_full env (select,other,order,limit) = + let (s1,p1,tbls,cardinality) = eval_select env select in + let (s2l,p2l) = List.split (List.map (fun (s,p,_,_) -> s,p) @@ List.map (eval_select env) other) in if false then eprintf "cardinality=%s other=%u\n%!" (Stmt.cardinality_to_string cardinality) @@ -238,13 +250,13 @@ and eval_select_full (select,other,order,limit) = else cardinality in final_schema,(p1@(List.flatten p2l)@p3@p4), Stmt.Select cardinality -and params_of_select s = +and params_of_select env s = let make = List.map (fun x -> `Param x) in match s with | `None -> [] - | `Select s -> let (_,p,_) = eval_select_full s in make p + | `Select s -> let (_,p,_) = eval_select_full env s in make p | `Single select -> - match eval_select_full select with + match eval_select_full env select with | [_],p,_ -> make p | s,_,_ -> raise (Schema.Error (s,"only one column allowed for SELECT operator in this expression")) @@ -262,7 +274,7 @@ let eval (stmt:Sql.stmt) = Tables.add (name,schema); ([],[],Create name) | Create (name,`Select select) -> - let (schema,params,_) = eval_select_full select in + let (schema,params,_) = eval_select_full empty_env select in Tables.add (name,schema); ([],params,Create name) | Alter (name,actions) -> @@ -292,7 +304,7 @@ let eval (stmt:Sql.stmt) = in [], params, Insert (inferred,table) | Insert (table,`Select (names, select)) -> - let (schema,params,_) = eval_select_full select in + let (schema,params,_) = eval_select_full empty_env select in let expect = values_or_all table names in ignore (Schema.compound expect schema); (* test equal types *) [], params, Insert (None,table) @@ -317,7 +329,7 @@ let eval (stmt:Sql.stmt) = let p3 = params_of_order o [] [Tables.get table] in [], params @ p3 @ lim, Update (Some table) | UpdateMulti (tables,ss,w) -> - let tables = List.map resolve_source tables in + let tables = List.map (resolve_source empty_env) tables in let params = update_tables tables ss w in [], params, Update None - | Select select -> eval_select_full select + | Select select -> eval_select_full empty_env select diff --git a/lib/tables.ml b/lib/tables.ml index b97f703..68a77ff 100644 --- a/lib/tables.ml +++ b/lib/tables.ml @@ -42,8 +42,9 @@ let alter_add name col pos = alter name (fun s -> Sql.Schema.add s col pos) let alter_drop name col = alter name (fun s -> Sql.Schema.drop s col) let alter_change name oldcol col pos = alter name (fun s -> Sql.Schema.change s oldcol col pos) -let print () = let out = IO.output_channel stdout in List.iter (Sql.print_table out) !all -let print1 name = Sql.print_table (IO.output_channel stdout) (get name) +let print ch tables = let out = IO.output_channel ch in List.iter (Sql.print_table out) tables; IO.flush out +let print_all () = print stdout !all +let print1 name = print stdout [get name] let reset () = all := [] diff --git a/src/cli.ml b/src/cli.ml index 0364fa7..5f6bbf5 100644 --- a/src/cli.ml +++ b/src/cli.ml @@ -73,7 +73,7 @@ let main () = "-params", Arg.String set_params_mode, "named|unnamed|oracle|postgresql|none Output query parameters substitution (default: none)"; "-debug", Arg.Int (fun x -> Sqlgg_config.debug_level := x), " set debug level"; "-no-header", Arg.Unit (fun () -> Sqlgg_config.gen_header := false), "do not put version header in generated output"; - "-show-tables", Arg.Unit Tables.print, " Show all current tables"; + "-show-tables", Arg.Unit Tables.print_all, " Show all current tables"; "-show-table", Arg.String Tables.print1, " Show specified table"; "-", Arg.Unit (fun () -> work "-"), " Read sql from stdin"; "-test", Arg.Unit Test.run, " Run unit tests"; @@ -88,10 +88,4 @@ let main () = else begin generate @@ List.concat @@ List.rev l; 0 end -let main () = - try - main () - with - exn -> Error.logs (Printexc.to_string exn); 2 - -let () = exit (main ()) +let () = exit @@ main () diff --git a/test/out/subquery.xml b/test/out/subquery.xml new file mode 100644 index 0000000..4b2b407 --- /dev/null +++ b/test/out/subquery.xml @@ -0,0 +1,19 @@ + + + + + + + + + + + + + + + + + + + diff --git a/test/subquery.sql b/test/subquery.sql new file mode 100644 index 0000000..6c3fb46 --- /dev/null +++ b/test/subquery.sql @@ -0,0 +1,19 @@ +CREATE TABLE IF NOT EXISTS `master` ( + `id` INTEGER PRIMARY KEY +); + +CREATE TABLE IF NOT EXISTS `detail` ( + `id` INTEGER PRIMARY KEY, + `master_id` INTEGER, + FOREIGN KEY (`master_id`) REFERENCES `master` (`id`) +); + +SELECT m.`id` m_id, d.`id` d_id +FROM `master` m +LEFT JOIN `detail` d ON d.`id` = ( + SELECT dd.`id` + FROM `detail` dd + WHERE dd.`master_id` = m.`id` + ORDER BY dd.`id` DESC + LIMIT 1 +); -- 2.11.4.GIT