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 query = tmpl__env in
let state = query_state query in
let (return_types, params, qtree) =
match state with
Query_ok (t,l) ->
(t,l,Sqml.query_of_string query.qry_query)
| e ->
failwith (Printf.sprintf "query %s: %s"
query.qry_name
(string_of_query_state state)
)
in
let return_types =
let a = Array.mapi (fun i col -> (Printf.sprintf "ret%d" i, col))
(Array.of_list return_types)
in
Array.to_list a
in
let concr = Sqml_pp.make_pp_query qtree in
let pp_env = Hashtbl.create 13 in
let _ =
List.iter
(fun (name,colopt) ->
let s =
match colopt with
None -> name
| Some col ->
Printf.sprintf "(%s %s)"
col.col_ml2sql name
in
Hashtbl.add pp_env name
(Printf.sprintf "\"^(Sql.escape_value %s)^\"" s)
)
params
in Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel "let ";
begin
let string = (query.qry_name)
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel " = fun db\n";
Pervasives.output_string tmpl__channel " ";
begin
List.iter
(fun p -> begin
Pervasives.output_string tmpl__channel "~";
begin
let string = (fst p)
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel " "; end)
params
end;
Pervasives.output_string tmpl__channel " ->\n";
Pervasives.output_string tmpl__channel " let query =\n";
Pervasives.output_string tmpl__channel " \"";
begin
let string = (Dbf_misc.strip_string
(Sqml_pp.pp_concr ~escape_dblquotes: true 2 (Some pp_env) concr))
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel "\" in\n";
Pervasives.output_string tmpl__channel " match Sql.exec db query with\n";
Pervasives.output_string tmpl__channel " | Sql.R_Ok\n";
Pervasives.output_string tmpl__channel " | Sql.R_Empty -> []\n";
Pervasives.output_string tmpl__channel " | Sql.R_Fetch cursor ->\n";
Pervasives.output_string tmpl__channel "\tlet f = function\n";
Pervasives.output_string tmpl__channel "\t | [|";
begin
let string = (String.concat ";" (List.map fst return_types))
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel "|] ->\n";
Pervasives.output_string tmpl__channel "\t ";
begin
List.iter
(fun t -> begin
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel "\t ";
begin
let string = (let (name,colopt) = t in
match colopt with
None -> ""
| Some col ->
Printf.sprintf "let %s = %s in\n" name
(
if col.col_nullable then
Printf.sprintf "Dbf_sql_misc.apply_opt %s %s"
col.col_sql2ml
name
else
Printf.sprintf "%s (Dbf_sql_misc.unopt %s)"
col.col_sql2ml
name
)
)
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel "\t "; end)
return_types
end;
Pervasives.output_string tmpl__channel "\n";
Pervasives.output_string tmpl__channel "\t (";
begin
let string = (String.concat "," (List.map fst return_types))
in
Pervasives.output_string tmpl__channel string
end;
Pervasives.output_string tmpl__channel ")\n";
Pervasives.output_string tmpl__channel "\t | _ -> assert false\n";
Pervasives.output_string tmpl__channel "\tin\n";
Pervasives.output_string tmpl__channel "\tlet 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 "\tin\n";
Pervasives.output_string tmpl__channel "\tSql.map cursor ~f: (fun r -> f (to_array r))\n";
end;
Pervasives.output_string tmpl__channel "\n";