Add Input stream functions.

Author: Drup

implem/tyxml_xml.ml

@@ -115,4 +115,5 @@ include Xml_print.Make_simple(M)(struct let emptytags = [] end)
 include Xml_iter.Make(M)
 include Xml_print.Make_fmt(M)(struct let emptytags = [] end)
 
+include Xml_stream.Import(M)
 let print fmt x = print_list ~output:(Format.pp_print_string fmt) [x]

implem/tyxml_xml.mli

@@ -31,6 +31,10 @@ include Xml_sigs.Iterable
 include Xml_sigs.Pp
   with type elt := elt
 
+(** {2 Import/Export} *)
+
+val of_seq : Xml_stream.signal Seq.t -> elt list
+
 
 (** {2 Iterators} *)
 

lib/html_f.ml

@@ -811,6 +811,9 @@ struct
   type doc  = [ `Html ] elt
   let doc_toelt x = x
 
+  module I = Xml_stream.Import(Xml)
+  let of_seq s = totl @@ I.of_seq s
+
   module Unsafe = struct
 
     let data s = Xml.encodedpcdata s

lib/html_sigs.mli

@@ -1053,7 +1053,17 @@ module type T = sig
 
   val ruby : ([< | ruby_attrib], [< | ruby_content_fun], [> | ruby]) star
 
-  (** {2 Conversion with untyped representation} *)
+  (** {2 Conversion with untyped representation} 
+
+      WARNING: These functions do not ensure HTML or SVG validity! You should
+      always explicitly given an appropriate type to the output.
+  *)
+
+  (** [import signal] converts the given XML signal into Tyxml elements.
+      It can be used with HTML and SVG parsing libraries, such as Markup.
+      @raise malformed_stream if the stream is malformed.
+  *)
+  val of_seq : Xml_stream.signal Seq.t -> 'a elt list_wrap
 
   val tot : Xml.elt -> 'a elt
   val totl : Xml.elt list_wrap -> 'a elt list_wrap

lib/svg_f.ml

@@ -894,6 +894,9 @@ struct
   type doc = [ `Svg ] elt
   let doc_toelt x = x
 
+  module I = Xml_stream.Import(Xml)
+  let of_seq s = totl @@ I.of_seq s
+
   module Unsafe = struct
 
     let data s = Xml.encodedpcdata s

lib/svg_sigs.mli

@@ -955,7 +955,17 @@ module type T = sig
     ?a: ((foreignobject_attr attrib) list) ->
     Xml.elt list_wrap -> [> | foreignobject] elt
 
-  (** {2 Conversion with untyped representation} *)
+  (** {2 Conversion with untyped representation} 
+
+      WARNING: These functions do not ensure HTML or SVG validity! You should
+      always explicitly given an appropriate type to the output.
+  *)
+
+  (** [import signal] converts the given XML signal into Tyxml elements.
+      It can be used with HTML and SVG parsing libraries, such as Markup.
+      @raise malformed_stream if the stream is malformed.
+  *)
+  val of_seq : Xml_stream.signal Seq.t -> 'a elt list_wrap
 
   val tot : Xml.elt -> 'a elt
   val totl : Xml.elt list_wrap -> ('a elt) list_wrap

lib/xml_stream.ml

@@ -0,0 +1,67 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2018 Gabriel Radanne
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+type name = string * string
+
+(** Input *)
+
+type signal = [
+  | `Comment of string
+  | `End_element
+  | `Start_element of name * (name * string) list
+  | `Text of string list
+]
+
+exception Malformed_stream
+
+module Import
+    (Xml : Xml_sigs.T)
+= struct
+
+  let of_list l =
+    List.fold_right
+      (fun a b -> Xml.W.(cons (return a) b))
+      l (Xml.W.nil ())
+
+  let mk_attribs attrs =
+    (* TODO: This is not very structured *)
+    let f ((_,name), v) = Xml.string_attrib name (Xml.W.return v) in
+    List.map f attrs
+
+  let rec mk children (seq : signal Seq.t) = match seq () with
+    | Cons (`Comment s, q) ->
+      mk (Xml.comment s :: children) q
+    | Cons (`Text s, q) ->
+      mk (List.map (fun x -> Xml.pcdata @@ Xml.W.return x) s @ children) q
+    | Cons (`Start_element ((_, name), attrs), q) ->
+      let a = mk_attribs attrs in
+      let sub_children, rest = mk [] q in
+      mk (Xml.node ~a name sub_children :: children) rest
+    | Cons (`End_element, rest) ->
+      of_list (List.rev children), rest
+    | Nil ->
+      of_list (List.rev children), Seq.empty
+
+  let of_seq seq =
+    let l, rest = mk [] seq in
+    match rest () with
+    | Seq.Nil -> l
+    | _ -> raise Malformed_stream
+
+end

lib/xml_stream.mli

@@ -0,0 +1,35 @@
+(* TyXML
+ * http://www.ocsigen.org/tyxml
+ * Copyright (C) 2018 Gabriel Radanne
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
+*)
+
+type name = string * string
+
+(** {2 Input} *)
+
+type signal = [
+  | `Comment of string
+  | `End_element
+  | `Start_element of name * (name * string) list
+  | `Text of string list
+]
+
+exception Malformed_stream
+  
+module Import (Xml : Xml_sigs.T) : sig
+  val of_seq : signal Seq.t -> Xml.elt Xml.list_wrap
+end

tyxml.opam

@@ -19,6 +19,7 @@ build: [
 
 depends: [
   "dune" {build}
+  "seq"
   "uutf" {>= "1.0.0"}
   "re" {>= "1.5.0"}
   "alcotest" {test}