Add export streaming functions.

Author: Drup

implem/tyxml_html.ml

@@ -24,3 +24,6 @@ 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

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.
 *)

implem/tyxml_svg.ml

@@ -25,3 +25,6 @@ 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

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.
 *)

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]

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} *)
 

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

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

lib/xml_stream.mli

@@ -29,7 +29,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