My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1type dtd = string option
2
3module Error = Syndic_error
4
5type pos = Xmlm.pos
6type tag = Xmlm.tag
7type t = Node of pos * tag * t list | Data of pos * string
8
9let resolve ~xmlbase uri =
10 match xmlbase with None -> uri | Some b -> Uri.resolve "" b uri
11
12(* Specialized version of the Xmlm.make_input one. *)
13let input_of_channel fh =
14 (* Xmlm.make_input does not raise any exception. *)
15 Xmlm.make_input (`Channel fh)
16
17let of_xmlm input =
18 let el tag datas = Node (Xmlm.pos input, tag, datas) in
19 let data data = Data (Xmlm.pos input, data) in
20 try Xmlm.input_doc_tree ~el ~data input with Xmlm.Error (pos, e) ->
21 raise (Error.Error (pos, Xmlm.error_message e))
22
23let get_position = function Node (pos, _, _) -> pos | Data (pos, _) -> pos
24
25let rec t_to_xmlm t output =
26 match t with
27 | Data (_pos, d) -> (
28 try Xmlm.output output (`Data d) with Xmlm.Error (pos, e) ->
29 raise (Error.Error (pos, Xmlm.error_message e)) )
30 | Node (_pos, tag, t_sub) -> (
31 Xmlm.output output (`El_start tag) ;
32 List.iter (fun t -> t_to_xmlm t output) t_sub ;
33 try Xmlm.output output `El_end with Xmlm.Error (pos, e) ->
34 raise (Error.Error (pos, Xmlm.error_message e)) )
35
36(* Specialized version of the Xmlm one. *)
37let make_output ?ns_prefix dest =
38 (* Xmlm.make_output does not raise any exception. *)
39 Xmlm.make_output dest ~decl:true ?ns_prefix
40
41let to_xmlm ?dtd t output =
42 ( try Xmlm.output output (`Dtd dtd) with Xmlm.Error (pos, e) ->
43 raise (Error.Error (pos, Xmlm.error_message e)) ) ;
44 t_to_xmlm t output
45
46let to_buffer ?ns_prefix t b =
47 let output = Xmlm.make_output ~decl:false (`Buffer b) ?ns_prefix in
48 to_xmlm t output
49
50let to_string ?ns_prefix t =
51 let b = Buffer.create 4096 in
52 to_buffer ?ns_prefix t b ; Buffer.contents b