9 let (inc_indent
,dec_indent
,make_indent
) =
11 (fun () -> v := !v + 2),
12 (fun () -> v := !v - 2),
13 (fun () -> String.make
!v ' '
)
15 let print_indent () = print_string
(make_indent
())
16 let indent s
= print_indent (); print_string s
17 let indent_endline s
= print_indent (); print_endline s
18 let output fmt
= kprintf
indent_endline fmt
19 let output_l = List.iter
indent_endline
20 let print fmt
= kprintf print_endline fmt
22 let name_of attr index
=
23 match attr
.RA.name
with
24 | "" -> sprintf
"_%u" index
27 let param_name_to_string id index
=
29 | Next
-> sprintf
"_%u" index
30 | Numbered x
-> sprintf
"_%u" x
33 let make_name props default
= Option.default default
(Props.get props
"name")
34 let default_name str index
= sprintf
"%s_%u" str index
36 let choose_name props kind index
=
37 let name = match kind
with
38 | Create t
-> sprintf
"create_%s" t
39 | Update t
-> sprintf
"update_%s_%u" t index
40 | Insert
(_
,t
) -> sprintf
"insert_%s_%u" t index
41 | Delete t
-> sprintf
"delete_%s_%u" t index
42 | Alter t
-> sprintf
"alter_%s_%u" t index
43 | Drop t
-> sprintf
"drop_%s" t
44 | Select
-> sprintf
"select_%u" index
49 let sql = Props.get stmt
.props
"sql" >> Option.get
in
52 | Insert
(true,_
) -> sql ^
" (" ^
(String.concat
"," (List.map
(fun _
-> "?") stmt
.params
)) ^
")"
55 module type Lang
= sig
57 val generate
: t
-> string -> Stmt.t
Enum.t
-> unit
59 val comment
: t
-> ('a
,unit,string,unit) format4
-> 'a
60 val empty_line
: t
-> unit
63 module Make
(S
: Lang
) = struct
66 let module U
= Unix
in
67 let t = U.time
() >> U.gmtime
in
68 sprintf
"%04u-%02u-%02uT%02u:%02uZ" (1900 + t.U.tm_year
) t.U.tm_mon
t.U.tm_mday
t.U.tm_hour
t.U.tm_min
70 let generate_header out
=
71 S.comment out
"DO NOT EDIT MANUALLY";
73 S.comment out
"generated by sqlgg %s on %s" Config.version
(time_string ());
74 S.comment out
"visit http://ygrek.org.ua/p/sqlgg/";
77 let process name stmts
=
78 let out = S.start
() in
80 S.generate
out name stmts