seppo/lib/xml.ml

open Astring

let ns_rdf        = "http://www.w3.org/1999/02/22-rdf-syntax-ns#"
let ns_xsd        = "http://www.w3.org/2001/XMLSchema"
(* and ns_sec         = As2_vocab.Constants.ActivityStreams.ns_sec ^ "#" *)
let ns_a          = "http://www.w3.org/2005/Atom" (* https://www.rfc-editor.org/rfc/rfc4287#section-2 *)
let ns_thr        = "http://purl.org/syndication/thread/1.0" (* https://www.rfc-editor.org/rfc/rfc4685#section-2 *)
let ns_seppo      = "http://seppo.social/2023/ns#"
let ns_backoffice = "http://seppo.social/2023/backoffice#"
let ns_rfc7033    = "urn:ietf:rfc:7033"
let ns_rfc7565    = "urn:ietf:rfc:7565"
let ns_as         = As2_vocab.Constants.ActivityStreams.ns_as
let ns_xhtml      = "http://www.w3.org/1999/xhtml"

(* for testing purpose only *)
let to_buf ?(xsl = None) ?(readme = None) ?(indent = None) (x : _ Xmlm.frag) (dst : Buffer.t) =
  let piw n v =
    (* TODO check syntax *)
    Printf.bprintf dst "<?%s %s?>\n" n v in
  piw "xml" "version=\"1.0\"";
  (match xsl with
   | Some v -> piw "xml-stylesheet" (Printf.sprintf "type='text/xsl' href='%s'" v)
   | None       -> ());
  (match readme with
   | Some v -> Printf.bprintf dst "<!--%s-->\n" v
   | None   -> ());
  let o = Xmlm.make_output ~decl:false ~indent (`Buffer dst) in
  Xmlm.output_doc_tree (fun x -> x) o (None,x)

let pi oc n l = 
  assert (String.exists (fun c -> c == '"')  n == false);
  let w = output_string oc in
  w "<?"; w n;
  l |> List.fold_left
    (fun _ (k,v) ->
       assert (String.exists (fun c -> c == '"')  v == false);
       w " "; w k; w "=\""; w v; w "\""
    ) ();
  w "?>\n"

let to_chan ?(xsl = None) ?(readme = None) ?(indent = None) (x : _ Xmlm.frag) dst =
  pi dst "xml" ["version","1.0"];
  (match xsl with
   | Some v -> pi dst "xml-stylesheet" ["type","text/xsl"; "href",v]
   | None       -> ());
  (match readme with
   | Some v -> Printf.fprintf dst "<!--%s-->\n" v
   | None   -> ());
  let o = Xmlm.make_output ~decl:false ~indent (`Channel dst) in
  Xmlm.output_doc_tree (fun x -> x) o (None,x)