mirror of
https://github.com/c-cube/tiny_httpd.git
synced 2025-12-05 19:00:32 -05:00
change api for Html.nary'; better newlines in output
This commit is contained in:
Simon Cruanes
parent
030d71ad72
commit
4aba0654b0
6 changed files with 102 additions and 177 deletions
|
|
@ -104,63 +104,64 @@ let html_list_dir (module VFS:VFS) ~prefix ~parent d : Html.elt =
|
|||
Array.sort String.compare entries;
|
||||
let open Html in
|
||||
|
||||
html'[] @@ fun out ->
|
||||
|
||||
(* TODO: breadcrumbs for the path, each element a link to the given ancestor dir *)
|
||||
out @< head[][
|
||||
title[][txtf "list directory %S" VFS.descr];
|
||||
meta[A.charset "utf-8"];
|
||||
];
|
||||
|
||||
out @< body'[] @@ fun out ->
|
||||
out @< h2[][txtf "Index of %S" d];
|
||||
begin match parent with
|
||||
| None -> ()
|
||||
| Some p ->
|
||||
out @< a[A.href (encode_path ("/" // prefix // p))][txt"(parent directory)"];
|
||||
end;
|
||||
|
||||
out @< ul'[] @@ fun out ->
|
||||
let head =
|
||||
head[][
|
||||
title[][txtf "list directory %S" VFS.descr];
|
||||
meta[A.charset "utf-8"];
|
||||
] in
|
||||
|
||||
let n_hidden = ref 0 in
|
||||
Array.iter (fun f -> if is_hidden f then incr n_hidden) entries;
|
||||
|
||||
let emit_file f out : unit =
|
||||
let file_to_elt f : elt option =
|
||||
if not @@ contains_dot_dot (d // f) then (
|
||||
let fpath = d // f in
|
||||
if not @@ VFS.contains fpath then (
|
||||
out @< li[][txtf "%s [invalid file]" f];
|
||||
Some (li[][txtf "%s [invalid file]" f])
|
||||
) else (
|
||||
let size =
|
||||
match VFS.file_size fpath with
|
||||
| Some f -> Printf.sprintf " (%s)" @@ human_size f
|
||||
| None -> ""
|
||||
in
|
||||
out @< li'[] @@ fun out ->
|
||||
out @< a[A.href ("/" // prefix // fpath)][txt f];
|
||||
if VFS.is_directory fpath then out @< txt"[dir]";
|
||||
out @< txt size;
|
||||
);
|
||||
)
|
||||
Some (li'[] [
|
||||
sub_e @@ a[A.href ("/" // prefix // fpath)][txt f];
|
||||
(if VFS.is_directory fpath then sub_e @@ txt "[dir]" else sub_empty);
|
||||
sub_e @@ txt size;
|
||||
])
|
||||
)
|
||||
) else None
|
||||
in
|
||||
|
||||
if !n_hidden>0 then (
|
||||
out @< details'[] @@ fun out ->
|
||||
out @< summary[][txtf "(%d hidden files)" !n_hidden];
|
||||
let body = body'[] [
|
||||
sub_e @@ h2[][txtf "Index of %S" d];
|
||||
begin match parent with
|
||||
| None -> sub_empty
|
||||
| Some p ->
|
||||
sub_e @@
|
||||
a[A.href (encode_path ("/" // prefix // p))][txt"(parent directory)"]
|
||||
end;
|
||||
|
||||
Array.iter
|
||||
(fun f ->
|
||||
if is_hidden f then (
|
||||
emit_file f out;
|
||||
))
|
||||
entries;
|
||||
);
|
||||
|
||||
Array.iter
|
||||
(fun f ->
|
||||
if not @@ is_hidden f then emit_file f out)
|
||||
entries;
|
||||
()
|
||||
sub_e @@ ul' [] [
|
||||
if !n_hidden>0 then
|
||||
sub_e @@ details'[][
|
||||
sub_e @@ summary[][txtf "(%d hidden files)" !n_hidden];
|
||||
sub_seq (
|
||||
seq_of_array entries
|
||||
|> Seq.filter_map
|
||||
(fun f -> if is_hidden f then file_to_elt f else None)
|
||||
);
|
||||
] else sub_empty;
|
||||
sub_seq (
|
||||
seq_of_array entries
|
||||
|> Seq.filter_map (fun f ->
|
||||
if not (is_hidden f) then file_to_elt f else None)
|
||||
)
|
||||
];
|
||||
]
|
||||
in
|
||||
html [][head; body]
|
||||
|
||||
let finally_ ~h x f =
|
||||
try
|
||||
|
|
|
|||
|
|
@ -303,8 +303,8 @@ end = struct
|
|||
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 to_string self = Buffer.contents self.buf
|
||||
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;
|
||||
|
|
@ -326,11 +326,13 @@ type nary = ?if_:bool -> attribute list -> elt list -> elt
|
|||
(** Element with children, represented as a list.
|
||||
@param if_ if false, do not print anything (default true) *)
|
||||
|
||||
type nary' = ?if_:bool -> attribute list -> (Out.t -> unit) -> elt
|
||||
(** Element with children, represented as a continuation.
|
||||
@param if_ if false, do not print anything (default true) *)
|
||||
(** A chunk of sub-elements, possibly empty.
|
||||
@inline *)
|
||||
type sub_elt = [ `E of elt | `L of elt list | `S of elt Seq.t | `Nil]
|
||||
|
||||
let (@<) (out:Out.t) (elt:elt) : unit = elt out
|
||||
type nary' = ?if_:bool -> attribute list -> sub_elt list -> elt
|
||||
(** Element with children, represented as a list of {!sub_elt} to be flattened
|
||||
@param if_ if false, do not print anything (default true) *)
|
||||
|
||||
(** Escape string so it can be safely embedded in HTML text. *)
|
||||
let _str_escape (out:Out.t) (s:string) : unit =
|
||||
|
|
@ -350,7 +352,7 @@ let _attr_escape (out:Out.t) (s:string) =
|
|||
Out.add_char out '"'
|
||||
|
||||
(** Output a list of attributes. *)
|
||||
let _write_attrs (out:Out.t ) (l:attribute list) : unit =
|
||||
let _write_attrs (out:Out.t) (l:attribute list) : unit =
|
||||
List.iter
|
||||
(fun (k,v) ->
|
||||
Out.add_char out ' ';
|
||||
|
|
@ -359,6 +361,20 @@ let _write_attrs (out:Out.t ) (l:attribute list) : unit =
|
|||
_attr_escape out v)
|
||||
l
|
||||
|
||||
(** Write sub-elements of a {!nary'} element, returns [true] iff
|
||||
at least one sub-element was written. *)
|
||||
let _write_subs (out:Out.t) (l:sub_elt list) : bool =
|
||||
let has_sub = ref false in
|
||||
let prepend_white () = has_sub := true; Out.add_format_nl out; in
|
||||
let emit1 = function
|
||||
| `E x -> prepend_white(); x out
|
||||
| `L l -> List.iter (fun e -> prepend_white(); e out) l
|
||||
| `S l -> Seq.iter (fun e -> prepend_white(); e out) l
|
||||
| `Nil -> ()
|
||||
in
|
||||
List.iter emit1 l;
|
||||
!has_sub
|
||||
|
||||
(** Write a tag, with its attributes.
|
||||
@param void if true, end with "/>", otherwise end with ">" *)
|
||||
let _write_tag_attrs ~void (out:Out.t) (tag:string) (attrs:attribute list) : unit =
|
||||
|
|
@ -367,6 +383,20 @@ let _write_tag_attrs ~void (out:Out.t) (tag:string) (attrs:attribute list) : uni
|
|||
_write_attrs out attrs;
|
||||
if void then Out.add_string out "/>" else Out.add_string out ">"
|
||||
|
||||
let[@inline] sub_e (elt:elt) : sub_elt = `E elt
|
||||
|
||||
let[@inline] sub_l (l:elt list) : sub_elt = `L l
|
||||
|
||||
let[@inline] sub_seq (l:elt Seq.t) : sub_elt = `S l
|
||||
|
||||
let seq_of_array (a:_ array) : _ Seq.t =
|
||||
let rec loop i () =
|
||||
if i=Array.length a then Seq.Nil
|
||||
else Seq.Cons (a.(i), loop (i+1))
|
||||
in loop 0
|
||||
|
||||
let sub_empty : sub_elt = `Nil
|
||||
|
||||
(** Emit a string value, which will be escaped. *)
|
||||
let txt (txt:string) : elt = fun out -> _str_escape out txt
|
||||
|
||||
|
|
@ -411,24 +441,22 @@ let emit_normal name =
|
|||
(* for <pre>, newlines actually matter *)
|
||||
if name="pre" then pf " Out.with_no_format_nl out @@ fun () ->\n";
|
||||
pf " _write_tag_attrs ~void:false out %S attrs;\n" name;
|
||||
pf " Out.add_format_nl out;\n";
|
||||
pf " List.iter (fun sub -> sub out; Out.add_format_nl out) sub;\n";
|
||||
pf " Out.add_string out \"</%s>\";" name;
|
||||
pf " Out.add_format_nl out)\n";
|
||||
pf " List.iter (fun sub -> Out.add_format_nl out; sub out) sub;\n";
|
||||
pf " if sub <> [] then Out.add_format_nl out;\n";
|
||||
pf " Out.add_string out \"</%s>\")" name;
|
||||
pf "\n\n";
|
||||
|
||||
(* block version *)
|
||||
let oname = oname ^ "'" in
|
||||
pf "(** tag %S, see {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/%s} mdn} *)\n"
|
||||
name name;
|
||||
pf "let %s : nary' = fun ?(if_=true) attrs f out ->\n" oname;
|
||||
pf "let %s : nary' = fun ?(if_=true) attrs l out ->\n" oname;
|
||||
pf " if if_ then (\n";
|
||||
if name="pre" then pf " Out.with_no_format_nl out @@ fun () ->\n";
|
||||
pf " _write_tag_attrs ~void:false out %S attrs;\n" name;
|
||||
pf " Out.add_format_nl out;\n";
|
||||
pf " f out;\n";
|
||||
pf " Out.add_string out \"</%s>\";" name;
|
||||
pf " Out.add_format_nl out)\n";
|
||||
pf " let has_sub = _write_subs out l in\n";
|
||||
pf " if has_sub then Out.add_format_nl out;\n";
|
||||
pf " Out.add_string out \"</%s>\")" name;
|
||||
pf "\n\n";
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -13,7 +13,6 @@ echo:
|
|||
<title>
|
||||
list directory "Embedded_fs"
|
||||
</title>
|
||||
|
||||
<meta charset="utf-8"/>
|
||||
</head>
|
||||
<body>
|
||||
|
|
@ -25,27 +24,33 @@ Index of ""
|
|||
<a href="/vfs/a.txt">
|
||||
a.txt
|
||||
</a>
|
||||
(12b)</li>
|
||||
(12b)
|
||||
</li>
|
||||
<li>
|
||||
<a href="/vfs/example_dot_com">
|
||||
example_dot_com
|
||||
</a>
|
||||
(1.12k)</li>
|
||||
(1.12k)
|
||||
</li>
|
||||
<li>
|
||||
<a href="/vfs/foo.html">
|
||||
foo.html
|
||||
</a>
|
||||
(214b)</li>
|
||||
(214b)
|
||||
</li>
|
||||
<li>
|
||||
<a href="/vfs/sub">
|
||||
sub
|
||||
</a>
|
||||
[dir]</li>
|
||||
[dir]
|
||||
|
||||
</li>
|
||||
<li>
|
||||
<a href="/vfs/test_out.txt">
|
||||
test_out.txt
|
||||
</a>
|
||||
(209b)</li>
|
||||
(209b)
|
||||
</li>
|
||||
</ul>
|
||||
</body>
|
||||
</html>
|
||||
|
|
|
|||
|
|
@ -18,11 +18,10 @@ let t2() =
|
|||
head [] [];
|
||||
pre [] [txt "a"; txt "b"];
|
||||
body [] [
|
||||
ul' [A.style "list-style: circle"] (fun out ->
|
||||
for i=0 to 99 do
|
||||
li ~if_:(i<> 42) [A.id (spf "l%d" i)] [txt (spf "item %d" i)] out
|
||||
done
|
||||
)
|
||||
ul' [A.style "list-style: circle"] [
|
||||
sub_l @@ List.init 100 @@ fun i ->
|
||||
li ~if_:(i<> 42) [A.id (spf "l%d" i)] [txt (spf "item %d" i)]
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
|
|
|
|||
|
|
@ -1,417 +1,312 @@
|
|||
<!DOCTYPE html>
|
||||
<html>
|
||||
<head>
|
||||
</head>
|
||||
|
||||
<head></head>
|
||||
<body>
|
||||
<ul style="list-style: circle">
|
||||
<li>
|
||||
<pre>a<pre>cd</pre>b</pre>
|
||||
</li>
|
||||
|
||||
<li id="l0">
|
||||
item 0
|
||||
</li>
|
||||
|
||||
<li id="l1">
|
||||
item 1
|
||||
</li>
|
||||
|
||||
<li id="l2">
|
||||
item 2
|
||||
</li>
|
||||
|
||||
<li id="l3">
|
||||
item 3
|
||||
</li>
|
||||
|
||||
<li id="l4">
|
||||
item 4
|
||||
</li>
|
||||
|
||||
<li id="l5">
|
||||
item 5
|
||||
</li>
|
||||
|
||||
<li id="l6">
|
||||
item 6
|
||||
</li>
|
||||
|
||||
<li id="l7">
|
||||
item 7
|
||||
</li>
|
||||
|
||||
<li id="l8">
|
||||
item 8
|
||||
</li>
|
||||
|
||||
<li id="l9">
|
||||
item 9
|
||||
</li>
|
||||
|
||||
<li id="l10">
|
||||
item 10
|
||||
</li>
|
||||
|
||||
<li id="l11">
|
||||
item 11
|
||||
</li>
|
||||
|
||||
<li id="l12">
|
||||
item 12
|
||||
</li>
|
||||
|
||||
<li id="l13">
|
||||
item 13
|
||||
</li>
|
||||
|
||||
<li id="l14">
|
||||
item 14
|
||||
</li>
|
||||
|
||||
<li id="l15">
|
||||
item 15
|
||||
</li>
|
||||
|
||||
<li id="l16">
|
||||
item 16
|
||||
</li>
|
||||
|
||||
<li id="l17">
|
||||
item 17
|
||||
</li>
|
||||
|
||||
<li id="l18">
|
||||
item 18
|
||||
</li>
|
||||
|
||||
<li id="l19">
|
||||
item 19
|
||||
</li>
|
||||
|
||||
<li id="l20">
|
||||
item 20
|
||||
</li>
|
||||
|
||||
<li id="l21">
|
||||
item 21
|
||||
</li>
|
||||
|
||||
<li id="l22">
|
||||
item 22
|
||||
</li>
|
||||
|
||||
<li id="l23">
|
||||
item 23
|
||||
</li>
|
||||
|
||||
<li id="l24">
|
||||
item 24
|
||||
</li>
|
||||
|
||||
<li id="l25">
|
||||
item 25
|
||||
</li>
|
||||
|
||||
<li id="l26">
|
||||
item 26
|
||||
</li>
|
||||
|
||||
<li id="l27">
|
||||
item 27
|
||||
</li>
|
||||
|
||||
<li id="l28">
|
||||
item 28
|
||||
</li>
|
||||
|
||||
<li id="l29">
|
||||
item 29
|
||||
</li>
|
||||
|
||||
<li id="l30">
|
||||
item 30
|
||||
</li>
|
||||
|
||||
<li id="l31">
|
||||
item 31
|
||||
</li>
|
||||
|
||||
<li id="l32">
|
||||
item 32
|
||||
</li>
|
||||
|
||||
<li id="l33">
|
||||
item 33
|
||||
</li>
|
||||
|
||||
<li id="l34">
|
||||
item 34
|
||||
</li>
|
||||
|
||||
<li id="l35">
|
||||
item 35
|
||||
</li>
|
||||
|
||||
<li id="l36">
|
||||
item 36
|
||||
</li>
|
||||
|
||||
<li id="l37">
|
||||
item 37
|
||||
</li>
|
||||
|
||||
<li id="l38">
|
||||
item 38
|
||||
</li>
|
||||
|
||||
<li id="l39">
|
||||
item 39
|
||||
</li>
|
||||
|
||||
<li id="l40">
|
||||
item 40
|
||||
</li>
|
||||
|
||||
<li id="l41">
|
||||
item 41
|
||||
</li>
|
||||
|
||||
<li id="l42">
|
||||
item 42
|
||||
</li>
|
||||
|
||||
<li id="l43">
|
||||
item 43
|
||||
</li>
|
||||
|
||||
<li id="l44">
|
||||
item 44
|
||||
</li>
|
||||
|
||||
<li id="l45">
|
||||
item 45
|
||||
</li>
|
||||
|
||||
<li id="l46">
|
||||
item 46
|
||||
</li>
|
||||
|
||||
<li id="l47">
|
||||
item 47
|
||||
</li>
|
||||
|
||||
<li id="l48">
|
||||
item 48
|
||||
</li>
|
||||
|
||||
<li id="l49">
|
||||
item 49
|
||||
</li>
|
||||
|
||||
<li id="l50">
|
||||
item 50
|
||||
</li>
|
||||
|
||||
<li id="l51">
|
||||
item 51
|
||||
</li>
|
||||
|
||||
<li id="l52">
|
||||
item 52
|
||||
</li>
|
||||
|
||||
<li id="l53">
|
||||
item 53
|
||||
</li>
|
||||
|
||||
<li id="l54">
|
||||
item 54
|
||||
</li>
|
||||
|
||||
<li id="l55">
|
||||
item 55
|
||||
</li>
|
||||
|
||||
<li id="l56">
|
||||
item 56
|
||||
</li>
|
||||
|
||||
<li id="l57">
|
||||
item 57
|
||||
</li>
|
||||
|
||||
<li id="l58">
|
||||
item 58
|
||||
</li>
|
||||
|
||||
<li id="l59">
|
||||
item 59
|
||||
</li>
|
||||
|
||||
<li id="l60">
|
||||
item 60
|
||||
</li>
|
||||
|
||||
<li id="l61">
|
||||
item 61
|
||||
</li>
|
||||
|
||||
<li id="l62">
|
||||
item 62
|
||||
</li>
|
||||
|
||||
<li id="l63">
|
||||
item 63
|
||||
</li>
|
||||
|
||||
<li id="l64">
|
||||
item 64
|
||||
</li>
|
||||
|
||||
<li id="l65">
|
||||
item 65
|
||||
</li>
|
||||
|
||||
<li id="l66">
|
||||
item 66
|
||||
</li>
|
||||
|
||||
<li id="l67">
|
||||
item 67
|
||||
</li>
|
||||
|
||||
<li id="l68">
|
||||
item 68
|
||||
</li>
|
||||
|
||||
<li id="l69">
|
||||
item 69
|
||||
</li>
|
||||
|
||||
<li id="l70">
|
||||
item 70
|
||||
</li>
|
||||
|
||||
<li id="l71">
|
||||
item 71
|
||||
</li>
|
||||
|
||||
<li id="l72">
|
||||
item 72
|
||||
</li>
|
||||
|
||||
<li id="l73">
|
||||
item 73
|
||||
</li>
|
||||
|
||||
<li id="l74">
|
||||
item 74
|
||||
</li>
|
||||
|
||||
<li id="l75">
|
||||
item 75
|
||||
</li>
|
||||
|
||||
<li id="l76">
|
||||
item 76
|
||||
</li>
|
||||
|
||||
<li id="l77">
|
||||
item 77
|
||||
</li>
|
||||
|
||||
<li id="l78">
|
||||
item 78
|
||||
</li>
|
||||
|
||||
<li id="l79">
|
||||
item 79
|
||||
</li>
|
||||
|
||||
<li id="l80">
|
||||
item 80
|
||||
</li>
|
||||
|
||||
<li id="l81">
|
||||
item 81
|
||||
</li>
|
||||
|
||||
<li id="l82">
|
||||
item 82
|
||||
</li>
|
||||
|
||||
<li id="l83">
|
||||
item 83
|
||||
</li>
|
||||
|
||||
<li id="l84">
|
||||
item 84
|
||||
</li>
|
||||
|
||||
<li id="l85">
|
||||
item 85
|
||||
</li>
|
||||
|
||||
<li id="l86">
|
||||
item 86
|
||||
</li>
|
||||
|
||||
<li id="l87">
|
||||
item 87
|
||||
</li>
|
||||
|
||||
<li id="l88">
|
||||
item 88
|
||||
</li>
|
||||
|
||||
<li id="l89">
|
||||
item 89
|
||||
</li>
|
||||
|
||||
<li id="l90">
|
||||
item 90
|
||||
</li>
|
||||
|
||||
<li id="l91">
|
||||
item 91
|
||||
</li>
|
||||
|
||||
<li id="l92">
|
||||
item 92
|
||||
</li>
|
||||
|
||||
<li id="l93">
|
||||
item 93
|
||||
</li>
|
||||
|
||||
<li id="l94">
|
||||
item 94
|
||||
</li>
|
||||
|
||||
<li id="l95">
|
||||
item 95
|
||||
</li>
|
||||
|
||||
<li id="l96">
|
||||
item 96
|
||||
</li>
|
||||
|
||||
<li id="l97">
|
||||
item 97
|
||||
</li>
|
||||
|
||||
<li id="l98">
|
||||
item 98
|
||||
</li>
|
||||
|
||||
<li id="l99">
|
||||
item 99
|
||||
</li>
|
||||
|
||||
</ul>
|
||||
|
||||
</body>
|
||||
|
||||
</html>
|
||||
|
||||
|
|
|
|||
|
|
@ -1,8 +1,6 @@
|
|||
<!DOCTYPE html>
|
||||
<html>
|
||||
<head>
|
||||
</head>
|
||||
|
||||
<head></head>
|
||||
<pre>ab</pre>
|
||||
<body>
|
||||
<ul style="list-style: circle">
|
||||
|
|
@ -132,6 +130,7 @@ item 40
|
|||
<li id="l41">
|
||||
item 41
|
||||
</li>
|
||||
|
||||
<li id="l43">
|
||||
item 43
|
||||
</li>
|
||||
|
|
@ -304,8 +303,6 @@ item 98
|
|||
item 99
|
||||
</li>
|
||||
</ul>
|
||||
|
||||
</body>
|
||||
|
||||
</html>
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue