change api for Html.nary'; better newlines in output

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[][
+  let head =
+    head[][
       title[][txtf "list directory %S" VFS.descr];
       meta[A.charset "utf-8"];
-  ];
+    ] in
-
-  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 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 ->
+        Some (li'[] [
-        out @< a[A.href ("/" // prefix // fpath)][txt f];
+          sub_e @@ a[A.href ("/" // prefix // fpath)][txt f];
-        if VFS.is_directory fpath then out @< txt"[dir]";
+          (if VFS.is_directory fpath then sub_e @@ txt "[dir]" else sub_empty);
-        out @< txt size;
+          sub_e @@ txt size;
-      );
+        ])
       )
+    ) else None
   in
 
-  if !n_hidden>0 then (
+  let body = body'[] [
-    out @< details'[] @@ fun out ->
+    sub_e @@ h2[][txtf "Index of %S" d];
-    out @< summary[][txtf "(%d hidden files)" !n_hidden];
+    begin match parent with
+      | None -> sub_empty
+      | Some p ->
+        sub_e @@
+        a[A.href (encode_path ("/" // prefix // p))][txt"(parent directory)"]
+    end;
 
-    Array.iter
+    sub_e @@ ul' [] [
-      (fun f ->
+      if !n_hidden>0 then
-         if is_hidden f then (
+        sub_e @@ details'[][
-           emit_file f out;
+          sub_e @@ summary[][txtf "(%d hidden files)" !n_hidden];
-         ))
+          sub_seq (
-      entries;
+            seq_of_array entries
+            |> Seq.filter_map
+              (fun f -> if is_hidden f then file_to_elt f else None)
           );
-
+        ] else sub_empty;
-  Array.iter
+      sub_seq (
-    (fun f ->
+        seq_of_array entries
-       if not @@ is_hidden f then emit_file f out)
+        |> Seq.filter_map (fun f ->
-    entries;
+            if not (is_hidden f) then file_to_elt f else None)
-  ()
+      )
+    ];
+  ]
+  in
+  html [][head; body]
 
 let finally_ ~h x f =
   try

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
+(** A chunk of sub-elements, possibly empty.
-(** Element with children, represented as a continuation.
+    @inline *)
-    @param if_ if false, do not print anything (default true) *)
+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 =
@@ -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 -> Out.add_format_nl out; sub out) sub;\n";
-  pf "    List.iter (fun sub -> sub out; Out.add_format_nl out) sub;\n";
+  pf "    if sub <> [] then Out.add_format_nl out;\n";
-  pf "    Out.add_string out \"</%s>\";" name;
+  pf "    Out.add_string out \"</%s>\")" name;
-  pf "    Out.add_format_nl out)\n";
   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 "    let has_sub = _write_subs out l in\n";
-  pf "    f out;\n";
+  pf "    if has_sub then Out.add_format_nl out;\n";
-  pf "    Out.add_string out \"</%s>\";" name;
+  pf "    Out.add_string out \"</%s>\")" name;
-  pf "    Out.add_format_nl out)\n";
   pf "\n\n";
 
 

tests/echo1.expect

@@ -13,7 +13,6 @@ echo:
 <title>
 list directory &quot;Embedded_fs&quot;
 </title>
-
 <meta charset="utf-8"/>
 </head>
 <body>
@@ -25,27 +24,33 @@ Index of &quot;&quot;
 <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>

tests/html/makehtml.ml

@@ -18,11 +18,10 @@ let t2() =
     head [] [];
     pre [] [txt "a"; txt "b"];
     body [] [
-      ul' [A.style "list-style: circle"] (fun out ->
+      ul' [A.style "list-style: circle"] [
-          for i=0 to 99 do
+        sub_l @@ List.init 100 @@ fun i ->
-            li ~if_:(i<> 42) [A.id (spf "l%d" i)] [txt (spf "item %d" i)] out
+        li ~if_:(i<> 42) [A.id (spf "l%d" i)] [txt (spf "item %d" i)]
-          done
+      ]
-      )
     ]
   ]
 

tests/html/t1.expected.html

@@ -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>
 

tests/html/t2.expected.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>