10 type xml
= | Node
of (string * (string * string) list
* xml list
)
14 let b = Buffer.create
10 in
15 let add s
= Buffer.add_string
b s
in
19 | '\n' -> add "

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