blob: dff9652a2fd73d4e97f435d733f861ce26e62c53 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
|
open Markup
type element = {
namespace : string;
local_name : string;
attributes : (string * string) list;
children : (element, string) Either.t list;
}
let tree s : element option =
(** [tree s] is an [element option] representing the XML element inside of stream [s],
if [s] is a complete element from start to end. *)
let element (namespace, name) attributes children =
Either.Left {
namespace;
local_name=name;
attributes=List.filter_map
(fun ((ns, name), content) ->
(* remove xmlns -- we don't need it. *)
match ns with
| "http://www.w3.org/2000/xmlns/" -> None
| _ -> Some (name, content))
attributes;
children;
}
and text ss = Either.Right (String.concat "" ss) in
let opt_el = tree ~text ~element s in
Option.bind opt_el (Either.fold ~left:Option.some ~right:(fun _ -> None))
let element_to_string ?(indent = 2) (el : element) =
(** [element_to_string element] is a string representation of the underlying XML in
[element], for debugging purposes.
Note this isn't serialization: namely, XML namespaces are inferred and don't exist
in the actual [element]. *)
let rec element_to_string parent {local_name; attributes; children; namespace} =
let attributes =
(if parent == namespace then "" else " xmlns=\"" ^ namespace ^ "\"") ^
String.concat ""
(List.map (fun (n, a) -> " " ^ n ^ "=\"" ^ a ^ "\"") attributes)
in
let tab s =
String.split_on_char '\n' s |> String.concat ("\n" ^ String.make indent ' ')
in
let tag = "\n<" ^ local_name ^ attributes
in tag ^ match children with
| [] -> "/>"
| _ -> ">" ^ (children
|> List.map
(Either.fold
~left:(element_to_string namespace)
~right:(fun x -> "\n" ^ x))
|> String.concat ""
|> tab)
^ "\n</" ^ local_name ^ ">"
in element_to_string "" el |> String.trim
|
