open Lwt.Syntax
open Markup
open Xml

(** [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))