open Dbf_sql.SQL_db
open Dbf_sql
let print = fun tmpl__env tmpl__channel ->
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel "\n";
begin
let vtable = fst tmpl__env
and indexes = snd tmpl__env
in
let tables =
vtable.vt_ftable :: (List.map fst vtable.vt_join)
and vtable_name = vtable.vt_name
and table_name = fun t -> t.ta_name
and index_name = fun i -> i.idx_name
and column_name = fun c -> c.col_name
and vtable_sql = string_of_vtable vtable
in
let sql_columns =
Dbf_misc.join ~sep:", " ~to_string:(fun x -> x)
(List.flatten
(List.map (fun t -> List.map column_fullname t.ta_columns) tables))
in
let args_of_columns = fun columns ->
let print =
fun s1 s2 -> Printf.sprintf "~(%s : %s)" s1 s2
in
Dbf_misc.join
~sep:" "
~to_string:
(fun c -> print c.col_name c.col_ocaml_ty)
columns
in Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel "module VT_";
begin
let string = (vtable_name)
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel " = functor (Sql : Dbf_sql_driver.SqlDriver) ->\n";
Pervasives.output_string tmpl__channel "struct\n";
Pervasives.output_string tmpl__channel " ";
begin
List.iter
(fun table -> begin
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel " module T_";
begin
let string = (table_name table)
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel " = T_";
begin
let string = (table_name table)
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel " (Sql)\n";
Pervasives.output_string tmpl__channel " "; end)
tables
end;
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel " type t = {\n";
Pervasives.output_string tmpl__channel " ";
begin
List.iter
(fun table -> begin
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel " ";
begin
let string = (table_name table)
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel " : T_";
begin
let string = (table_name table)
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel ".";
begin
let string = (table_name table)
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel " ;\n";
Pervasives.output_string tmpl__channel " "; end)
tables
end;
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel " }\n";
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel " let row_as_record = fun row ->\n";
Pervasives.output_string tmpl__channel " let offset = ref 0 in\n";
Pervasives.output_string tmpl__channel " ";
begin
List.iter
(fun table -> begin
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel " let ";
begin
let string = (table_name table)
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel " =\n";
Pervasives.output_string tmpl__channel " T_";
begin
let string = (table_name table)
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel ".row_as_record ~offset:!offset row\n";
Pervasives.output_string tmpl__channel " in\n";
Pervasives.output_string tmpl__channel " offset := !offset + ";
begin
let string = (string_of_int (List.length table.ta_columns))
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel " ;\n";
Pervasives.output_string tmpl__channel " "; end)
tables
end;
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel " {";
begin
List.iter
(fun table -> begin
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel " ";
begin
let string = (table_name table)
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel " = ";
begin
let string = (table_name table)
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel " ;\n";
Pervasives.output_string tmpl__channel " "; end)
tables
end;
Pervasives.output_string tmpl__channel "}\n";
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel " let select_where = fun db condition ->\n";
Pervasives.output_string tmpl__channel " let query =\n";
Pervasives.output_string tmpl__channel " Printf.sprintf\n";
Pervasives.output_string tmpl__channel " \"SELECT ";
begin
let string = (sql_columns)
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel " FROM ";
begin
let string = (vtable_sql)
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel " %s\"\n";
Pervasives.output_string tmpl__channel " (match Dbf_sql_misc.no_blanks condition with\n";
Pervasives.output_string tmpl__channel " \"\" -> \"\"\n";
Pervasives.output_string tmpl__channel " | _ -> Printf.sprintf \"WHERE %s\" condition\n";
Pervasives.output_string tmpl__channel " )\n";
Pervasives.output_string tmpl__channel " in\n";
Pervasives.output_string tmpl__channel " Sql.exec db query\n";
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel " let fetch = fun result ->\n";
Pervasives.output_string tmpl__channel " match Sql.fetch_row result with\n";
Pervasives.output_string tmpl__channel " | None -> None\n";
Pervasives.output_string tmpl__channel " | Some (Sql.FR_Array row) -> Some (row_as_record row)\n";
Pervasives.output_string tmpl__channel " | _ -> Dbf_sql_misc.ie ()\n";
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel " let fetch_all = fun result ->\n";
Pervasives.output_string tmpl__channel " let to_array = function\n";
Pervasives.output_string tmpl__channel " | Sql.FR_Array a -> a\n";
Pervasives.output_string tmpl__channel " | _ -> Dbf_sql_misc.ie ()\n";
Pervasives.output_string tmpl__channel " in\n";
Pervasives.output_string tmpl__channel " Sql.map result ~f:(fun r -> row_as_record (to_array r))\n";
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel " ";
begin
List.iter
(fun idx -> begin
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel " ";
begin
let (in_idx, out_idx) =
List.partition
(fun c -> List.memq c idx.idx_columns)
(table_of_index idx).ta_columns
in Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel " module I_";
begin
let string = (index_name idx)
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel " =\n";
Pervasives.output_string tmpl__channel " struct\n";
Pervasives.output_string tmpl__channel " let condition_of_args = fun ";
begin
let string = (args_of_columns in_idx)
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel " ->\n";
Pervasives.output_string tmpl__channel " let columns =\n";
Pervasives.output_string tmpl__channel " [";
begin
List.iter
(fun c -> begin
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel " ((";
begin
let string = (c.col_ml2sql)
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel ") ";
begin
let string = (column_name c)
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel ",\n";
Pervasives.output_string tmpl__channel " \"";
begin
let string = (String.escaped (column_fullname c))
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel "\") ;\n";
Pervasives.output_string tmpl__channel " "; end)
in_idx
end;
Pervasives.output_string tmpl__channel "]\n";
Pervasives.output_string tmpl__channel " in\n";
Pervasives.output_string tmpl__channel " Dbf_sql_misc.join\n";
Pervasives.output_string tmpl__channel " ~sep:\" AND \"\n";
Pervasives.output_string tmpl__channel " ~to_string:\n";
Pervasives.output_string tmpl__channel " (fun (value, name) ->\n";
Pervasives.output_string tmpl__channel " Printf.sprintf \"%s = %s\" name (Sql.escape_value value))\n";
Pervasives.output_string tmpl__channel " columns\n";
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel " let search = fun db ";
begin
let string = (args_of_columns in_idx)
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel " ->\n";
Pervasives.output_string tmpl__channel " let condition =\n";
Pervasives.output_string tmpl__channel " (condition_of_args ";
begin
List.iter
(fun c -> begin
begin
let string = (column_name c)
in
Pervasives.output_string tmpl__channel string
end;
end)
in_idx
end;
Pervasives.output_string tmpl__channel ")\n";
Pervasives.output_string tmpl__channel " in\n";
Pervasives.output_string tmpl__channel " match select_where db condition with\n";
Pervasives.output_string tmpl__channel " | Sql.R_Fetch r -> fetch r\n";
Pervasives.output_string tmpl__channel " | _ -> None\n";
Pervasives.output_string tmpl__channel " end\n";
Pervasives.output_string tmpl__channel " ";
end;
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel " "; end)
indexes
end;
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel "end\n";
end;
Pervasives.output_string tmpl__channel "\n";