aboutsummaryrefslogtreecommitdiff
path: root/lib/xml.ml
diff options
context:
space:
mode:
Diffstat (limited to 'lib/xml.ml')
-rw-r--r--lib/xml.ml19
1 files changed, 19 insertions, 0 deletions
diff --git a/lib/xml.ml b/lib/xml.ml
index 99a388f..25332a5 100644
--- a/lib/xml.ml
+++ b/lib/xml.ml
@@ -1,3 +1,4 @@
+open Lwt.Syntax
open Markup
exception InvalidStanza of string
@@ -56,3 +57,21 @@ let element_to_string ?(indent = 2) (el : element) =
|> tab)
^ "\n</" ^ local_name ^ ">"
in element_to_string "" el |> String.trim
+
+(** [next stream] is a promise containing a full stanza of the fragments of
+ [stream]. *)
+let next (stream : (signal, async) stream) : (signal, sync) stream Lwt.t =
+ let traverse_stanza depth fragment =
+ let depth = match fragment with
+ | `Start_element _ -> depth + 1
+ | `End_element -> depth - 1
+ | _ -> depth
+ in ([fragment], if depth = 0 then None else Some depth)
+ in transform traverse_stanza 0 stream |> Markup_lwt.load
+
+(** [get stream] is a promise containing a single Xml element of [stream]. *)
+let get (stream : (signal, async) stream) : element Lwt.t =
+ let* signal = next stream
+ in match tree signal with
+ | Some xml -> Lwt.return xml
+ | None -> Lwt.fail (InvalidStanza (signal |> write_xml |> to_string))