diff --git a/implem/tyxml_html.ml b/implem/tyxml_html.ml
index 290fba8c2..f32b3abeb 100644
--- a/implem/tyxml_html.ml
+++ b/implem/tyxml_html.ml
@@ -25,5 +25,8 @@ module Make_printer = Xml_print.Make_typed(Tyxml_xml)(M)
include M
include P
+module E = Xml_stream.Typed_export(Tyxml_xml)(M)
+include E
+
let _pp = pp ()
let _pp_elt = pp_elt ()
diff --git a/implem/tyxml_html.mli b/implem/tyxml_html.mli
index 571fb684c..455f99df7 100644
--- a/implem/tyxml_html.mli
+++ b/implem/tyxml_html.mli
@@ -43,6 +43,14 @@ val pp_elt :
?encode:(string -> string) -> ?indent:bool -> unit ->
Format.formatter -> 'a elt -> unit
+(** {2 Export} *)
+
+(** [export l] converts the Tyxml elements [l] into a signal.
+ This signal is roughtly compatible with libraries to manipulate HTML
+ and SVG such as Markup and Lambdasoup.
+*)
+val export : 'a elt list -> Xml_stream.output Seq.t
+
(** Parametrized stream printer for Html documents.
@deprecated Use {!pp} instead.
*)
diff --git a/implem/tyxml_svg.ml b/implem/tyxml_svg.ml
index b9794fe4c..b1821e5a5 100644
--- a/implem/tyxml_svg.ml
+++ b/implem/tyxml_svg.ml
@@ -26,5 +26,8 @@ module Make_printer = Xml_print.Make_typed(Tyxml_xml)(M)
include M
include P
+module E = Xml_stream.Typed_export(Tyxml_xml)(M)
+include E
+
let _pp = pp ()
let _pp_elt = pp_elt ()
diff --git a/implem/tyxml_svg.mli b/implem/tyxml_svg.mli
index 1b3deeb9a..0376487fb 100644
--- a/implem/tyxml_svg.mli
+++ b/implem/tyxml_svg.mli
@@ -43,6 +43,14 @@ val pp_elt :
?encode:(string -> string) -> ?indent:bool -> unit ->
Format.formatter -> 'a elt -> unit
+(** {2 Export} *)
+
+(** [export l] converts the Tyxml elements [l] into a signal.
+ This signal is roughtly compatible with libraries to manipulate HTML
+ and SVG such as Markup and Lambdasoup.
+*)
+val export : 'a elt list -> Xml_stream.output Seq.t
+
(** Parametrized stream printer for Svg documents.
@deprecated Use {!pp} instead.
*)
diff --git a/implem/tyxml_xml.ml b/implem/tyxml_xml.ml
index 15c1029a8..13f4dd1e1 100644
--- a/implem/tyxml_xml.ml
+++ b/implem/tyxml_xml.ml
@@ -112,8 +112,11 @@ include M
include Xml_print.Make_simple(M)(struct let emptytags = [] end)
[@@ocaml.warning "-3"]
-include Xml_iter.Make(M)
+module Iter = Xml_iter.Make(M)
+include Iter
include Xml_print.Make_fmt(M)(struct let emptytags = [] end)
include Xml_stream.Import(M)
+include Xml_stream.Export(struct include M include Iter end)
+
let print fmt x = print_list ~output:(Format.pp_print_string fmt) [x]
diff --git a/implem/tyxml_xml.mli b/implem/tyxml_xml.mli
index f607a5b0e..0d2552cfe 100644
--- a/implem/tyxml_xml.mli
+++ b/implem/tyxml_xml.mli
@@ -35,6 +35,8 @@ include Xml_sigs.Pp
val of_seq : Xml_stream.signal Seq.t -> elt list
+val to_seq : ?namespace:ename -> elt -> Xml_stream.output Seq.t
+val to_seql : ?namespace:ename -> elt list -> Xml_stream.output Seq.t
(** {2 Iterators} *)
diff --git a/lib/xml_sigs.mli b/lib/xml_sigs.mli
index ba0de523b..20dcf5487 100644
--- a/lib/xml_sigs.mli
+++ b/lib/xml_sigs.mli
@@ -119,12 +119,13 @@ end
module type Typed_xml = sig
- module Xml : NoWrap
+ module Xml : T
module Info : Info
type 'a elt
type doc
val toelt : 'a elt -> Xml.elt
+ val toeltl : ('a elt) Xml.list_wrap -> Xml.elt Xml.list_wrap
val doc_toelt : doc -> Xml.elt
end
diff --git a/lib/xml_stream.ml b/lib/xml_stream.ml
index 45c20caab..06f188545 100644
--- a/lib/xml_stream.ml
+++ b/lib/xml_stream.ml
@@ -65,3 +65,59 @@ module Import
| _ -> raise Malformed_stream
end
+
+(** Output *)
+
+type output = [ signal | `Raw of string list ]
+
+module Export
+ (Xml : Xml_sigs.Iterable)
+= struct
+
+ let mk ~ns name = (ns, name)
+
+ let convert_attributes ~ns attributes =
+ attributes |> List.map @@ fun attribute ->
+ let value =
+ match Xml.acontent attribute with
+ | AFloat n -> Xml_print.string_of_number n
+ | AInt n -> string_of_int n
+ | AStr s -> s
+ | AStrL (Space, ss) -> String.concat " " ss
+ | AStrL (Comma, ss) -> String.concat ", " ss
+ in
+ (mk ~ns (Xml.aname attribute), value)
+
+ let (++) x l = Seq.Cons (x, l)
+ let rec mk_elt ~ns x q () : output Seq.node =
+ match Xml.content x with
+ | Empty -> q ()
+ | Comment s -> `Comment s ++ q
+ | EncodedPCDATA s -> `Raw [s] ++ q
+ | PCDATA s -> `Text [s] ++ q
+ | Entity s -> `Raw ["&"^s^";"] ++ q
+ | Leaf (name, attributes) ->
+ `Start_element (mk ~ns name, convert_attributes ~ns attributes) ++
+ fun () -> `End_element ++ q
+ | Node (name, attributes, children) ->
+ `Start_element (mk ~ns name, convert_attributes ~ns attributes) ++
+ mk_list ~ns children q
+ and mk_list ~ns l q () : output Seq.node =
+ match l with
+ | [] -> Seq.Nil
+ | h :: t -> mk_elt ~ns h (mk_list ~ns t q) ()
+
+ let to_seq ?(namespace="") xml : output Seq.t =
+ mk_elt ~ns:namespace xml Seq.empty
+ let to_seql ?(namespace="") l : output Seq.t =
+ mk_list ~ns:namespace l Seq.empty
+end
+
+module Typed_export
+ (Xml : Xml_sigs.Iterable)
+ (Typed_xml : Xml_sigs.Typed_xml with module Xml := Xml)
+= struct
+ module E = Export(Xml)
+ let export l =
+ E.to_seql ~namespace:Typed_xml.Info.namespace @@ Typed_xml.toeltl l
+end
diff --git a/lib/xml_stream.mli b/lib/xml_stream.mli
index c856c42f2..762ba597d 100644
--- a/lib/xml_stream.mli
+++ b/lib/xml_stream.mli
@@ -31,7 +31,30 @@ type signal = [
]
exception Malformed_stream
-
+
module Import (Xml : Xml_sigs.T) : sig
val of_seq : signal Seq.t -> Xml.elt Xml.list_wrap
end
+
+(** {2 Output} *)
+
+type output = [ signal | `Raw of string list ]
+
+module Typed_export
+ (Xml : Xml_sigs.Iterable)
+ (Typed_xml : Xml_sigs.Typed_xml with module Xml := Xml)
+ : sig
+
+ (** [export l] converts the Tyxml elements [l] into a signal.
+ This signal is roughtly compatible with libraries to manipulate HTML
+ and SVG such as Markup and Lambdasoup.
+ *)
+ val export : 'a Typed_xml.elt list -> output Seq.t
+ end
+
+module Export
+ (Xml : Xml_sigs.Iterable)
+ : sig
+ val to_seq : ?namespace:string -> Xml.elt -> output Seq.t
+ val to_seql : ?namespace:string -> Xml.elt list -> output Seq.t
+ end