Skip to content

Commit

Permalink
Add Input stream functions.
Browse files Browse the repository at this point in the history
  • Loading branch information
Drup committed Oct 28, 2018
1 parent f3f86a8 commit 9e2dc1d
Show file tree
Hide file tree
Showing 8 changed files with 135 additions and 2 deletions.
1 change: 1 addition & 0 deletions implem/tyxml_xml.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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]
4 changes: 4 additions & 0 deletions implem/tyxml_xml.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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} *)

Expand Down
3 changes: 3 additions & 0 deletions lib/html_f.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
12 changes: 11 additions & 1 deletion lib/html_sigs.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
3 changes: 3 additions & 0 deletions lib/svg_f.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
12 changes: 11 additions & 1 deletion lib/svg_sigs.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
67 changes: 67 additions & 0 deletions lib/xml_stream.ml
Original file line number Diff line number Diff line change
@@ -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
35 changes: 35 additions & 0 deletions lib/xml_stream.mli
Original file line number Diff line number Diff line change
@@ -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

0 comments on commit 9e2dc1d

Please sign in to comment.