Skip to content

Commit ec4fa87

Browse files
DrupDrup
committed
Add export streaming functions.
1 parent 9e2dc1d commit ec4fa87

9 files changed

+110
-3
lines changed

‎implem/tyxml_html.ml

+3
Original file line numberDiff line numberDiff line change
@@ -24,3 +24,6 @@ module Make_printer = Xml_print.Make_typed(Tyxml_xml)(M)
2424

2525
include M
2626
include P
27+
28+
module E = Xml_stream.Typed_export(Tyxml_xml)(M)
29+
include E

‎implem/tyxml_html.mli

+8
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,14 @@ val pp_elt :
4343
?encode:(string -> string) -> ?indent:bool -> unit ->
4444
Format.formatter -> 'a elt -> unit
4545

46+
(** {2 Export} *)
47+
48+
(** [export l] converts the Tyxml elements [l] into a signal.
49+
This signal is roughtly compatible with libraries to manipulate HTML
50+
and SVG such as Markup and Lambdasoup.
51+
*)
52+
val export : 'a elt list -> Xml_stream.output Seq.t
53+
4654
(** Parametrized stream printer for Html documents.
4755
@deprecated Use {!pp} instead.
4856
*)

‎implem/tyxml_svg.ml

+3
Original file line numberDiff line numberDiff line change
@@ -25,3 +25,6 @@ module Make_printer = Xml_print.Make_typed(Tyxml_xml)(M)
2525

2626
include M
2727
include P
28+
29+
module E = Xml_stream.Typed_export(Tyxml_xml)(M)
30+
include E

‎implem/tyxml_svg.mli

+8
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,14 @@ val pp_elt :
4343
?encode:(string -> string) -> ?indent:bool -> unit ->
4444
Format.formatter -> 'a elt -> unit
4545

46+
(** {2 Export} *)
47+
48+
(** [export l] converts the Tyxml elements [l] into a signal.
49+
This signal is roughtly compatible with libraries to manipulate HTML
50+
and SVG such as Markup and Lambdasoup.
51+
*)
52+
val export : 'a elt list -> Xml_stream.output Seq.t
53+
4654
(** Parametrized stream printer for Svg documents.
4755
@deprecated Use {!pp} instead.
4856
*)

‎implem/tyxml_xml.ml

+4-1
Original file line numberDiff line numberDiff line change
@@ -112,8 +112,11 @@ include M
112112
include Xml_print.Make_simple(M)(struct let emptytags = [] end)
113113
[@@ocaml.warning "-3"]
114114

115-
include Xml_iter.Make(M)
115+
module Iter = Xml_iter.Make(M)
116+
include Iter
116117
include Xml_print.Make_fmt(M)(struct let emptytags = [] end)
117118

118119
include Xml_stream.Import(M)
120+
include Xml_stream.Export(struct include M include Iter end)
121+
119122
let print fmt x = print_list ~output:(Format.pp_print_string fmt) [x]

‎implem/tyxml_xml.mli

+2
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,8 @@ include Xml_sigs.Pp
3535

3636
val of_seq : Xml_stream.signal Seq.t -> elt list
3737

38+
val to_seq : ?namespace:ename -> elt -> Xml_stream.output Seq.t
39+
val to_seql : ?namespace:ename -> elt list -> Xml_stream.output Seq.t
3840

3941
(** {2 Iterators} *)
4042

‎lib/xml_sigs.mli

+2-1
Original file line numberDiff line numberDiff line change
@@ -119,12 +119,13 @@ end
119119

120120
module type Typed_xml = sig
121121

122-
module Xml : NoWrap
122+
module Xml : T
123123
module Info : Info
124124

125125
type 'a elt
126126
type doc
127127
val toelt : 'a elt -> Xml.elt
128+
val toeltl : ('a elt) Xml.list_wrap -> Xml.elt Xml.list_wrap
128129
val doc_toelt : doc -> Xml.elt
129130

130131
end

‎lib/xml_stream.ml

+56
Original file line numberDiff line numberDiff line change
@@ -65,3 +65,59 @@ module Import
6565
| _ -> raise Malformed_stream
6666

6767
end
68+
69+
(** Output *)
70+
71+
type output = [ signal | `Raw of string list ]
72+
73+
module Export
74+
(Xml : Xml_sigs.Iterable)
75+
= struct
76+
77+
let mk ~ns name = (ns, name)
78+
79+
let convert_attributes ~ns attributes =
80+
attributes |> List.map @@ fun attribute ->
81+
let value =
82+
match Xml.acontent attribute with
83+
| AFloat n -> Xml_print.string_of_number n
84+
| AInt n -> string_of_int n
85+
| AStr s -> s
86+
| AStrL (Space, ss) -> String.concat " " ss
87+
| AStrL (Comma, ss) -> String.concat ", " ss
88+
in
89+
(mk ~ns (Xml.aname attribute), value)
90+
91+
let (++) x l = Seq.Cons (x, l)
92+
let rec mk_elt ~ns x q () : output Seq.node =
93+
match Xml.content x with
94+
| Empty -> q ()
95+
| Comment s -> `Comment s ++ q
96+
| EncodedPCDATA s -> `Raw [s] ++ q
97+
| PCDATA s -> `Text [s] ++ q
98+
| Entity s -> `Raw ["&"^s^";"] ++ q
99+
| Leaf (name, attributes) ->
100+
`Start_element (mk ~ns name, convert_attributes ~ns attributes) ++
101+
fun () -> `End_element ++ q
102+
| Node (name, attributes, children) ->
103+
`Start_element (mk ~ns name, convert_attributes ~ns attributes) ++
104+
mk_list ~ns children q
105+
and mk_list ~ns l q () : output Seq.node =
106+
match l with
107+
| [] -> Seq.Nil
108+
| h :: t -> mk_elt ~ns h (mk_list ~ns t q) ()
109+
110+
let to_seq ?(namespace="") xml : output Seq.t =
111+
mk_elt ~ns:namespace xml Seq.empty
112+
let to_seql ?(namespace="") l : output Seq.t =
113+
mk_list ~ns:namespace l Seq.empty
114+
end
115+
116+
module Typed_export
117+
(Xml : Xml_sigs.Iterable)
118+
(Typed_xml : Xml_sigs.Typed_xml with module Xml := Xml)
119+
= struct
120+
module E = Export(Xml)
121+
let export l =
122+
E.to_seql ~namespace:Typed_xml.Info.namespace @@ Typed_xml.toeltl l
123+
end

‎lib/xml_stream.mli

+24-1
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,30 @@ type signal = [
2929
]
3030

3131
exception Malformed_stream
32-
32+
3333
module Import (Xml : Xml_sigs.T) : sig
3434
val of_seq : signal Seq.t -> Xml.elt Xml.list_wrap
3535
end
36+
37+
(** {2 Output} *)
38+
39+
type output = [ signal | `Raw of string list ]
40+
41+
module Typed_export
42+
(Xml : Xml_sigs.Iterable)
43+
(Typed_xml : Xml_sigs.Typed_xml with module Xml := Xml)
44+
: sig
45+
46+
(** [export l] converts the Tyxml elements [l] into a signal.
47+
This signal is roughtly compatible with libraries to manipulate HTML
48+
and SVG such as Markup and Lambdasoup.
49+
*)
50+
val export : 'a Typed_xml.elt list -> output Seq.t
51+
end
52+
53+
module Export
54+
(Xml : Xml_sigs.Iterable)
55+
: sig
56+
val to_seq : ?namespace:string -> Xml.elt -> output Seq.t
57+
val to_seql : ?namespace:string -> Xml.elt list -> output Seq.t
58+
end

0 commit comments

Comments
 (0)