diff --git a/src/Tiny_httpd_dir.ml b/src/Tiny_httpd_dir.ml
index d30ae10e..48721e30 100644
--- a/src/Tiny_httpd_dir.ml
+++ b/src/Tiny_httpd_dir.ml
@@ -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
diff --git a/src/gen/gentags.ml b/src/gen/gentags.ml
index db1cec21..e9946c7d 100644
--- a/src/gen/gentags.ml
+++ b/src/gen/gentags.ml
@@ -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 , 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 \"\";" 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 \"\")" 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 \"\";" 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 \"\")" name;
pf "\n\n";
diff --git a/tests/echo1.expect b/tests/echo1.expect
index 65ab6c65..4be10429 100644
--- a/tests/echo1.expect
+++ b/tests/echo1.expect
@@ -13,7 +13,6 @@ echo:
list directory "Embedded_fs"
-
@@ -25,27 +24,33 @@ Index of ""
a.txt
- (12b)
+ (12b)
+
example_dot_com
- (1.12k)
+ (1.12k)
+
foo.html
- (214b)
+ (214b)
+
sub
-[dir]
+[dir]
+
+
test_out.txt
- (209b)
+ (209b)
+