12 type xml
= | Node
of (string * (string * string) list
* xml list
)
16 let b = Buffer.create
10 in
17 let add s
= Buffer.add_string
b s
in
21 | '\n' -> add "

;"
25 | c -> Buffer.add_char b c) s;
28 let xml_to_string xml =
29 let b = Buffer.create 1000 in
30 let rec iter spaces = function
31 | Node (name,attrs,children) ->
32 bprintf b "\n%s
<%s
" spaces name;
33 List.iter (fun (n,v) -> bprintf b " %s
=\"%s
\"" n (xml_escape v)) attrs;
34 begin match children with
35 | [] -> bprintf b "/>"
36 | _ -> bprintf b ">"; List.iter (iter (spaces ^ " ")) children; bprintf b "\n%s
</%s
>" spaces name
38 | Comment text -> bprintf b "\n<!-- %s
-->" (Gen_caml.replace_all ~str:text ~sub:"--" ~by:"&mdash
;")
45 Node ("test
",["name
","d
\"s
"
;ds
"],[]) >> xml_to_string >> print_endline
48 let comment (x,_) fmt = Printf.ksprintf (fun s -> x := Comment s :: !x) fmt
51 let value n t = Node ("value",["name
",n; "type",t;],[])
56 let params_to_values = List.map (fun (n,t) -> value n t) & all_params_to_values
57 let schema_to_values = List.map (fun (n,t) -> value n t) & schema_to_values
59 type t = xml list ref * xml list ref
61 let start () = ref [], ref []
63 let generate_code (x,_) index stmt =
64 let name = choose_name stmt.props stmt.kind index in
65 let input = Node ("in",[],params_to_values stmt.params) in
66 let output = Node ("out
",[],schema_to_values stmt.schema) in
67 let sql = get_sql stmt in
68 x := Node ("stmt
",["name",name; "sql",sql;],[input; output]) :: !x
70 let start_output (x,pre) = pre := !x; x := []
72 let finish_output (x,pre) =
73 print_endline "<?xml version
=\"1.0\"?
>";
74 List.iter (fun z -> z >> xml_to_string >> print_endline) (List.rev !pre);
75 Node ("sqlgg
",[],List.rev !x) >> xml_to_string >> print_endline;
79 let generate out name stmts =
81 Enum.iteri (generate_code out) stmts;