html: ability to write a html document to an IO.Out_channel.t

This commit is contained in:
Simon Cruanes 2023-07-18 14:14:22 -04:00
parent 41be8908d3
commit 4a78eeb69c
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
2 changed files with 35 additions and 17 deletions

View file

@ -6,33 +6,50 @@
@since 0.12
*)
module IO = Tiny_httpd_io
include Tiny_httpd_html_
(** @inline *)
(** Write an HTML element to this out channel.
@param top if true, add DOCTYPE at the beginning. The top element should then
be a "html" tag.
@since NEXT_RELEASE
*)
let to_out_channel ?(top = false) (self : elt) (out : IO.Out_channel.t) : unit =
let out = Out.create_of_out out in
if top then Out.add_string out "<!DOCTYPE html>\n";
self out
(** Convert a HTML element to a string.
@param top if true, add DOCTYPE at the beginning. The top element should then
be a "html" tag. *)
let to_string ?(top = false) (self : elt) : string =
let out = Out.create () in
if top then Out.add_string out "<!DOCTYPE html>\n";
self out;
Out.to_string out
let to_string ?top (self : elt) : string =
let buf = Buffer.create 64 in
let out = IO.Out_channel.of_buffer buf in
to_out_channel ?top self out;
Buffer.contents buf
(** Convert a list of HTML elements to a string.
This is designed for fragments of HTML that are to be injected inside
a bigger context, as it's invalid to have multiple elements at the toplevel
of a HTML document. *)
let to_string_l (l : elt list) =
let out = Out.create () in
let buf = Buffer.create 64 in
let out = Out.create_of_buffer buf in
List.iter
(fun f ->
f out;
Out.add_format_nl out)
l;
Out.to_string out
Buffer.contents buf
let to_string_top = to_string ~top:true
(** Write a toplevel element to an output channel.
@since NEXT_RELEASE *)
let to_out_channel_top = to_out_channel ~top:true
(** Convert a HTML element to a stream. This might just convert
it to a string first, do not assume it to be more efficient. *)
let to_stream (self : elt) : Tiny_httpd_stream.t =

View file

@ -287,28 +287,29 @@ let prelude =
This output type is used to produce a string reasonably efficiently from
a tree of combinators.
{b NOTE}: this is experimental and an unstable API.
@since 0.12
@open *)
module Out : sig
type t
val create : unit -> t
val clear : t -> unit
val create_of_buffer : Buffer.t -> t
val create_of_out: Tiny_httpd_io.Out_channel.t -> t
val add_char : t -> char -> unit
val add_string : t -> string -> unit
val add_format_nl : t -> unit
val with_no_format_nl : t -> (unit -> 'a) -> 'a
val to_string : t -> string
end = struct
module IO = Tiny_httpd_io
type t = {
buf: Buffer.t;
mutable fmt_nl: bool; (* if true, we print \b around to format the html *)
out: IO.Out_channel.t;
mutable fmt_nl: bool; (* if true, we print [\n] around tags to format the html *)
}
let create () = {buf=Buffer.create 256; fmt_nl=true}
let clear self = Buffer.clear self.buf; self.fmt_nl <- true
let[@inline] add_char self c = Buffer.add_char self.buf c
let[@inline] add_string self s = Buffer.add_string self.buf s
let create_of_out out = {out; fmt_nl=true}
let create_of_buffer buf : t = create_of_out (IO.Out_channel.of_buffer buf)
let[@inline] add_char self c = IO.Out_channel.output_char self.out c
let[@inline] add_string self s = IO.Out_channel.output_string self.out s
let add_format_nl self = if self.fmt_nl then add_char self '\n'
let to_string self = add_format_nl self; Buffer.contents self.buf
let with_no_format_nl self f =
if self.fmt_nl then (
self.fmt_nl <- false;