Add a custom "Output_sink" module for emitting strings

OCaml doesn't have a good abstraction over writing text to generic
output (file, stdout, to memory). As a result, we often end up using
Format.formatter as an arbitrary output source.

This is fine in some use-cases. However, Format is designed around
pretty-printing values, rather than being high-performance. We see this
particularly when emitting HTML, with the format machinery contributing
a significant amount of time.

This change adds a new Output_sink module, which effectively exposes a
single "write" method. We switch the HTML module over to this.

This provides a significant performance boost. For a CC:T doc-gen this
reduces allocations and time taken by ~15%.

Author: SquidDev

src/bin/cli/dune

@@ -19,7 +19,6 @@
   illuaminate.lint
   illuaminate.config
   illuaminateConfigFormat
-  illuaminate.html
   illuaminate.minify
   illuaminate.pattern
   illuaminate.doc_emit

src/bin/cli/illuaminate_cli.ml

@@ -104,10 +104,7 @@ let doc_gen path =
   let to_abs path = Fpath.to_string (to_abs' path) in
 
   (* Write a HTML doc to a file. *)
-  let emit_doc node out =
-    let fmt = Format.formatter_of_out_channel out in
-    Html.Default.emit_doc fmt node; Format.pp_print_flush fmt ()
-  in
+  let emit_doc node out = Output_sink.with_output_stream out @@ fun out -> Html.emit_doc out node in
 
   (* Resolve the path to the logo, copying it into the output directory if needed. *)
   let resolve_logo ~data ~destination logo =
@@ -199,7 +196,7 @@ let doc_gen path =
        |> CCIO.with_out ~flags:[ Open_creat; Open_trunc; Open_binary ] (Fpath.to_string path) );
 
      let path = Fpath.(destination / "index.html") in
-     Option.fold ~none:Html.Default.nil ~some:(parse_index ~options:(options Fun.id)) index
+     Option.fold ~none:Html.nil ~some:(parse_index ~options:(options Fun.id)) index
      |> E.Html.emit_index ~options:(options Fun.id) ~pages
      |> emit_doc
      |> CCIO.with_out ~flags:[ Open_creat; Open_trunc; Open_binary ] (Fpath.to_string path);

src/doc_emit/dune

@@ -9,7 +9,6 @@
   illuaminate
   illuaminate.core
   illuaminate.data
-  illuaminate.html
   illuaminate.parser
   illuaminate.semantics
   markup

src/doc_emit/html_basic.ml

@@ -9,10 +9,11 @@ let reference_link ~options:{ resolve; _ } : Reference.resolved -> string option
   | External { url = None; _ } -> None
   | Unknown _ -> None
 
-let show_list ?(tag = "h3") ?(expandable = false) ?(expand = true) title = function
-  | [] -> Html.Default.nil
+let show_list ?(tag = "h3") ?(expandable = false) ?(expand = true) title =
+  let open Illuaminate.Html in
+  function
+  | [] -> nil
   | xs ->
-      let open Html.Default in
       [ create_node ~tag
           ~children:[ str title ]
           ~attributes:

src/doc_emit/html_highlight.ml

@@ -21,7 +21,7 @@ let transform_ref ~options ((r : M.Reference.t), t) =
   | _ -> None
 
 let emit ~options ~data ~input visit tree =
-  let open Html.Default in
+  let open Illuaminate.Html in
   (* TODO: Emit a true HTML node. Not sure how to do that elegantly though - we'd probably need to
      use a visitor within Emit instead. *)
   let res = Buffer.create (String.length input) in
@@ -49,7 +49,11 @@ let emit ~options ~data ~input visit tree =
                 in
                 ("title", desc) :: attrs
           in
-          Format.asprintf "<a%a>" Html.Emitters.attrs attrs
+          let module Sink = Illuaminate.Output_sink in
+          Sink.with_to_str @@ fun out ->
+          Sink.write out "<a";
+          Illuaminate.Html.emit_attrs out attrs;
+          Sink.write out ">"
       | None ->
           stack := false :: xs;
           ""
@@ -117,7 +121,7 @@ let do_lua ~options:({ Html_options.data; _ } as options) input =
   | Error _, (lazy (Ok tree)) ->
       let data = resolve tree in
       (emit ~options ~data ~input Emit.program tree, Some `Stmt)
-  | Error _, (lazy (Error _)) -> (Html.Default.str input, None)
+  | Error _, (lazy (Error _)) -> (Illuaminate.Html.str input, None)
 
 let lua ~options input = do_lua ~options input |> fst
 
@@ -129,6 +133,6 @@ let lua_block ?(attrs = []) ~options input =
     | Some `Expr -> Some "expr"
     | Some `Stmt -> Some "stmt"
   in
-  Html.Default.create_node ~tag:"pre"
+  Illuaminate.Html.create_node ~tag:"pre"
     ~attributes:(("class", Some "highlight") :: ("data-lua-kind", kind) :: attrs)
     ~children:[ highlighted ] ()

src/doc_emit/html_highlight.mli

@@ -1,5 +1,5 @@
 (** Highlight a Lua string, rendering it as HTML *)
-val lua : options:Html_options.t -> string -> Html.Default.node
+val lua : options:Html_options.t -> string -> Illuaminate.Html.node_
 
 val lua_block :
-  ?attrs:(string * string option) list -> options:Html_options.t -> string -> Html.Default.node
+  ?attrs:(string * string option) list -> options:Html_options.t -> string -> Illuaminate.Html.node_

src/doc_emit/html_loader.ml

@@ -1,5 +1,5 @@
 let load_file ~options path =
-  let open Html.Default in
+  let open Illuaminate.Html in
   match CCIO.File.read (Fpath.to_string path) with
   | Error msg ->
       Format.asprintf "Cannot open documentation index '%a' (%s)\n%!" Fpath.pp path msg

src/doc_emit/html_loader.mli

@@ -1,2 +1,2 @@
 (** Load a file, converting it to a HTML node depending on the file's type. *)
-val load_file : options:Html_options.t -> Fpath.t -> (Html.Default.node, string) result
+val load_file : options:Html_options.t -> Fpath.t -> (Illuaminate.Html.node_, string) result

src/doc_emit/html_main.re

@@ -1,4 +1,4 @@
-open Html.Default;
+open Illuaminate.Html;
 open Html_basic;
 open Html_md;
 open Html_value;

src/doc_emit/html_main.rei

@@ -7,10 +7,10 @@ type page_list :=
 
 /** Emit an index file from a list of page.  */
 let emit_index:
-  (~options: Html_options.t, ~pages: page_list, Html.Default.node) =>
-  Html.Default.node;
+  (~options: Html_options.t, ~pages: page_list, Illuaminate.Html.node_) =>
+  Illuaminate.Html.node_;
 
 /** Emit a single page. */
 let emit_page:
   (~options: Html_options.t, ~pages: page_list, documented(page)) =>
-  Html.Default.node;
+  Illuaminate.Html.node_;