diff options
Diffstat (limited to 'lib/xml.ml')
-rw-r--r-- | lib/xml.ml | 19 |
1 files changed, 19 insertions, 0 deletions
@@ -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)) |