From 3362a074c7dddf439ff878cf94d9169ab208eb10 Mon Sep 17 00:00:00 2001 From: Clombrong Date: Thu, 26 Jun 2025 16:59:26 +0200 Subject: refactor(xml): move get and next functions to Xml --- lib/xml.ml | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) (limited to 'lib/xml.ml') 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" 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)) -- cgit v1.2.3