simon/tiny_httpd
1
0
Fork 0
mirror of https://github.com/c-cube/tiny_httpd.git synced 2025-12-06 11:15:35 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

31
src/Tiny_httpd_html.ml
View file

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

21
src/gen/gentags.ml
View file

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