9 type subst_mode
= | Named
| Unnamed
11 (** defines substitution function for parameter literals *)
12 let params_mode = ref None
14 let (inc_indent
,dec_indent
,make_indent
) =
16 (fun () -> v := !v + 2),
17 (fun () -> v := !v - 2),
18 (fun () -> String.make
!v ' '
)
20 let print_indent () = print_string
(make_indent
())
21 let indent s
= print_indent (); print_string s
22 let indent_endline s
= print_indent (); print_endline s
23 let output fmt
= kprintf
indent_endline fmt
24 let output_l = List.iter
indent_endline
25 let print fmt
= kprintf print_endline fmt
27 let name_of attr index
=
28 match attr
.RA.name
with
29 | "" -> sprintf
"_%u" index
32 let param_name_to_string (name
,_
) index
=
34 | None
-> sprintf
"_%u" index
37 let make_name props default
= Option.default default
(Props.get props
"name")
38 let default_name str index
= sprintf
"%s_%u" str index
40 let choose_name props kind index
=
41 let name = match kind
with
42 | Create t
-> sprintf
"create_%s" t
43 | Update t
-> sprintf
"update_%s_%u" t index
44 | Insert
(_
,t
) -> sprintf
"insert_%s_%u" t index
45 | Delete t
-> sprintf
"delete_%s_%u" t index
46 | Alter t
-> sprintf
"alter_%s_%u" t index
47 | Drop t
-> sprintf
"drop_%s" t
48 | Select
-> sprintf
"select_%u" index
52 let substitute_params s params f
=
54 let b = Buffer.create
(String.length s
) in
55 let last = List.fold_left
(fun i
((_
,(i1
,i2
)),_
as param
) ->
56 let prefix = String.slice ~first
:i ~
last:i1 s
in
57 Buffer.add_string
b prefix;
58 Buffer.add_string
b (f
!index param
);
61 Buffer.add_string
b (String.slice ~first
:last s
);
64 let subst_named index (id
,_
) = "@" ^
(param_name_to_string id
index)
65 let subst_unnamed _ _
= "?"
68 let sql = Props.get stmt
.props
"sql" >> Option.get
in
69 match !params_mode with
72 let f = match subst
with Named
-> subst_named | Unnamed
-> subst_unnamed in
73 substitute_params sql stmt
.params
f
76 let module U
= Unix
in
77 let t = U.time
() >> U.gmtime
in
78 sprintf
"%04u-%02u-%02uT%02u:%02uZ" (1900 + t.U.tm_year
) (t.U.tm_mon
+1) t.U.tm_mday
t.U.tm_hour
t.U.tm_min
80 module type Lang
= sig
82 val generate
: t -> string -> Stmt.t Enum.t -> unit
84 val comment
: t -> ('a
,unit,string,unit) format4
-> 'a
85 val empty_line
: t -> unit
88 module Make
(S
: Lang
) = struct
90 let generate_header out
=
91 S.comment out
"DO NOT EDIT MANUALLY";
93 S.comment out
"generated by sqlgg %s on %s" Config.version
(time_string ());
94 S.comment out
"visit http://ygrek.org.ua/p/sqlgg/";
97 let process name stmts
=
98 let out = S.start
() in
100 S.generate
out name stmts