ocamlformat

.ocamlformat

@@ -0,0 +1,14 @@
+version = 0.24.1
+profile=conventional
+margin=80
+if-then-else=k-r
+parens-ite=true
+parens-tuple=multi-line-only
+sequence-style=terminator
+type-decl=compact
+break-cases=toplevel
+cases-exp-indent=2
+field-space=tight-decl
+leading-nested-match-parens=true
+module-item-spacing=compact
+quiet=true

examples/dune

@@ -1,4 +1,3 @@
-
 (executable
  (name sse_server)
  (modules sse_server)
@@ -17,26 +16,41 @@
 
 (rule
  (targets test_output.txt)
-  (deps (:script ./run_test.sh) ./sse_client.exe ./sse_server.exe)
+ (deps
-  (enabled_if (= %{system} "linux"))
+  (:script ./run_test.sh)
+  ./sse_client.exe
+  ./sse_server.exe)
+ (enabled_if
+  (= %{system} "linux"))
  (package tiny_httpd)
  (action
-    (with-stdout-to %{targets} (run %{script}))))
+  (with-stdout-to
+   %{targets}
+   (run %{script}))))
 
 (rule
  (alias runtest)
  (package tiny_httpd)
-  (enabled_if (= %{system} "linux"))
+ (enabled_if
+  (= %{system} "linux"))
  (deps test_output.txt)
  (action
   (diff test_output.txt.expected test_output.txt)))
 
 ; produce an embedded FS
+
 (rule
  (targets vfs.ml)
-  (deps (source_tree files) (:out test_output.txt.expected))
+ (deps
-  (enabled_if (= %{system} "linux"))
+  (source_tree files)
-  (action (run %{bin:tiny-httpd-vfs-pack} -o %{targets}
+  (:out test_output.txt.expected))
+ (enabled_if
+  (= %{system} "linux"))
+ (action
+  (run
+   %{bin:tiny-httpd-vfs-pack}
+   -o
+   %{targets}
    --mirror=files/
    --file=test_out.txt,%{out}
    ; --url=example_dot_com,http://example.com ; this breaks tests in opam sandbox 😢
@@ -44,7 +58,8 @@
 
 (rule
  (targets vfs.ml)
-  (enabled_if (<> %{system} "linux"))
+ (enabled_if
+  (<> %{system} "linux"))
  (action
   (with-stdout-to
    %{targets}

examples/echo.ml

@@ -1,4 +1,3 @@
-
 module S = Tiny_httpd
 
 let now_ = Unix.gettimeofday
@@ -22,30 +21,34 @@ let middleware_stat () : S.Middleware.t * (unit -> string) =
         total_time_ := !total_time_ +. (t4 -. t1);
         parse_time_ := !parse_time_ +. (t2 -. t1);
         build_time_ := !build_time_ +. (t3 -. t2);
-        write_time_ := !write_time_ +. (t4 -. t3);
+        write_time_ := !write_time_ +. (t4 -. t3))
-      )
   and get_stat () =
-    Printf.sprintf "%d requests (average response time: %.3fms = %.3fms + %.3fms + %.3fms)"
+    Printf.sprintf
-      !n_req (!total_time_ /. float !n_req *. 1e3)
+      "%d requests (average response time: %.3fms = %.3fms + %.3fms + %.3fms)"
+      !n_req
+      (!total_time_ /. float !n_req *. 1e3)
       (!parse_time_ /. float !n_req *. 1e3)
       (!build_time_ /. float !n_req *. 1e3)
       (!write_time_ /. float !n_req *. 1e3)
   in
   m, get_stat
 
-
 let () =
   let port_ = ref 8080 in
   let j = ref 32 in
-  Arg.parse (Arg.align [
+  Arg.parse
+    (Arg.align
+       [
          "--port", Arg.Set_int port_, " set port";
          "-p", Arg.Set_int port_, " set port";
          "--debug", Arg.Unit (fun () -> S._enable_debug true), " enable debug";
          "-j", Arg.Set_int j, " maximum number of connections";
-    ]) (fun _ -> raise (Arg.Bad "")) "echo [option]*";
+       ])
+    (fun _ -> raise (Arg.Bad ""))
+    "echo [option]*";
 
   let server = S.create ~port:!port_ ~max_connections:!j () in
-  Tiny_httpd_camlzip.setup ~compress_above:1024 ~buf_size:(16*1024) server;
+  Tiny_httpd_camlzip.setup ~compress_above:1024 ~buf_size:(16 * 1024) server;
 
   let m_stats, get_stats = middleware_stat () in
   S.add_middleware server ~stage:(`Stage 1) m_stats;
@@ -53,7 +56,7 @@ let () =
   (* say hello *)
   S.add_route_handler ~meth:`GET server
     S.Route.(exact "hello" @/ string @/ return)
-    (fun name _req -> S.Response.make_string (Ok ("hello " ^name ^"!\n")));
+    (fun name _req -> S.Response.make_string (Ok ("hello " ^ name ^ "!\n")));
 
   (* compressed file access *)
   S.add_route_handler ~meth:`GET server
@@ -65,21 +68,23 @@ let () =
         try
           let p = Unix.open_process_in (Printf.sprintf "file -i -b %S" path) in
           try
-              let s = ["Content-Type", String.trim (input_line p)] in
+            let s = [ "Content-Type", String.trim (input_line p) ] in
             ignore @@ Unix.close_process_in p;
             s
-            with _ -> ignore @@ Unix.close_process_in p; []
+          with _ ->
+            ignore @@ Unix.close_process_in p;
+            []
         with _ -> []
       in
-        S.Response.make_stream ~headers:mime_type (Ok str)
+      S.Response.make_stream ~headers:mime_type (Ok str));
-      );
 
   (* echo request *)
   S.add_route_handler server
     S.Route.(exact "echo" @/ return)
     (fun req ->
       let q =
-          S.Request.query req |> List.map (fun (k,v) -> Printf.sprintf "%S = %S" k v)
+        S.Request.query req
+        |> List.map (fun (k, v) -> Printf.sprintf "%S = %S" k v)
         |> String.concat ";"
       in
       S.Response.make_string
@@ -89,7 +94,8 @@ let () =
   S.add_route_handler_stream ~meth:`PUT server
     S.Route.(exact "upload" @/ string @/ return)
     (fun path req ->
-        S._debug (fun k->k "start upload %S, headers:\n%s\n\n%!" path
+      S._debug (fun k ->
+          k "start upload %S, headers:\n%s\n\n%!" path
             (Format.asprintf "%a" S.Headers.pp (S.Request.headers req)));
       try
         let oc = open_out @@ "/tmp/" ^ path in
@@ -97,43 +103,80 @@ let () =
         flush oc;
         S.Response.make_string (Ok "uploaded file")
       with e ->
-          S.Response.fail ~code:500 "couldn't upload file: %s" (Printexc.to_string e)
+        S.Response.fail ~code:500 "couldn't upload file: %s"
-      );
+          (Printexc.to_string e));
 
   (* stats *)
-  S.add_route_handler server S.Route.(exact "stats" @/ return)
+  S.add_route_handler server
+    S.Route.(exact "stats" @/ return)
     (fun _req ->
-       let stats = get_stats() in
+      let stats = get_stats () in
-       S.Response.make_string @@ Ok stats
+      S.Response.make_string @@ Ok stats);
-    );
 
   (* VFS *)
   Tiny_httpd_dir.add_vfs server
-    ~config:(Tiny_httpd_dir.config ~download:true
+    ~config:
+      (Tiny_httpd_dir.config ~download:true
          ~dir_behavior:Tiny_httpd_dir.Index_or_lists ())
     ~vfs:Vfs.vfs ~prefix:"vfs";
 
   (* main page *)
-  S.add_route_handler server S.Route.(return)
+  S.add_route_handler server
+    S.Route.(return)
     (fun _req ->
       let open Tiny_httpd_html in
-       let h = html [] [
+      let h =
-           head[][title[][txt "index of echo"]];
+        html []
-           body[][
+          [
-             h3[] [txt "welcome!"];
+            head [] [ title [] [ txt "index of echo" ] ];
-             p[] [b[] [txt "endpoints are:"]];
+            body []
-             ul[] [
+              [
-               li[][pre[][txt "/hello/:name (GET)"]];
+                h3 [] [ txt "welcome!" ];
-               li[][pre[][a[A.href "/echo/"][txt "echo"]; txt " echo back query"]];
+                p [] [ b [] [ txt "endpoints are:" ] ];
-               li[][pre[][txt "/upload/:path (PUT) to upload a file"]];
+                ul []
-               li[][pre[][txt "/zcat/:path (GET) to download a file (deflate transfer-encoding)"]];
+                  [
-               li[][pre[][a[A.href "/stats/"][txt"/stats/"]; txt" (GET) to access statistics"]];
+                    li [] [ pre [] [ txt "/hello/:name (GET)" ] ];
-               li[][pre[][a[A.href "/vfs/"][txt"/vfs"]; txt" (GET) to access a VFS embedded in the binary"]];
+                    li []
+                      [
+                        pre []
+                          [
+                            a [ A.href "/echo/" ] [ txt "echo" ];
+                            txt " echo back query";
+                          ];
+                      ];
+                    li []
+                      [ pre [] [ txt "/upload/:path (PUT) to upload a file" ] ];
+                    li []
+                      [
+                        pre []
+                          [
+                            txt
+                              "/zcat/:path (GET) to download a file (deflate \
+                               transfer-encoding)";
+                          ];
+                      ];
+                    li []
+                      [
+                        pre []
+                          [
+                            a [ A.href "/stats/" ] [ txt "/stats/" ];
+                            txt " (GET) to access statistics";
+                          ];
+                      ];
+                    li []
+                      [
+                        pre []
+                          [
+                            a [ A.href "/vfs/" ] [ txt "/vfs" ];
+                            txt " (GET) to access a VFS embedded in the binary";
+                          ];
+                      ];
+                  ];
+              ];
           ]
-           ]
+      in
-         ] in
       let s = to_string_top h in
-       S.Response.make_string ~headers:["content-type", "text/html"] @@ Ok s);
+      S.Response.make_string ~headers:[ "content-type", "text/html" ] @@ Ok s);
 
   Printf.printf "listening on http://%s:%d\n%!" (S.addr server) (S.port server);
   match S.run server with

examples/sse_client.ml

@@ -1,15 +1,20 @@
 let addr = ref "127.0.0.1"
 let port = ref 8080
 let path = ref "/clock"
-
 let bufsize = 1024
 
 let () =
-  Arg.parse (Arg.align [
+  Arg.parse
+    (Arg.align
+       [
          "-h", Arg.Set_string addr, " address to connect to";
          "-p", Arg.Set_int port, " port to connect to";
-      "--alarm", Arg.Int (fun i->Unix.alarm i|>ignore), " set alarm (in seconds)";
+         ( "--alarm",
-    ]) (fun s -> path := s) "sse_client [opt]* path?";
+           Arg.Int (fun i -> Unix.alarm i |> ignore),
+           " set alarm (in seconds)" );
+       ])
+    (fun s -> path := s)
+    "sse_client [opt]* path?";
 
   Format.printf "connect to %s:%d@." !addr !port;
   let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
@@ -25,7 +30,8 @@ let () =
   let buf = Bytes.create bufsize in
   while !continue do
     let n = input ic buf 0 bufsize in
-    if n=0 then continue := false;
+    if n = 0 then continue := false;
-    output stdout buf 0 n; flush stdout
+    output stdout buf 0 n;
+    flush stdout
   done;
   Format.printf "exit!@."

examples/sse_server.ml

@@ -1,4 +1,3 @@
-
 (* serves some streams of events *)
 
 module S = Tiny_httpd
@@ -6,57 +5,68 @@ module S = Tiny_httpd
 let port = ref 8080
 
 let () =
-  Arg.parse (Arg.align [
+  Arg.parse
+    (Arg.align
+       [
          "-p", Arg.Set_int port, " port to listen on";
          "--debug", Arg.Bool S._enable_debug, " toggle debug";
-    ]) (fun _ -> ()) "sse_clock [opt*]";
+       ])
+    (fun _ -> ())
+    "sse_clock [opt*]";
   let server = S.create ~port:!port () in
 
-  let extra_headers = [
+  let extra_headers =
+    [
       "Access-Control-Allow-Origin", "*";
       "Access-Control-Allow-Methods", "POST, GET, OPTIONS";
-  ] in
+    ]
+  in
 
   (* tick/tock goes the clock *)
-  S.add_route_server_sent_handler server S.Route.(exact "clock" @/ return)
+  S.add_route_server_sent_handler server
+    S.Route.(exact "clock" @/ return)
     (fun _req (module EV : S.SERVER_SENT_GENERATOR) ->
-       S._debug (fun k->k"new connection");
+      S._debug (fun k -> k "new connection");
       EV.set_headers extra_headers;
       let tick = ref true in
       while true do
-         let now = Ptime_clock.now() in
+        let now = Ptime_clock.now () in
-         S._debug (fun k->k"send clock ev %s" (Format.asprintf "%a" Ptime.pp now));
+        S._debug (fun k ->
-         EV.send_event ~event:(if !tick then "tick" else "tock")
+            k "send clock ev %s" (Format.asprintf "%a" Ptime.pp now));
+        EV.send_event
+          ~event:
+            (if !tick then
+              "tick"
+            else
+              "tock")
           ~data:(Ptime.to_rfc3339 now) ();
         tick := not !tick;
 
-         Unix.sleepf 1.0;
+        Unix.sleepf 1.0
-       done;
+      done);
-    );
 
   (* just count *)
-  S.add_route_server_sent_handler server S.Route.(exact "count" @/ return)
+  S.add_route_server_sent_handler server
+    S.Route.(exact "count" @/ return)
     (fun _req (module EV : S.SERVER_SENT_GENERATOR) ->
       let n = ref 0 in
       while true do
         EV.send_event ~data:(string_of_int !n) ();
         incr n;
-         Unix.sleepf 0.1;
+        Unix.sleepf 0.1
-       done;
+      done);
-    );
+  S.add_route_server_sent_handler server
-  S.add_route_server_sent_handler server S.Route.(exact "count" @/ int @/ return)
+    S.Route.(exact "count" @/ int @/ return)
     (fun n _req (module EV : S.SERVER_SENT_GENERATOR) ->
-       for i=0 to n do
+      for i = 0 to n do
         EV.send_event ~data:(string_of_int i) ();
-         Unix.sleepf 0.1;
+        Unix.sleepf 0.1
       done;
-       EV.close();
+      EV.close ());
-    );
 
   Printf.printf "listening on http://localhost:%d/\n%!" (S.port server);
   match S.run server with
   | Ok () -> ()
   | Error e ->
-    Printf.eprintf "error: %s\n%!" (Printexc.to_string e); exit 1
+    Printf.eprintf "error: %s\n%!" (Printexc.to_string e);
-
+    exit 1
-

src/Tiny_httpd.ml

@@ -1,4 +1,3 @@
-
 (** Tiny Httpd.
 
     A small HTTP/1.1 server, in pure OCaml, along with some utilities
@@ -8,13 +7,8 @@
 *)
 
 module Buf = Tiny_httpd_buf
-
 module Byte_stream = Tiny_httpd_stream
-
 include Tiny_httpd_server
-
 module Util = Tiny_httpd_util
-
 module Dir = Tiny_httpd_dir
-
 module Html = Tiny_httpd_html

src/Tiny_httpd.mli

@@ -1,4 +1,3 @@
-
 (** {1 Tiny Http Server}
 
     This library implements a very simple, basic HTTP/1.1 server using blocking
@@ -74,7 +73,6 @@ echo:
 
 *)
 
-
 (** {2 Tiny buffer implementation}
 
     These buffers are used to avoid allocating too many byte arrays when
@@ -93,7 +91,9 @@ module Byte_stream = Tiny_httpd_stream
 (** {2 Main Server Type} *)
 
 (** @inline *)
-include module type of struct include Tiny_httpd_server end
+include module type of struct
+  include Tiny_httpd_server
+end
 
 (** {2 Utils} *)
 

src/Tiny_httpd_buf.ml

@@ -1,18 +1,12 @@
+type t = { mutable bytes: bytes; mutable i: int }
 
-type t = {
+let create ?(size = 4_096) () : t = { bytes = Bytes.make size ' '; i = 0 }
-  mutable bytes: bytes;
-  mutable i: int;
-}
-
-let create ?(size=4_096) () : t =
-  { bytes=Bytes.make size ' '; i=0 }
-
 let size self = self.i
 let bytes_slice self = self.bytes
+
 let clear self : unit =
-  if Bytes.length self.bytes > 4_096 * 1_024 then (
+  if Bytes.length self.bytes > 4_096 * 1_024 then
-    self.bytes <- Bytes.make 4096 ' '; (* free big buffer *)
+    self.bytes <- Bytes.make 4096 ' ' (* free big buffer *);
-  );
   self.i <- 0
 
 let resize self new_size : unit =
@@ -20,16 +14,15 @@ let resize self new_size : unit =
   Bytes.blit self.bytes 0 new_buf 0 self.i;
   self.bytes <- new_buf
 
-let add_bytes (self:t) s i len : unit =
+let add_bytes (self : t) s i len : unit =
-  if self.i + len >= Bytes.length self.bytes then (
+  if self.i + len >= Bytes.length self.bytes then
-    resize self (self.i + self.i / 2 + len + 10);
+    resize self (self.i + (self.i / 2) + len + 10);
-  );
   Bytes.blit s i self.bytes self.i len;
   self.i <- self.i + len
 
-let contents (self:t) : string = Bytes.sub_string self.bytes 0 self.i
+let contents (self : t) : string = Bytes.sub_string self.bytes 0 self.i
 
-let contents_and_clear (self:t) : string =
+let contents_and_clear (self : t) : string =
   let x = contents self in
   clear self;
   x

src/Tiny_httpd_buf.mli

@@ -1,4 +1,3 @@
-
 (** Simple buffer.
 
     These buffers are used to avoid allocating too many byte arrays when
@@ -8,6 +7,7 @@
 *)
 
 type t
+
 val size : t -> int
 val clear : t -> unit
 val create : ?size:int -> unit -> t
@@ -24,4 +24,3 @@ val contents_and_clear : t -> string
 val add_bytes : t -> bytes -> int -> int -> unit
 (** Append given bytes slice to the buffer.
     @since 0.5 *)
-

src/Tiny_httpd_dir.ml

@@ -3,62 +3,73 @@ module U = Tiny_httpd_util
 module Html = Tiny_httpd_html
 module Pf = Printf
 
-type dir_behavior =
+type dir_behavior = Index | Lists | Index_or_lists | Forbidden
-  | Index | Lists | Index_or_lists | Forbidden
-
 type hidden = unit
+
 type config = {
   mutable download: bool;
   mutable dir_behavior: dir_behavior;
   mutable delete: bool;
   mutable upload: bool;
   mutable max_upload_size: int;
-  _rest: hidden
+  _rest: hidden;
 }
 
 let default_config_ : config =
-  { download=true;
+  {
-    dir_behavior=Forbidden;
+    download = true;
-    delete=false;
+    dir_behavior = Forbidden;
-    upload=false;
+    delete = false;
+    upload = false;
     max_upload_size = 10 * 1024 * 1024;
-    _rest=();
+    _rest = ();
   }
 
 let default_config () = default_config_
-let config
+
-    ?(download=default_config_.download)
+let config ?(download = default_config_.download)
-    ?(dir_behavior=default_config_.dir_behavior)
+    ?(dir_behavior = default_config_.dir_behavior)
-    ?(delete=default_config_.delete)
+    ?(delete = default_config_.delete) ?(upload = default_config_.upload)
-    ?(upload=default_config_.upload)
+    ?(max_upload_size = default_config_.max_upload_size) () : config =
-    ?(max_upload_size=default_config_.max_upload_size)
+  { download; dir_behavior; delete; upload; max_upload_size; _rest = () }
-    () : config =
-  { download; dir_behavior; delete; upload; max_upload_size;
-    _rest=()}
 
 let contains_dot_dot s =
   try
     String.iteri
       (fun i c ->
-         if c='.' && i+1 < String.length s && String.get s (i+1) = '.' then raise Exit)
+        if c = '.' && i + 1 < String.length s && String.get s (i + 1) = '.' then
+          raise Exit)
       s;
     false
   with Exit -> true
 
 (* Human readable size *)
-let human_size (x:int) : string =
+let human_size (x : int) : string =
-  if x >= 1_000_000_000 then Printf.sprintf "%d.%dG" (x / 1_000_000_000) ((x/1_000_000) mod 1_000_000)
+  if x >= 1_000_000_000 then
-  else if x >= 1_000_000 then Printf.sprintf "%d.%dM" (x / 1_000_000) ((x/1000) mod 1_000)
+    Printf.sprintf "%d.%dG" (x / 1_000_000_000) (x / 1_000_000 mod 1_000_000)
-  else if x >= 1_000 then Printf.sprintf "%d.%dk" (x/1000) ((x/100) mod 100)
+  else if x >= 1_000_000 then
-  else Printf.sprintf "%db" x
+    Printf.sprintf "%d.%dM" (x / 1_000_000) (x / 1000 mod 1_000)
+  else if x >= 1_000 then
+    Printf.sprintf "%d.%dk" (x / 1000) (x / 100 mod 100)
+  else
+    Printf.sprintf "%db" x
 
 let header_html = "Content-Type", "text/html"
-let (//) = Filename.concat
+let ( // ) = Filename.concat
 
-let encode_path s = U.percent_encode ~skip:(function '/' -> true|_->false) s
+let encode_path s =
-let _decode_path s = match U.percent_decode s with Some s->s | None -> s
+  U.percent_encode
+    ~skip:(function
+      | '/' -> true
+      | _ -> false)
+    s
 
-let is_hidden s = String.length s>0 && s.[0] = '.'
+let _decode_path s =
+  match U.percent_decode s with
+  | Some s -> s
+  | None -> s
+
+let is_hidden s = String.length s > 0 && s.[0] = '.'
 
 module type VFS = sig
   val descr : string
@@ -74,42 +85,46 @@ end
 
 type vfs = (module VFS)
 
-let vfs_of_dir (top:string) : vfs =
+let vfs_of_dir (top : string) : vfs =
   let module M = struct
     let descr = top
-    let (//) = Filename.concat
+    let ( // ) = Filename.concat
     let is_directory f = Sys.is_directory (top // f)
     let contains f = Sys.file_exists (top // f)
     let list_dir f = Sys.readdir (top // f)
+
     let read_file_content f =
-      let ic = Unix.(openfile (top // f) [O_RDONLY] 0) in
+      let ic = Unix.(openfile (top // f) [ O_RDONLY ] 0) in
       Tiny_httpd_stream.of_fd ic
+
     let create f =
       let oc = open_out_bin (top // f) in
       let write = output oc in
-      let close() = close_out oc in
+      let close () = close_out oc in
       write, close
+
     let delete f = Sys.remove (top // f)
+
     let file_size f =
-      try Some (Unix.stat (top // f)).Unix.st_size
+      try Some (Unix.stat (top // f)).Unix.st_size with _ -> None
-      with _ -> None
+
     let file_mtime f =
-      try Some (Unix.stat (top // f)).Unix.st_mtime
+      try Some (Unix.stat (top // f)).Unix.st_mtime with _ -> None
-      with _ -> None
   end in
   (module M)
 
-let html_list_dir (module VFS:VFS) ~prefix ~parent d : Html.elt =
+let html_list_dir (module VFS : VFS) ~prefix ~parent d : Html.elt =
   let entries = VFS.list_dir d in
   Array.sort String.compare entries;
   let open Html in
-
   (* TODO: breadcrumbs for the path, each element a link to the given ancestor dir *)
   let head =
-    head[][
+    head []
-      title[][txtf "list directory %S" VFS.descr];
+      [
-      meta[A.charset "utf-8"];
+        title [] [ txtf "list directory %S" VFS.descr ];
-    ] in
+        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;
@@ -117,51 +132,70 @@ let html_list_dir (module VFS:VFS) ~prefix ~parent d : Html.elt =
   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 (
+      if not @@ VFS.contains fpath then
-        Some (li[][txtf "%s [invalid file]" f])
+        Some (li [] [ txtf "%s [invalid file]" f ])
-      ) else (
+      else (
         let size =
           match VFS.file_size fpath with
           | Some f -> Printf.sprintf " (%s)" @@ human_size f
           | None -> ""
         in
-        Some (li'[] [
+        Some
-          sub_e @@ a[A.href ("/" // prefix // fpath)][txt f];
+          (li' []
-          (if VFS.is_directory fpath then sub_e @@ txt "[dir]" else sub_empty);
+             [
+               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
+    ) else
+      None
   in
 
-  let body = body'[] [
+  let body =
-    sub_e @@ h2[][txtf "Index of %S" d];
+    body' []
-    begin match parent with
+      [
+        sub_e @@ h2 [] [ txtf "Index of %S" d ];
+        (match parent with
         | None -> sub_empty
         | Some p ->
-        sub_e @@
+          sub_e
-        a[A.href (encode_path ("/" // prefix // p))][txt"(parent directory)"]
+          @@ a
-    end;
+               [ A.href (encode_path ("/" // prefix // p)) ]
-
+               [ txt "(parent directory)" ]);
-    sub_e @@ ul' [] [
+        sub_e
-      if !n_hidden>0 then
+        @@ ul' []
-        sub_e @@ details'[][
+             [
-          sub_e @@ summary[][txtf "(%d hidden files)" !n_hidden];
+               (if !n_hidden > 0 then
-          sub_seq (
+                 sub_e
-            seq_of_array entries
+                 @@ details' []
-            |> Seq.filter_map
+                      [
-              (fun f -> if is_hidden f then file_to_elt f else None)
+                        sub_e
-          );
+                        @@ summary [] [ txtf "(%d hidden files)" !n_hidden ];
-        ] else sub_empty;
+                        sub_seq
-      sub_seq (
+                          (seq_of_array entries
-        seq_of_array entries
                           |> Seq.filter_map (fun f ->
-            if not (is_hidden f) then file_to_elt f else None)
+                                 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]
+  html [] [ head; body ]
 
 let finally_ ~h x f =
   try
@@ -173,120 +207,135 @@ let finally_ ~h x f =
     raise e
 
 (* @param on_fs: if true, we assume the file exists on the FS *)
-let add_vfs_ ~on_fs ~top ~config ~vfs:((module VFS:VFS) as vfs) ~prefix server : unit=
+let add_vfs_ ~on_fs ~top ~config ~vfs:((module VFS : VFS) as vfs) ~prefix server
-
+    : unit =
   let route () =
-    if prefix="" then S.Route.rest_of_path_urlencoded
+    if prefix = "" then
-    else S.Route.exact_path prefix S.Route.rest_of_path_urlencoded
+      S.Route.rest_of_path_urlencoded
+    else
+      S.Route.exact_path prefix S.Route.rest_of_path_urlencoded
   in
-  if config.delete then (
+  if config.delete then
-    S.add_route_handler server ~meth:`DELETE (route())
+    S.add_route_handler server ~meth:`DELETE (route ()) (fun path _req ->
-      (fun path _req ->
+        if contains_dot_dot path then
-         if contains_dot_dot path then (
           S.Response.fail_raise ~code:403 "invalid path in delete"
-         ) else (
+        else
           S.Response.make_string
             (try
-                VFS.delete path; Ok "file deleted successfully"
+               VFS.delete path;
-              with e -> Error (500, Printexc.to_string e))
+               Ok "file deleted successfully"
-         )
+             with e -> Error (500, Printexc.to_string e)))
-      );
+  else
-  ) else (
+    S.add_route_handler server ~meth:`DELETE (route ()) (fun _ _ ->
-    S.add_route_handler server ~meth:`DELETE (route())
+        S.Response.make_raw ~code:405 "delete not allowed");
-      (fun _ _  -> S.Response.make_raw ~code:405 "delete not allowed");
-  );
 
-  if config.upload then (
+  if config.upload then
-    S.add_route_handler_stream server ~meth:`PUT (route())
+    S.add_route_handler_stream server ~meth:`PUT (route ())
       ~accept:(fun req ->
         match S.Request.get_header_int req "Content-Length" with
         | Some n when n > config.max_upload_size ->
-            Error (403, "max upload size is " ^ string_of_int config.max_upload_size)
+          Error
+            (403, "max upload size is " ^ string_of_int config.max_upload_size)
         | Some _ when contains_dot_dot req.S.Request.path ->
           Error (403, "invalid path (contains '..')")
-          | _ -> Ok ()
+        | _ -> Ok ())
-        )
       (fun path req ->
         let write, close =
           try VFS.create path
           with e ->
-             S.Response.fail_raise ~code:403 "cannot upload to %S: %s"
+            S.Response.fail_raise ~code:403 "cannot upload to %S: %s" path
-               path (Printexc.to_string e)
+              (Printexc.to_string e)
+        in
+        let req =
+          S.Request.limit_body_size ~max_size:config.max_upload_size req
         in
-         let req = S.Request.limit_body_size ~max_size:config.max_upload_size req in
         Tiny_httpd_stream.iter write req.S.Request.body;
         close ();
-         S._debug (fun k->k "done uploading");
+        S._debug (fun k -> k "done uploading");
-         S.Response.make_raw ~code:201 "upload successful"
+        S.Response.make_raw ~code:201 "upload successful")
-      )
+  else
-  ) else (
+    S.add_route_handler server ~meth:`PUT (route ()) (fun _ _ ->
-    S.add_route_handler server ~meth:`PUT (route())
+        S.Response.make_raw ~code:405 "upload not allowed");
-      (fun _ _  -> S.Response.make_raw ~code:405 "upload not allowed");
-  );
 
-  if config.download then (
+  if config.download then
-    S.add_route_handler server ~meth:`GET (route())
+    S.add_route_handler server ~meth:`GET (route ()) (fun path req ->
-      (fun path req ->
+        S._debug (fun k -> k "path=%S" path);
-         S._debug (fun k->k "path=%S" path);
+        let mtime =
-         let mtime = lazy (
+          lazy
-           match VFS.file_mtime path with
+            (match VFS.file_mtime path with
             | None -> S.Response.fail_raise ~code:403 "Cannot access file"
-           | Some t -> Printf.sprintf "mtime: %.4f" t
+            | Some t -> Printf.sprintf "mtime: %.4f" t)
-         ) in
+        in
-         if contains_dot_dot path then (
+        if contains_dot_dot path then
-           S.Response.fail ~code:403 "Path is forbidden";
+          S.Response.fail ~code:403 "Path is forbidden"
-         ) else if not (VFS.contains path) then (
+        else if not (VFS.contains path) then
-           S.Response.fail ~code:404 "File not found";
+          S.Response.fail ~code:404 "File not found"
-         ) else if S.Request.get_header req "If-None-Match" = Some (Lazy.force mtime) then (
+        else if
-           S._debug (fun k->k "cached object %S (etag: %S)" path (Lazy.force mtime));
+          S.Request.get_header req "If-None-Match" = Some (Lazy.force mtime)
+        then (
+          S._debug (fun k ->
+              k "cached object %S (etag: %S)" path (Lazy.force mtime));
           S.Response.make_raw ~code:304 ""
         ) else if VFS.is_directory path then (
-           S._debug (fun k->k "list dir %S (topdir %S)" path VFS.descr);
+          S._debug (fun k -> k "list dir %S (topdir %S)" path VFS.descr);
           let parent = Filename.(dirname path) in
-           let parent = if Filename.basename path <> "." then Some parent else None in
+          let parent =
+            if Filename.basename path <> "." then
+              Some parent
+            else
+              None
+          in
           match config.dir_behavior with
-           | Index | Index_or_lists when VFS.contains (path // "index.html") ->
+          | (Index | Index_or_lists) when VFS.contains (path // "index.html") ->
             (* redirect using path, not full path *)
             let new_path = "/" // prefix // path // "index.html" in
-             S._debug (fun k->k "redirect to `%s`" new_path);
+            S._debug (fun k -> k "redirect to `%s`" new_path);
             S.Response.make_void ~code:301 ()
               ~headers:S.Headers.(empty |> set "location" new_path)
           | Lists | Index_or_lists ->
-             let body = html_list_dir ~prefix vfs path ~parent |> Html.to_string_top in
+            let body =
+              html_list_dir ~prefix vfs path ~parent |> Html.to_string_top
+            in
             S.Response.make_string
-               ~headers:[header_html; "ETag", Lazy.force mtime]
+              ~headers:[ header_html; "ETag", Lazy.force mtime ]
               (Ok body)
           | Forbidden | Index ->
             S.Response.make_raw ~code:405 "listing dir not allowed"
         ) else (
           try
             let mime_type =
-               if Filename.extension path = ".css" then (
+              if Filename.extension path = ".css" then
-                 ["Content-Type", "text/css"]
+                [ "Content-Type", "text/css" ]
-               ) else if Filename.extension path = ".js" then (
+              else if Filename.extension path = ".js" then
-                 ["Content-Type", "text/javascript"]
+                [ "Content-Type", "text/javascript" ]
-               ) else if on_fs then (
+              else if on_fs then (
                 (* call "file" util *)
                 try
-                   let p = Unix.open_process_in (Printf.sprintf "file -i -b %S" (top // path)) in
+                  let p =
-                   finally_ ~h:(fun p->ignore @@ Unix.close_process_in p) p
+                    Unix.open_process_in
+                      (Printf.sprintf "file -i -b %S" (top // path))
+                  in
+                  finally_
+                    ~h:(fun p -> ignore @@ Unix.close_process_in p)
+                    p
                     (fun p ->
-                        try ["Content-Type", String.trim (input_line p)]
+                      try [ "Content-Type", String.trim (input_line p) ]
                       with _ -> [])
                 with _ -> []
-               ) else []
+              ) else
+                []
             in
             let stream = VFS.read_file_content path in
             S.Response.make_raw_stream
-               ~headers:(mime_type@["Etag", Lazy.force mtime])
+              ~headers:(mime_type @ [ "Etag", Lazy.force mtime ])
               ~code:200 stream
           with e ->
-             S.Response.fail ~code:500 "error while reading file: %s" (Printexc.to_string e))
+            S.Response.fail ~code:500 "error while reading file: %s"
-      )
+              (Printexc.to_string e)
-  ) else (
+        ))
-    S.add_route_handler server ~meth:`GET (route())
+  else
-      (fun _ _  -> S.Response.make_raw ~code:405 "download not allowed");
+    S.add_route_handler server ~meth:`GET (route ()) (fun _ _ ->
-  );
+        S.Response.make_raw ~code:405 "download not allowed");
   ()
 
 let add_vfs ~config ~vfs ~prefix server : unit =
@@ -296,43 +345,38 @@ let add_dir_path ~config ~dir ~prefix server : unit =
   add_vfs_ ~on_fs:true ~top:dir ~config ~prefix ~vfs:(vfs_of_dir dir) server
 
 module Embedded_fs = struct
-  module Str_map = Map.Make(String)
+  module Str_map = Map.Make (String)
 
-  type t = {
+  type t = { mtime: float; mutable entries: entry Str_map.t }
-    mtime: float;
+  and entry = File of { content: string; mtime: float } | Dir of t
-    mutable entries: entry Str_map.t
-  }
 
-  and entry =
+  let create ?(mtime = Unix.gettimeofday ()) () : t =
-    | File of {
+    { mtime; entries = Str_map.empty }
-        content: string;
-        mtime: float;
-      }
-    | Dir of t
 
-  let create ?(mtime=Unix.gettimeofday()) () : t = {
+  let split_path_ (path : string) : string list * string =
-    mtime;
-    entries=Str_map.empty;
-  }
-
-  let split_path_ (path:string) : string list * string =
     let basename = Filename.basename path in
     let dirname =
-      Filename.dirname path
+      Filename.dirname path |> String.split_on_char '/'
-      |> String.split_on_char '/'
+      |> List.filter (function
-      |> List.filter (function "" | "." -> false | _ -> true) in
+           | "" | "." -> false
+           | _ -> true)
+    in
     dirname, basename
 
-  let add_file ?mtime (self:t) ~path content : unit =
+  let add_file ?mtime (self : t) ~path content : unit =
-    let mtime = match mtime with Some t -> t | None -> self.mtime in
+    let mtime =
+      match mtime with
+      | Some t -> t
+      | None -> self.mtime
+    in
     let dir_path, basename = split_path_ path in
-    if List.mem ".." dir_path then (
+    if List.mem ".." dir_path then invalid_arg "add_file: '..' is not allowed";
-      invalid_arg "add_file: '..' is not allowed";
-    );
 
-    let rec loop self dir = match dir with
+    let rec loop self dir =
+      match dir with
       | [] ->
-        self.entries <- Str_map.add basename (File {mtime; content}) self.entries
+        self.entries <-
+          Str_map.add basename (File { mtime; content }) self.entries
       | d :: ds ->
         let sub =
           match Str_map.find d self.entries with
@@ -352,49 +396,61 @@ module Embedded_fs = struct
   (* find entry *)
   let find_ self path : entry option =
     let dir_path, basename = split_path_ path in
-    let rec loop self dir_name = match dir_name with
+    let rec loop self dir_name =
+      match dir_name with
       | [] -> (try Some (Str_map.find basename self.entries) with _ -> None)
       | d :: ds ->
-        match Str_map.find d self.entries with
+        (match Str_map.find d self.entries with
         | exception Not_found -> None
         | File _ -> None
-        | Dir sub -> loop sub ds
+        | Dir sub -> loop sub ds)
     in
-    if path="" then Some (Dir self)
+    if path = "" then
-    else loop self dir_path
+      Some (Dir self)
+    else
+      loop self dir_path
 
   let to_vfs self : vfs =
     let module M = struct
       let descr = "Embedded_fs"
-      let file_mtime p = match find_ self p with
+
-        | Some (File {mtime;_}) -> Some mtime
+      let file_mtime p =
+        match find_ self p with
+        | Some (File { mtime; _ }) -> Some mtime
         | Some (Dir _) -> Some self.mtime
         | _ -> None
 
-      let file_size p = match find_ self p with
+      let file_size p =
-        | Some (File {content;_}) -> Some (String.length content)
+        match find_ self p with
+        | Some (File { content; _ }) -> Some (String.length content)
         | _ -> None
 
-      let contains p = S._debug (fun k->k "contains %S" p); match find_ self p with
+      let contains p =
+        S._debug (fun k -> k "contains %S" p);
+        match find_ self p with
         | Some _ -> true
         | None -> false
 
-      let is_directory p = match find_ self p with
+      let is_directory p =
+        match find_ self p with
         | Some (Dir _) -> true
         | _ -> false
 
-      let read_file_content p = match find_ self p with
+      let read_file_content p =
-        | Some (File {content;_}) -> Tiny_httpd_stream.of_string content
+        match find_ self p with
+        | Some (File { content; _ }) -> Tiny_httpd_stream.of_string content
         | _ -> failwith (Printf.sprintf "no such file: %S" p)
 
-      let list_dir p = S._debug (fun k->k "list dir %S" p); match find_ self p with
+      let list_dir p =
+        S._debug (fun k -> k "list dir %S" p);
+        match find_ self p with
         | Some (Dir sub) ->
-          Str_map.fold (fun sub _ acc -> sub::acc) sub.entries [] |> Array.of_list
+          Str_map.fold (fun sub _ acc -> sub :: acc) sub.entries []
+          |> Array.of_list
         | _ -> failwith (Printf.sprintf "no such directory: %S" p)
 
       let create _ = failwith "Embedded_fs is read-only"
       let delete _ = failwith "Embedded_fs is read-only"
-
+    end in
-    end in (module M)
+    (module M)
-
 end

src/Tiny_httpd_dir.mli

@@ -1,4 +1,3 @@
-
 (** Serving static content from directories
 
     This module provides the same functionality as the "http_of_dir" tool.
@@ -12,8 +11,7 @@
     This controls what happens when the user requests the path to
     a directory rather than a file. *)
 type dir_behavior =
-  | Index
+  | Index  (** Redirect to index.html if present, else fails. *)
-  (** Redirect to index.html if present, else fails. *)
   | Lists
       (** Lists content of directory. Be careful of security implications. *)
   | Index_or_lists
@@ -27,29 +25,21 @@ type hidden
 (** Type used to prevent users from building a config directly.
     Use {!default_config} or {!config} instead. *)
 
-(** configuration for static file handlers. This might get
-    more fields over time. *)
 type config = {
-  mutable download: bool;
+  mutable download: bool;  (** Is downloading files allowed? *)
-  (** Is downloading files allowed? *)
-
   mutable dir_behavior: dir_behavior;
       (** Behavior when serving a directory and not a file *)
-
+  mutable delete: bool;  (** Is deleting a file allowed? (with method DELETE) *)
-  mutable delete: bool;
+  mutable upload: bool;  (** Is uploading a file allowed? (with method PUT) *)
-  (** Is deleting a file allowed? (with method DELETE) *)
-
-  mutable upload: bool;
-  (** Is uploading a file allowed? (with method PUT) *)
-
   mutable max_upload_size: int;
       (** If {!upload} is true, this is the maximum size in bytes for
       uploaded files. *)
-
+  _rest: hidden;  (** Just ignore this field. *)
-  _rest: hidden;
-  (** Just ignore this field. *)
 }
+(** configuration for static file handlers. This might get
+    more fields over time. *)
 
+val default_config : unit -> config
 (** default configuration: [
   { download=true
   ; dir_behavior=Forbidden
@@ -57,7 +47,6 @@ type config = {
   ; upload=false
   ; max_upload_size = 10 * 1024 * 1024
   }] *)
-val default_config : unit -> config
 
 val config :
   ?download:bool ->
@@ -70,14 +59,11 @@ val config :
 (** Build a config from {!default_config}.
     @since 0.12 *)
 
+val add_dir_path :
+  config:config -> dir:string -> prefix:string -> Tiny_httpd_server.t -> unit
 (** [add_dirpath ~config ~dir ~prefix server] adds route handle to the
     [server] to serve static files in [dir] when url starts with [prefix],
     using the given configuration [config]. *)
-val add_dir_path :
-  config:config ->
-  dir:string ->
-  prefix:string ->
-  Tiny_httpd_server.t -> unit
 
 (** Virtual file system.
 
@@ -125,7 +111,8 @@ val add_vfs :
   config:config ->
   vfs:(module VFS) ->
   prefix:string ->
-  Tiny_httpd_server.t -> unit
+  Tiny_httpd_server.t ->
+  unit
 (** Similar to {!add_dir_path} but using a virtual file system instead.
     @since 0.12
 *)

src/Tiny_httpd_html.ml

@@ -1,4 +1,3 @@
-
 (** HTML combinators.
 
     This module provides combinators to produce html. It doesn't enforce
@@ -7,13 +6,13 @@
     @since 0.12
 *)
 
-(** @inline *)
 include Tiny_httpd_html_
+(** @inline *)
 
 (** 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 to_string ?(top = false) (self : elt) : string =
   let out = Out.create () in
   if top then Out.add_string out "<!DOCTYPE html>\n";
   self out;
@@ -23,14 +22,18 @@ let to_string ?(top=false) (self:elt) : 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 to_string_l (l : elt list) =
   let out = Out.create () in
-  List.iter (fun f -> f out; Out.add_format_nl out) l;
+  List.iter
+    (fun f ->
+      f out;
+      Out.add_format_nl out)
+    l;
   Out.to_string out
 
 let to_string_top = to_string ~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 =
+let to_stream (self : elt) : Tiny_httpd_stream.t =
   Tiny_httpd_stream.of_string @@ to_string self

src/Tiny_httpd_server.mli

@@ -1,4 +1,3 @@
-
 (** HTTP server.
 
     This module implements a very simple, basic HTTP/1.1 server using blocking
@@ -15,14 +14,7 @@ type byte_stream = Tiny_httpd_stream.t
 (** {2 Methods} *)
 
 module Meth : sig
-  type t = [
+  type t = [ `GET | `PUT | `POST | `HEAD | `DELETE | `OPTIONS ]
-    | `GET
-    | `PUT
-    | `POST
-    | `HEAD
-    | `DELETE
-    | `OPTIONS
-  ]
   (** A HTTP method.
       For now we only handle a subset of these.
 
@@ -47,7 +39,7 @@ module Headers : sig
   (** Empty list of headers
       @since 0.5 *)
 
-  val get : ?f:(string->string) -> string -> t -> string option
+  val get : ?f:(string -> string) -> string -> t -> string option
   (** [get k headers] looks for the header field with key [k].
       @param f if provided, will transform the value before it is returned. *)
 
@@ -74,10 +66,10 @@ module Request : sig
     meth: Meth.t;
     host: string;
     headers: Headers.t;
-    http_version: int*int;
+    http_version: int * int;
     path: string;
     path_components: string list;
-    query: (string*string) list;
+    query: (string * string) list;
     body: 'body;
     start_time: float;
         (** Obtained via [get_time_s] in {!create}
@@ -105,8 +97,7 @@ module Request : sig
   val headers : _ t -> Headers.t
   (** List of headers of the request, including ["Host"] *)
 
-  val get_header : ?f:(string->string) -> _ t -> string -> string option
+  val get_header : ?f:(string -> string) -> _ t -> string -> string option
-
   val get_header_int : _ t -> string -> int option
 
   val set_header : string -> string -> 'a t -> 'a t
@@ -129,7 +120,7 @@ module Request : sig
   val path : _ t -> string
   (** Request path. *)
 
-  val query : _ t -> (string*string) list
+  val query : _ t -> (string * string) list
   (** Decode the query part of the {!path} field
       @since 0.4 *)
 
@@ -152,11 +143,15 @@ module Request : sig
       @param buf_size initial size of underlying buffer (since 0.11) *)
 
   (**/**)
+
   (* for testing purpose, do not use *)
   module Internal_ : sig
-    val parse_req_start : ?buf:buf -> get_time_s:(unit -> float) -> byte_stream -> unit t option
+    val parse_req_start :
+      ?buf:buf -> get_time_s:(unit -> float) -> byte_stream -> unit t option
+
     val parse_body : ?buf:buf -> unit t -> byte_stream -> byte_stream t
   end
+
   (**/**)
 end
 
@@ -185,13 +180,14 @@ end
     the client to answer a {!Request.t}*)
 
 module Response : sig
-  type body = [`String of string | `Stream of byte_stream | `Void]
+  type body = [ `String of string | `Stream of byte_stream | `Void ]
   (** Body of a response, either as a simple string,
       or a stream of bytes, or nothing (for server-sent events). *)
 
   type t = private {
     code: Response_code.t;  (** HTTP response code. See {!Response_code}. *)
-    headers: Headers.t; (** Headers of the reply. Some will be set by [Tiny_httpd] automatically. *)
+    headers: Headers.t;
+        (** Headers of the reply. Some will be set by [Tiny_httpd] automatically. *)
     body: body;  (** Body of the response. Can be empty. *)
   }
   (** A response to send back to a client. *)
@@ -216,19 +212,12 @@ module Response : sig
   (** Set the response code.
       @since 0.11 *)
 
-  val make_raw :
+  val make_raw : ?headers:Headers.t -> code:Response_code.t -> string -> t
-    ?headers:Headers.t ->
-    code:Response_code.t ->
-    string ->
-    t
   (** Make a response from its raw components, with a string body.
       Use [""] to not send a body at all. *)
 
   val make_raw_stream :
-    ?headers:Headers.t ->
+    ?headers:Headers.t -> code:Response_code.t -> byte_stream -> t
-    code:Response_code.t ->
-    byte_stream ->
-    t
   (** Same as {!make_raw} but with a stream body. The body will be sent with
       the chunked transfer-encoding. *)
 
@@ -236,9 +225,7 @@ module Response : sig
   (** Return a response without a body at all.
       @since NEXT_RELEASE *)
 
-  val make :
+  val make : ?headers:Headers.t -> (body, Response_code.t * string) result -> t
-    ?headers:Headers.t ->
-    (body, Response_code.t * string) result -> t
   (** [make r] turns a result into a response.
 
       - [make (Ok body)] replies with [200] and the body.
@@ -247,17 +234,15 @@ module Response : sig
   *)
 
   val make_string :
-    ?headers:Headers.t ->
+    ?headers:Headers.t -> (string, Response_code.t * string) result -> t
-    (string, Response_code.t * string) result -> t
   (** Same as {!make} but with a string body. *)
 
   val make_stream :
-    ?headers:Headers.t ->
+    ?headers:Headers.t -> (byte_stream, Response_code.t * string) result -> t
-    (byte_stream, Response_code.t * string) result -> t
   (** Same as {!make} but with a stream body. *)
 
-  val fail : ?headers:Headers.t -> code:int ->
+  val fail :
-    ('a, unit, string, t) format4 -> 'a
+    ?headers:Headers.t -> code:int -> ('a, unit, string, t) format4 -> 'a
   (** Make the current request fail with the given code and message.
       Example: [fail ~code:404 "oh noes, %s not found" "waldo"].
   *)
@@ -308,11 +293,11 @@ module Route : sig
       This will match the entirety of the remaining route.
       @since 0.7 *)
 
-  val (@/) : ('a, 'b) comp -> ('b, 'c) t -> ('a, 'c) t
+  val ( @/ ) : ('a, 'b) comp -> ('b, 'c) t -> ('a, 'c) t
   (** [comp / route] matches ["foo/bar/…"] iff [comp] matches ["foo"],
       and [route] matches ["bar/…"]. *)
 
-  val exact_path : string -> ('a,'b) t -> ('a,'b) t
+  val exact_path : string -> ('a, 'b) t -> ('a, 'b) t
   (** [exact_path "foo/bar/..." r] is equivalent to
       [exact "foo" @/ exact "bar" @/ ... @/ r]
       @since 0.11 **)
@@ -366,7 +351,7 @@ val create :
   ?addr:string ->
   ?port:int ->
   ?sock:Unix.file_descr ->
-  ?middlewares:([`Encoding | `Stage of int] * Middleware.t) list ->
+  ?middlewares:([ `Encoding | `Stage of int ] * Middleware.t) list ->
   unit ->
   t
 (** Create a new webserver.
@@ -416,8 +401,9 @@ val active_connections : t -> int
 
 val add_decode_request_cb :
   t ->
-  (unit Request.t -> (unit Request.t * (byte_stream -> byte_stream)) option) -> unit
+  (unit Request.t -> (unit Request.t * (byte_stream -> byte_stream)) option) ->
-[@@deprecated "use add_middleware"]
+  unit
+  [@@deprecated "use add_middleware"]
 (** Add a callback for every request.
     The callback can provide a stream transformer and a new request (with
     modified headers, typically).
@@ -427,9 +413,9 @@ val add_decode_request_cb :
     @deprecated use {!add_middleware} instead
 *)
 
-val add_encode_response_cb:
+val add_encode_response_cb :
   t -> (unit Request.t -> Response.t -> Response.t option) -> unit
-[@@deprecated "use add_middleware"]
+  [@@deprecated "use add_middleware"]
 (** Add a callback for every request/response pair.
     Similarly to {!add_encode_response_cb} the callback can return a new
     response, for example to compress it.
@@ -440,8 +426,7 @@ val add_encode_response_cb:
 *)
 
 val add_middleware :
-  stage:[`Encoding | `Stage of int] ->
+  stage:[ `Encoding | `Stage of int ] -> t -> Middleware.t -> unit
-  t -> Middleware.t -> unit
 (** Add a middleware to every request/response pair.
     @param stage specify when middleware applies.
       Encoding comes first (outermost layer), then stages in increasing order.
@@ -463,7 +448,8 @@ val add_route_handler :
   ?middlewares:Middleware.t list ->
   ?meth:Meth.t ->
   t ->
-  ('a, string Request.t -> Response.t) Route.t -> 'a ->
+  ('a, string Request.t -> Response.t) Route.t ->
+  'a ->
   unit
 (** [add_route_handler server Route.(exact "path" @/ string @/ int @/ return) f]
     calls [f "foo" 42 request] when a [request] with path "path/foo/42/"
@@ -489,7 +475,8 @@ val add_route_handler_stream :
   ?middlewares:Middleware.t list ->
   ?meth:Meth.t ->
   t ->
-  ('a, byte_stream Request.t -> Response.t) Route.t -> 'a ->
+  ('a, byte_stream Request.t -> Response.t) Route.t ->
+  'a ->
   unit
 (** Similar to {!add_route_handler}, but where the body of the request
     is a stream of bytes that has not been read yet.
@@ -517,11 +504,7 @@ module type SERVER_SENT_GENERATOR = sig
       already sent too). *)
 
   val send_event :
-    ?event:string ->
+    ?event:string -> ?id:string -> ?retry:string -> data:string -> unit -> unit
-    ?id:string ->
-    ?retry:string ->
-    data:string ->
-    unit -> unit
   (** Send an event from the server.
       If data is a multiline string, it will be sent on separate "data:" lines. *)
 
@@ -537,7 +520,8 @@ type server_sent_generator = (module SERVER_SENT_GENERATOR)
 val add_route_server_sent_handler :
   ?accept:(unit Request.t -> (unit, Response_code.t * string) result) ->
   t ->
-  ('a, string Request.t -> server_sent_generator -> unit) Route.t -> 'a ->
+  ('a, string Request.t -> server_sent_generator -> unit) Route.t ->
+  'a ->
   unit
 (** Add a handler on an endpoint, that serves server-sent events.
 
@@ -568,7 +552,9 @@ val run : t -> (unit, exn) result
 
 (**/**)
 
-val _debug : ((('a, out_channel, unit, unit, unit, unit) format6 -> 'a) -> unit) -> unit
+val _debug :
-val _enable_debug: bool -> unit
+  ((('a, out_channel, unit, unit, unit, unit) format6 -> 'a) -> unit) -> unit
+
+val _enable_debug : bool -> unit
 
 (**/**)

src/Tiny_httpd_stream.ml

@@ -1,51 +1,52 @@
-
 module Buf = Tiny_httpd_buf
 
 let spf = Printf.sprintf
 
 type hidden = unit
+
 type t = {
   mutable bs: bytes;
-  mutable off : int;
+  mutable off: int;
-  mutable len : int;
+  mutable len: int;
   fill_buf: unit -> unit;
   consume: int -> unit;
   close: unit -> unit;
   _rest: hidden;
 }
 
-let[@inline] close self = self.close()
+let[@inline] close self = self.close ()
 
-let empty = {
+let empty =
-  bs=Bytes.empty;
+  {
-  off=0;
+    bs = Bytes.empty;
-  len=0;
+    off = 0;
-  fill_buf=ignore;
+    len = 0;
-  consume=ignore;
+    fill_buf = ignore;
-  close=ignore;
+    consume = ignore;
-  _rest=();
+    close = ignore;
-}
+    _rest = ();
+  }
 
-let make ?(bs=Bytes.create @@ 16 * 1024) ?(close=ignore) ~consume ~fill () : t =
+let make ?(bs = Bytes.create @@ (16 * 1024)) ?(close = ignore) ~consume ~fill ()
-  let rec self = {
+    : t =
+  let rec self =
+    {
       bs;
-    off=0;
+      off = 0;
-    len=0;
+      len = 0;
-    close=(fun () -> close self);
+      close = (fun () -> close self);
-    fill_buf=(fun () ->
+      fill_buf = (fun () -> if self.len = 0 then fill self);
-        if self.len = 0 then fill self);
+      consume =
-    consume=
         (fun n ->
           assert (n <= self.len);
-         consume self n
+          consume self n);
-      );
+      _rest = ();
-    _rest=();
+    }
-  } in
+  in
   self
 
-let of_chan_ ?(buf_size=16 * 1024) ~close ic : t =
+let of_chan_ ?(buf_size = 16 * 1024) ~close ic : t =
-  make
+  make ~bs:(Bytes.create buf_size)
-    ~bs:(Bytes.create buf_size)
     ~close:(fun _ -> close ic)
     ~consume:(fun self n ->
       self.off <- self.off + n;
@@ -53,17 +54,15 @@ let of_chan_ ?(buf_size=16 * 1024) ~close ic : t =
     ~fill:(fun self ->
       if self.off >= self.len then (
         self.off <- 0;
-          self.len <- input ic self.bs 0 (Bytes.length self.bs);
+        self.len <- input ic self.bs 0 (Bytes.length self.bs)
-        )
+      ))
-      )
     ()
 
 let of_chan = of_chan_ ~close:close_in
 let of_chan_close_noerr = of_chan_ ~close:close_in_noerr
 
-let of_fd_ ?(buf_size=16 * 1024) ~close ic : t =
+let of_fd_ ?(buf_size = 16 * 1024) ~close ic : t =
-  make
+  make ~bs:(Bytes.create buf_size)
-    ~bs:(Bytes.create buf_size)
     ~close:(fun _ -> close ic)
     ~consume:(fun self n ->
       self.off <- self.off + n;
@@ -71,28 +70,27 @@ let of_fd_ ?(buf_size=16 * 1024) ~close ic : t =
     ~fill:(fun self ->
       if self.off >= self.len then (
         self.off <- 0;
-          self.len <- Unix.read ic self.bs 0 (Bytes.length self.bs);
+        self.len <- Unix.read ic self.bs 0 (Bytes.length self.bs)
-        )
+      ))
-      )
     ()
 
 let of_fd = of_fd_ ~close:Unix.close
 let of_fd_close_noerr = of_fd_ ~close:(fun f -> try Unix.close f with _ -> ())
 
-let rec iter f (self:t) : unit =
+let rec iter f (self : t) : unit =
-  self.fill_buf();
+  self.fill_buf ();
-  if self.len=0 then (
+  if self.len = 0 then
-    self.close();
+    self.close ()
-  ) else (
+  else (
     f self.bs self.off self.len;
     self.consume self.len;
     (iter [@tailcall]) f self
   )
 
-let to_chan (oc:out_channel) (self:t) =
+let to_chan (oc : out_channel) (self : t) =
   iter (fun s i len -> output oc s i len) self
 
-let of_bytes ?(i=0) ?len (bs:bytes) : t =
+let of_bytes ?(i = 0) ?len (bs : bytes) : t =
   (* invariant: !i+!len is constant *)
   let len =
     match len with
@@ -102,25 +100,22 @@ let of_bytes ?(i=0) ?len (bs:bytes) : t =
     | None -> Bytes.length bs - i
   in
   let self =
-    make
+    make ~bs ~fill:ignore
-      ~bs ~fill:ignore
       ~close:(fun self -> self.len <- 0)
       ~consume:(fun self n ->
-          assert (n>=0 && n<= self.len);
+        assert (n >= 0 && n <= self.len);
         self.off <- n + self.off;
-          self.len <- self.len - n
+        self.len <- self.len - n)
-        )
       ()
   in
   self.off <- i;
   self.len <- len;
   self
 
-let of_string s : t =
+let of_string s : t = of_bytes (Bytes.unsafe_of_string s)
-  of_bytes (Bytes.unsafe_of_string s)
 
 let with_file ?buf_size file f =
-  let ic = Unix.(openfile file [O_RDONLY] 0) in
+  let ic = Unix.(openfile file [ O_RDONLY ] 0) in
   try
     let x = f (of_fd ?buf_size ic) in
     Unix.close ic;
@@ -129,81 +124,78 @@ let with_file ?buf_size file f =
     Unix.close ic;
     raise e
 
-let read_all ?(buf=Buf.create()) (self:t) : string =
+let read_all ?(buf = Buf.create ()) (self : t) : string =
   let continue = ref true in
   while !continue do
-    self.fill_buf();
+    self.fill_buf ();
     if self.len > 0 then (
       Buf.add_bytes buf self.bs self.off self.len;
-      self.consume self.len;
+      self.consume self.len
     );
     assert (self.len >= 0);
-    if self.len = 0 then (
+    if self.len = 0 then continue := false
-      continue := false
-    )
   done;
   Buf.contents_and_clear buf
 
 (* put [n] bytes from the input into bytes *)
-let read_exactly_ ~too_short (self:t) (bytes:bytes) (n:int) : unit =
+let read_exactly_ ~too_short (self : t) (bytes : bytes) (n : int) : unit =
   assert (Bytes.length bytes >= n);
   let offset = ref 0 in
   while !offset < n do
-    self.fill_buf();
+    self.fill_buf ();
     let n_read = min self.len (n - !offset) in
     Bytes.blit self.bs self.off bytes !offset n_read;
     offset := !offset + n_read;
     self.consume n_read;
-    if n_read=0 then too_short();
+    if n_read = 0 then too_short ()
   done
 
 (* read a line into the buffer, after clearing it. *)
-let read_line_into (self:t) ~buf : unit =
+let read_line_into (self : t) ~buf : unit =
   Buf.clear buf;
   let continue = ref true in
   while !continue do
-    self.fill_buf();
+    self.fill_buf ();
-    if self.len=0 then (
+    if self.len = 0 then (
       continue := false;
-      if Buf.size buf = 0 then raise End_of_file;
+      if Buf.size buf = 0 then raise End_of_file
     );
     let j = ref self.off in
     while !j < self.off + self.len && Bytes.get self.bs !j <> '\n' do
       incr j
     done;
-    if !j-self.off < self.len then (
+    if !j - self.off < self.len then (
       assert (Bytes.get self.bs !j = '\n');
-      Buf.add_bytes buf self.bs self.off (!j-self.off); (* without \n *)
+      Buf.add_bytes buf self.bs self.off (!j - self.off);
-      self.consume (!j-self.off+1); (* remove \n *)
+      (* without \n *)
+      self.consume (!j - self.off + 1);
+      (* remove \n *)
       continue := false
     ) else (
       Buf.add_bytes buf self.bs self.off self.len;
-      self.consume self.len;
+      self.consume self.len
     )
   done
 
 (* new stream with maximum size [max_size].
    @param close_rec if true, closing this will also close the input stream
    @param too_big called with read size if the max size is reached *)
-let limit_size_to ~close_rec ~max_size ~too_big (arg:t) : t =
+let limit_size_to ~close_rec ~max_size ~too_big (arg : t) : t =
   let size = ref 0 in
   let continue = ref true in
-  make
+  make ~bs:Bytes.empty
-    ~bs:Bytes.empty
+    ~close:(fun _ -> if close_rec then arg.close ())
-    ~close:(fun _ ->
-        if close_rec then arg.close ())
     ~fill:(fun res ->
       if res.len = 0 && !continue then (
-           arg.fill_buf();
+        arg.fill_buf ();
         res.bs <- arg.bs;
         res.off <- arg.off;
-           res.len <- arg.len;
+        res.len <- arg.len
       ) else (
         arg.bs <- Bytes.empty;
         arg.off <- 0;
-           arg.len <- 0;
+        arg.len <- 0
-         )
+      ))
-      )
     ~consume:(fun res n ->
       size := !size + n;
       if !size > max_size then (
@@ -212,15 +204,15 @@ let limit_size_to ~close_rec ~max_size ~too_big (arg:t) : t =
       ) else (
         arg.consume n;
         res.off <- res.off + n;
-          res.len <- res.len - n;
+        res.len <- res.len - n
       ))
     ()
 
 (* read exactly [size] bytes from the stream *)
-let read_exactly ~close_rec ~size ~too_short (arg:t) : t =
+let read_exactly ~close_rec ~size ~too_short (arg : t) : t =
-  if size=0 then (
+  if size = 0 then
     empty
-  ) else (
+  else (
     let size = ref size in
     make ~bs:Bytes.empty
       ~fill:(fun res ->
@@ -228,53 +220,52 @@ let read_exactly ~close_rec ~size ~too_short (arg:t) : t =
         if !size = 0 then (
           res.bs <- Bytes.empty;
           res.off <- 0;
-            res.len <- 0;
+          res.len <- 0
         ) else (
-            arg.fill_buf();
+          arg.fill_buf ();
           res.bs <- arg.bs;
           res.off <- arg.off;
           let len = min arg.len !size in
-            if len = 0 && !size > 0 then (
+          if len = 0 && !size > 0 then too_short !size;
-              too_short !size;
+          res.len <- len
-            );
-            res.len <- len;
         ))
       ~close:(fun _res ->
         (* close underlying stream if [close_rec] *)
-          if close_rec then arg.close();
+        if close_rec then arg.close ();
-          size := 0
+        size := 0)
-        )
       ~consume:(fun res n ->
         let n = min n !size in
         size := !size - n;
         arg.consume n;
         res.off <- res.off + n;
-          res.len <- res.len - n;
+        res.len <- res.len - n)
-        )
       ()
   )
 
-let read_line ?(buf=Buf.create()) self : string =
+let read_line ?(buf = Buf.create ()) self : string =
   read_line_into self ~buf;
   Buf.contents buf
 
-let read_chunked ?(buf=Buf.create()) ~fail (bs:t) : t=
+let read_chunked ?(buf = Buf.create ()) ~fail (bs : t) : t =
   let first = ref true in
   let read_next_chunk_len () : int =
-    if !first then (
+    if !first then
       first := false
-    ) else (
+    else (
       let line = read_line ~buf bs in
-      if String.trim line <> "" then raise (fail "expected crlf between chunks";)
+      if String.trim line <> "" then raise (fail "expected crlf between chunks")
     );
     let line = read_line ~buf bs in
     (* parse chunk length, ignore extensions *)
-    let chunk_size = (
+    let chunk_size =
-      if String.trim line = "" then 0
+      if String.trim line = "" then
-      else
+        0
+      else (
         try Scanf.sscanf line "%x %s@\r" (fun n _ext -> n)
-        with _ -> raise (fail (spf "cannot read chunk size from line %S" line))
+        with _ ->
-    ) in
+          raise (fail (spf "cannot read chunk size from line %S" line))
+      )
+    in
     chunk_size
   in
   let refill = ref true in
@@ -284,9 +275,7 @@ let read_chunked ?(buf=Buf.create()) ~fail (bs:t) : t=
     ~fill:(fun self ->
       (* do we need to refill? *)
       if self.off >= self.len then (
-          if !chunk_size = 0 && !refill then (
+        if !chunk_size = 0 && !refill then chunk_size := read_next_chunk_len ();
-            chunk_size := read_next_chunk_len();
-          );
         self.off <- 0;
         self.len <- 0;
         if !chunk_size > 0 then (
@@ -296,36 +285,31 @@ let read_chunked ?(buf=Buf.create()) ~fail (bs:t) : t=
             ~too_short:(fun () -> raise (fail "chunk is too short"))
             bs self.bs to_read;
           self.len <- to_read;
-            chunk_size := !chunk_size - to_read;
+          chunk_size := !chunk_size - to_read
-          ) else (
+        ) else
-            refill := false; (* stream is finished *)
+          refill := false (* stream is finished *)
-          )
+      ))
-        );
-      )
     ~consume:(fun self n ->
       self.off <- self.off + n;
       self.len <- self.len - n)
     ~close:(fun self ->
       (* close this overlay, do not close underlying stream *)
       self.len <- 0;
-        refill:= false
+      refill := false)
-      )
     ()
 
 (* print a stream as a series of chunks *)
-let output_chunked (oc:out_channel) (self:t) : unit =
+let output_chunked (oc : out_channel) (self : t) : unit =
   let continue = ref true in
   while !continue do
     (* next chunk *)
-    self.fill_buf();
+    self.fill_buf ();
     let n = self.len in
     Printf.fprintf oc "%x\r\n" n;
     output oc self.bs self.off n;
     self.consume n;
-    if n = 0 then (
+    if n = 0 then continue := false;
-      continue := false;
+    output_string oc "\r\n"
-    );
-    output_string oc "\r\n";
   done;
   (* write another crlf after the stream (see #56) *)
   output_string oc "\r\n";

src/Tiny_httpd_stream.mli

@@ -1,4 +1,3 @@
-
 (** Byte streams.
 
     These used to live in {!Tiny_httpd} but are now in their own module.
@@ -8,31 +7,21 @@ type hidden
 (** Type used to make {!t} unbuildable via a record literal. Use {!make} instead. *)
 
 type t = {
-  mutable bs: bytes;
+  mutable bs: bytes;  (** The bytes *)
-  (** The bytes *)
+  mutable off: int;  (** Beginning of valid slice in {!bs} *)
-
+  mutable len: int;
-  mutable off : int;
-  (** Beginning of valid slice in {!bs} *)
-
-  mutable len : int;
       (** Length of valid slice in {!bs}. If [len = 0] after
       a call to {!fill}, then the stream is finished. *)
-
   fill_buf: unit -> unit;
       (** See the current slice of the internal buffer as [bytes, i, len],
       where the slice is [bytes[i] .. [bytes[i+len-1]]].
       Can block to refill the buffer if there is currently no content.
       If [len=0] then there is no more data. *)
-
   consume: int -> unit;
       (** Consume [n] bytes from the buffer.
       This should only be called with [n <= len]. *)
-
+  close: unit -> unit;  (** Close the stream. *)
-  close: unit -> unit;
+  _rest: hidden;  (** Use {!make} to build a stream. *)
-  (** Close the stream. *)
-
-  _rest: hidden;
-  (** Use {!make} to build a stream. *)
 }
 (** A buffered stream, with a view into the current buffer (or refill if empty),
     and a function to consume [n] bytes.
@@ -75,7 +64,8 @@ val make :
   ?close:(t -> unit) ->
   consume:(t -> int -> unit) ->
   fill:(t -> unit) ->
-  unit -> t
+  unit ->
+  t
 (** [make ~fill ()] creates a byte stream.
     @param fill is used to refill the buffer, and is called initially.
     @param close optional closing.
@@ -95,18 +85,12 @@ val read_all : ?buf:Tiny_httpd_buf.t -> t -> string
     @param buf a buffer to (re)use. Its content will be cleared. *)
 
 val limit_size_to :
-  close_rec:bool ->
+  close_rec:bool -> max_size:int -> too_big:(int -> unit) -> t -> t
-  max_size:int ->
-  too_big:(int -> unit) ->
-  t -> t
 (* New stream with maximum size [max_size].
    @param close_rec if true, closing this will also close the input stream
    @param too_big called with read size if the max size is reached *)
 
-val read_chunked :
+val read_chunked : ?buf:Tiny_httpd_buf.t -> fail:(string -> exn) -> t -> t
-  ?buf:Tiny_httpd_buf.t ->
-  fail:(string -> exn) ->
-  t -> t
 (** Convert a stream into a stream of byte chunks using
     the chunked encoding. The size of chunks is not specified.
     @param buf buffer used for intermediate storage.
@@ -114,8 +98,7 @@ val read_chunked :
 *)
 
 val read_exactly :
-  close_rec:bool -> size:int -> too_short:(int -> unit) ->
+  close_rec:bool -> size:int -> too_short:(int -> unit) -> t -> t
-  t -> t
 (** [read_exactly ~size bs] returns a new stream that reads exactly
     [size] bytes from [bs], and then closes.
     @param close_rec if true, closing the resulting stream also closes

src/Tiny_httpd_util.ml

@@ -1,4 +1,3 @@
-
 (* test utils *)
 (*$inject
   let pp_res f = function Ok x -> f x | Error e -> e
@@ -9,17 +8,15 @@
   let is_ascii_char c = Char.code c < 128
 *)
 
-let percent_encode ?(skip=fun _->false) s =
+let percent_encode ?(skip = fun _ -> false) s =
   let buf = Buffer.create (String.length s) in
   String.iter
     (function
       | c when skip c -> Buffer.add_char buf c
-      | (' ' | '!' | '"' | '#' | '$' | '%' | '&' | '\'' | '(' | ')' | '*' | '+'
+      | ( ' ' | '!' | '"' | '#' | '$' | '%' | '&' | '\'' | '(' | ')' | '*' | '+'
-        | ',' | '/' | ':' | ';' | '=' | '?' | '@' | '[' | ']' | '~')
+        | ',' | '/' | ':' | ';' | '=' | '?' | '@' | '[' | ']' | '~' ) as c ->
-        as c ->
-        Printf.bprintf buf "%%%X" (Char.code c)
-      | c when Char.code c > 127 ->
         Printf.bprintf buf "%%%X" (Char.code c)
+      | c when Char.code c > 127 -> Printf.bprintf buf "%%%X" (Char.code c)
       | c -> Buffer.add_char buf c)
     s;
   Buffer.contents buf
@@ -34,26 +31,28 @@ let percent_encode ?(skip=fun _->false) s =
   (Some "?") (percent_decode @@ percent_encode "?")
 *)
 
-let hex_int (s:string) : int = Scanf.sscanf s "%x" (fun x->x)
+let hex_int (s : string) : int = Scanf.sscanf s "%x" (fun x -> x)
 
-let percent_decode (s:string) : _ option =
+let percent_decode (s : string) : _ option =
   let buf = Buffer.create (String.length s) in
   let i = ref 0 in
   try
     while !i < String.length s do
       match String.get s !i with
       | '%' ->
-        if !i+2 < String.length s then (
+        if !i + 2 < String.length s then (
-          begin match hex_int @@ String.sub s (!i+1) 2 with
+          (match hex_int @@ String.sub s (!i + 1) 2 with
           | n -> Buffer.add_char buf (Char.chr n)
-            | exception _ -> raise Exit
+          | exception _ -> raise Exit);
-          end;
+          i := !i + 3
-          i := !i + 3;
+        ) else
-        ) else (
           raise Exit (* truncated *)
-        )
+      | '+' ->
-      | '+' -> Buffer.add_char buf ' '; incr i (* for query strings *)
+        Buffer.add_char buf ' ';
-      | c -> Buffer.add_char buf c; incr i
+        incr i (* for query strings *)
+      | c ->
+        Buffer.add_char buf c;
+        incr i
     done;
     Some (Buffer.contents buf)
   with Exit -> None
@@ -77,7 +76,7 @@ let get_non_query_path s =
 
 let get_query s : string =
   match find_q_index_ s with
-  | i -> String.sub s (i+1) (String.length s-i-1)
+  | i -> String.sub s (i + 1) (String.length s - i - 1)
   | exception Not_found -> ""
 
 let split_query s = get_non_query_path s, get_query s
@@ -89,16 +88,11 @@ let split_on_slash s : _ list =
   while !i < n do
     match String.index_from s !i '/' with
     | exception Not_found ->
-      if !i < n then (
+      if !i < n then (* last component *) l := String.sub s !i (n - !i) :: !l;
-        (* last component *)
-        l := String.sub s !i (n - !i) :: !l;
-      );
       i := n (* done *)
     | j ->
-      if j > !i then  (
+      if j > !i then l := String.sub s !i (j - !i) :: !l;
-        l := String.sub s !i (j - !i) :: !l;
+      i := j + 1
-      );
-      i := j+1;
   done;
   List.rev !l
 
@@ -112,31 +106,38 @@ let split_on_slash s : _ list =
   [] (split_on_slash "//")
 *)
 
-let parse_query s : (_ list, string) result=
+let parse_query s : (_ list, string) result =
   let pairs = ref [] in
-  let is_sep_ = function '&' | ';' -> true | _ -> false in
+  let is_sep_ = function
+    | '&' | ';' -> true
+    | _ -> false
+  in
   let i = ref 0 in
   let j = ref 0 in
   try
     let percent_decode s =
-      match percent_decode s with Some x -> x | None -> raise Invalid_query
+      match percent_decode s with
+      | Some x -> x
+      | None -> raise Invalid_query
     in
     let parse_pair () =
       let eq = String.index_from s !i '=' in
-      let k = percent_decode @@ String.sub s !i (eq- !i) in
+      let k = percent_decode @@ String.sub s !i (eq - !i) in
-      let v = percent_decode @@ String.sub s (eq+1) (!j-eq-1) in
+      let v = percent_decode @@ String.sub s (eq + 1) (!j - eq - 1) in
-      pairs := (k,v) :: !pairs;
+      pairs := (k, v) :: !pairs
     in
     while !i < String.length s do
-      while !j < String.length s && not (is_sep_ (String.get s !j)) do incr j done;
+      while !j < String.length s && not (is_sep_ (String.get s !j)) do
+        incr j
+      done;
       if !j < String.length s then (
         assert (is_sep_ (String.get s !j));
-        parse_pair();
+        parse_pair ();
-        i := !j+1;
+        i := !j + 1;
-        j := !i;
+        j := !i
       ) else (
-        parse_pair();
+        parse_pair ();
-        i := String.length s; (* done *)
+        i := String.length s (* done *)
       )
     done;
     Ok !pairs

src/Tiny_httpd_util.mli

@@ -29,7 +29,7 @@ val get_query : string -> string
 (** Obtain the query part of a path.
     @since 0.4 *)
 
-val parse_query : string -> ((string*string) list, string) result
+val parse_query : string -> ((string * string) list, string) result
 (** Parse a query as a list of ['&'] or [';'] separated [key=value] pairs.
     The order might not be preserved.
     @since 0.3

src/bin/curly.ml

@@ -1,11 +1,12 @@
 module Result = struct
   include Result
-  let (>>=)
+
-    : type a b e. (a, e) result -> (a -> (b, e) result) -> (b, e) result
+  let ( >>= ) :
-    = fun r f ->
+      type a b e. (a, e) result -> (a -> (b, e) result) -> (b, e) result =
+   fun r f ->
     match r with
     | Ok x -> f x
-      | (Error _) as e -> e
+    | Error _ as e -> e
 end
 
 open Result
@@ -21,8 +22,7 @@ module Meth = struct
     | `TRACE
     | `CONNECT
     | `PATCH
-    | `Other of string
+    | `Other of string ]
-    ]
 
   let to_string = function
     | `GET -> "GET"
@@ -46,44 +46,31 @@ module Header = struct
 
   let to_cmd t =
     t
-    |> List.map (fun (k, v) -> ["-H"; Printf.sprintf "%s: %s" k v])
+    |> List.map (fun (k, v) -> [ "-H"; Printf.sprintf "%s: %s" k v ])
     |> List.concat
 
   let pp fmt t =
-    Format.pp_print_list
+    Format.pp_print_list ~pp_sep:Format.pp_print_newline
-      ~pp_sep:Format.pp_print_newline
+      (fun fmt (k, v) -> Format.fprintf fmt "%s: %s\n" k v)
-      (fun fmt (k ,v) -> Format.fprintf fmt "%s: %s\n" k v)
       fmt t
 end
 
 module Response = struct
-  type t = Http.response =
+  type t = Http.response = { code: int; headers: Header.t; body: string }
-    { code: int
-    ; headers: Header.t
-    ; body: string
-    }
 
-  let default =
+  let default = { code = 0; headers = []; body = "" }
-    { code = 0
-    ; headers = []
-    ; body = "" }
 
   let of_stdout s =
     let lexbuf = Lexing.from_string s in
-    try Ok (Http.response default lexbuf)
+    try Ok (Http.response default lexbuf) with e -> Error e
-    with e -> Error e
 
   let pp fmt t =
-    Format.fprintf fmt "{code=%d;@ headers=%a;@ body=\"%s\"}"
+    Format.fprintf fmt "{code=%d;@ headers=%a;@ body=\"%s\"}" t.code Header.pp
-      t.code Header.pp t.headers t.body
+      t.headers t.body
 end
 
 module Process_result = struct
-  type t =
+  type t = { status: Unix.process_status; stderr: string; stdout: string }
-    { status: Unix.process_status
-    ; stderr: string
-    ; stdout: string
-    }
 
   let pp_process_status fmt = function
     | Unix.WEXITED n -> Format.fprintf fmt "Exit code %d" n
@@ -114,42 +101,35 @@ module Error = struct
 end
 
 module Request = struct
-  type t =
+  type t = { meth: Meth.t; url: string; headers: Header.t; body: string }
-    { meth: Meth.t
-    ; url: string
-    ; headers: Header.t
-    ; body: string
-    }
 
-  let make ?(headers=Header.empty) ?(body="") ~url ~meth () =
+  let make ?(headers = Header.empty) ?(body = "") ~url ~meth () =
-    { meth
+    { meth; url; headers; body }
-    ; url
-    ; headers
-    ; body }
 
   let has_body t = String.length t.body > 0
 
   let validate t =
-    if has_body t && List.mem t.meth [`GET; `HEAD] then
+    if has_body t && List.mem t.meth [ `GET; `HEAD ] then
       Error (Error.Invalid_request "No body is allowed with GET/HEAD methods")
     else
       Ok t
 
   let to_cmd_args t =
     List.concat
-      [ ["-X"; Meth.to_string t.meth]
+      [
-      ; Header.to_cmd t.headers
+        [ "-X"; Meth.to_string t.meth ];
-      ; [t.url]
+        Header.to_cmd t.headers;
-      ; (if has_body t then
+        [ t.url ];
-           ["--data-binary"; "@-"]
+        (if has_body t then
+          [ "--data-binary"; "@-" ]
         else
-           [])
+          []);
       ]
 
   let pp fmt t =
     Format.fprintf fmt
-      "{@ meth=%a;@ url=\"%s\";@ headers=\"%a\";@ body=\"%s\"@ }"
+      "{@ meth=%a;@ url=\"%s\";@ headers=\"%a\";@ body=\"%s\"@ }" Meth.pp t.meth
-      Meth.pp t.meth t.url Header.pp t.headers t.body
+      t.url Header.pp t.headers t.body
 end
 
 let result_of_process_result t =
@@ -158,67 +138,58 @@ let result_of_process_result t =
   | _ -> Error (Error.Bad_exit t)
 
 let run prog args stdin_str =
-  let (stdout, stdin, stderr) =
+  let stdout, stdin, stderr =
-    let prog =
+    let prog = prog :: List.map Filename.quote args |> String.concat " " in
-      prog :: (List.map Filename.quote args)
+    Unix.open_process_full prog [||]
-      |> String.concat " " in
+  in
-    Unix.open_process_full prog [||] in
+  if String.length stdin_str > 0 then output_string stdin stdin_str;
-  if String.length stdin_str > 0 then (
+  (try close_out stdin with _ -> ());
-    output_string stdin stdin_str
-  );
-  begin
-    try close_out stdin;
-    with _ -> ()
-  end;
   let stdout_fd = Unix.descr_of_in_channel stdout in
   let stderr_fd = Unix.descr_of_in_channel stderr in
-  let (in_buf, err_buf) = Buffer.(create 128, create 128) in
+  let in_buf, err_buf = Buffer.(create 128, create 128) in
   let read_buf_len = 512 in
   let read_buf = Bytes.create read_buf_len in
   let input ch =
     match input ch read_buf 0 read_buf_len with
     | 0 -> Error `Eof
-    | s -> Ok s in
+    | s -> Ok s
+  in
   let rec loop = function
     | [] -> ()
     | read_list ->
       let can_read, _, _ = Unix.select read_list [] [] 1.0 in
       let to_remove =
-        List.fold_left (fun to_remove fh ->
+        List.fold_left
-            let (rr, buf) =
+          (fun to_remove fh ->
-              if fh = stderr_fd then (
+            let rr, buf =
-                (input stderr, err_buf)
+              if fh = stderr_fd then
-              ) else (
+                input stderr, err_buf
-                (input stdout, in_buf)
+              else
-              ) in
+                input stdout, in_buf
-            begin match rr with
+            in
+            match rr with
             | Ok len ->
               Buffer.add_subbytes buf read_buf 0 len;
               to_remove
-              | Error `Eof ->
+            | Error `Eof -> fh :: to_remove)
-                fh :: to_remove
+          [] can_read
-            end
-          ) [] can_read in
-      read_list
-      |> List.filter (fun fh -> not (List.mem fh to_remove))
-      |> loop
       in
-  ignore (loop [ stdout_fd ; stderr_fd ]);
+      read_list |> List.filter (fun fh -> not (List.mem fh to_remove)) |> loop
+  in
+  ignore (loop [ stdout_fd; stderr_fd ]);
   let status = Unix.close_process_full (stdout, stdin, stderr) in
-  { Process_result.
+  {
-    status
+    Process_result.status;
-  ; stdout = Buffer.contents in_buf
+    stdout = Buffer.contents in_buf;
-  ; stderr = Buffer.contents err_buf
+    stderr = Buffer.contents err_buf;
   }
 
-let run ?(exe="curl") ?(args=[]) req =
+let run ?(exe = "curl") ?(args = []) req =
   Request.validate req >>= fun req ->
-  let args = "-si" :: (Request.to_cmd_args req) @ args in
+  let args = ("-si" :: Request.to_cmd_args req) @ args in
   let res =
-    try
+    try result_of_process_result (run exe args req.Request.body)
-      result_of_process_result (run exe args req.Request.body)
+    with e -> Error (Error.Exn e)
-    with e ->
-      Error (Error.Exn e)
   in
   res >>= fun res ->
   match Response.of_stdout res.Process_result.stdout with
@@ -227,11 +198,15 @@ let run ?(exe="curl") ?(args=[]) req =
 
 let get ?exe ?args ?headers url =
   run ?exe ?args (Request.make ?headers ~url ~meth:`GET ())
+
 let head ?exe ?args ?headers url =
   run ?exe ?args (Request.make ?headers ~url ~meth:`HEAD ())
+
 let delete ?exe ?args ?headers url =
   run ?exe ?args (Request.make ?headers ~url ~meth:`DELETE ())
+
 let post ?exe ?args ?headers ?body url =
   run ?exe ?args (Request.make ?body ?headers ~url ~meth:`POST ())
+
 let put ?exe ?args ?headers ?body url =
   run ?exe ?args (Request.make ?body ?headers ~url ~meth:`PUT ())

src/bin/curly.mli

@@ -21,42 +21,23 @@ module Header : sig
 end
 
 module Response : sig
-  type t =
+  type t = { code: int; headers: Header.t; body: string }
-    { code: int
-    ; headers: Header.t
-    ; body:string
-    }
 
   val pp : Format.formatter -> t -> unit
 end
 
 module Request : sig
-  type t =
+  type t = { meth: Meth.t; url: string; headers: Header.t; body: string }
-    { meth: Meth.t
-    ; url:string
-    ; headers: Header.t
-    ; body:string
-    }
 
-  val make
+  val make :
-    : ?headers:Header.t
+    ?headers:Header.t -> ?body:string -> url:string -> meth:Meth.t -> unit -> t
-    -> ?body:string
-    -> url:string
-    -> meth:Meth.t
-    -> unit
-    -> t
 
   val to_cmd_args : t -> string list
-
   val pp : Format.formatter -> t -> unit
 end
 
 module Process_result : sig
-  type t =
+  type t = { status: Unix.process_status; stderr: string; stdout: string }
-    { status: Unix.process_status
-    ; stderr:string
-    ; stdout:string
-    }
 
   val pp : Format.formatter -> t -> unit
 end
@@ -71,55 +52,55 @@ module Error : sig
   val pp : Format.formatter -> t -> unit
 end
 
-val run
+val run :
-  : ?exe:string
+  ?exe:string ->
-  -> ?args:string list
+  ?args:string list ->
-  -> Request.t
+  Request.t ->
-  -> (Response.t, Error.t) Result.result
+  (Response.t, Error.t) Result.result
 
-val get
+val get :
-  : ?exe:string
+  ?exe:string ->
-  -> ?args:string list
+  ?args:string list ->
-  -> ?headers:Header.t
+  ?headers:Header.t ->
-  -> string
+  string ->
-  -> (Response.t, Error.t) Result.result
+  (Response.t, Error.t) Result.result
 (** Specialized version of {!run} for method [`GET]
     @since 0.2.0 *)
 
-val head
+val head :
-  : ?exe:string
+  ?exe:string ->
-  -> ?args:string list
+  ?args:string list ->
-  -> ?headers:Header.t
+  ?headers:Header.t ->
-  -> string
+  string ->
-  -> (Response.t, Error.t) Result.result
+  (Response.t, Error.t) Result.result
 (** Specialized version of {!run} for method [`HEAD]
     @since 0.2.0 *)
 
-val delete
+val delete :
-  : ?exe:string
+  ?exe:string ->
-  -> ?args:string list
+  ?args:string list ->
-  -> ?headers:Header.t
+  ?headers:Header.t ->
-  -> string
+  string ->
-  -> (Response.t, Error.t) Result.result
+  (Response.t, Error.t) Result.result
 (** Specialized version of {!run} for method [`DELETE]
     @since 0.2.0 *)
 
-val post 
+val post :
-  : ?exe:string
+  ?exe:string ->
-  -> ?args:string list
+  ?args:string list ->
-  -> ?headers:Header.t
+  ?headers:Header.t ->
-  -> ?body:string
+  ?body:string ->
-  -> string
+  string ->
-  -> (Response.t, Error.t) Result.result
+  (Response.t, Error.t) Result.result
 (** Specialized version of {!run} for method [`POST]
     @since 0.2.0 *)
 
-val put
+val put :
-  : ?exe:string
+  ?exe:string ->
-  -> ?args:string list
+  ?args:string list ->
-  -> ?headers:Header.t
+  ?headers:Header.t ->
-  -> ?body:string
+  ?body:string ->
-  -> string
+  string ->
-  -> (Response.t, Error.t) Result.result
+  (Response.t, Error.t) Result.result
 (** Specialized version of {!run} for method [`PUT]
     @since 0.2.0 *)

src/bin/dune

@@ -1,4 +1,3 @@
-
 (executable
  (name http_of_dir)
  (public_name http_of_dir)

src/bin/http.mli

@@ -1,9 +1,5 @@
 (* The purpose of this module isn't to be a full blown http parser but rather to
    only parse whatever curl otputs *)
-type response =
+type response = { code: int; headers: (string * string) list; body: string }
-  { code: int
-  ; headers: (string * string) list
-  ; body: string
-  }
 
 val response : response -> Lexing.lexbuf -> response

src/bin/http_of_dir.ml

@@ -3,10 +3,14 @@ module U = Tiny_httpd_util
 module D = Tiny_httpd_dir
 module Pf = Printf
 
-let serve ~config (dir:string) addr port j : _ result =
+let serve ~config (dir : string) addr port j : _ result =
   let server = S.create ~max_connections:j ~addr ~port () in
-  Printf.printf "serve directory %s on http://%(%s%):%d\n%!"
+  Printf.printf "serve directory %s on http://%(%s%):%d\n%!" dir
-    dir (if S.is_ipv6 server then "[%s]" else "%s") addr port;
+    (if S.is_ipv6 server then
+      "[%s]"
+    else
+      "%s")
+    addr port;
 
   D.add_dir_path ~config ~dir ~prefix:"" server;
   S.run server
@@ -14,43 +18,62 @@ let serve ~config (dir:string) addr port j : _ result =
 let parse_size s : int =
   try Scanf.sscanf s "%dM" (fun n -> n * 1_024 * 1_024)
   with _ ->
-  try Scanf.sscanf s "%dk" (fun n -> n * 1_024)
+    (try Scanf.sscanf s "%dk" (fun n -> n * 1_024)
      with _ ->
-  try int_of_string s
+       (try int_of_string s
-  with _ -> raise (Arg.Bad "invalid size (expected <int>[kM]?)")
+        with _ -> raise (Arg.Bad "invalid size (expected <int>[kM]?)")))
 
 let main () =
-  let config =
+  let config = D.config ~dir_behavior:Index_or_lists () in
-    D.config ~dir_behavior:Index_or_lists ()
-  in
   let dir_ = ref "." in
   let addr = ref "127.0.0.1" in
   let port = ref 8080 in
   let j = ref 32 in
-  Arg.parse (Arg.align [
+  Arg.parse
+    (Arg.align
+       [
          "--addr", Set_string addr, " address to listen on";
          "-a", Set_string addr, " alias to --listen";
          "--port", Set_int port, " port to listen on";
          "-p", Set_int port, " alias to --port";
          "--dir", Set_string dir_, " directory to serve (default: \".\")";
          "--debug", Unit (fun () -> S._enable_debug true), " debug mode";
-      "--upload", Unit (fun () -> config.upload <- true), " enable file uploading";
+         ( "--upload",
-      "--no-upload", Unit (fun () -> config.upload <- false), " disable file uploading";
+           Unit (fun () -> config.upload <- true),
-      "--download", Unit (fun () -> config.download <- true), " enable file downloading";
+           " enable file uploading" );
-      "--no-download", Unit (fun () -> config.download <- false), " disable file downloading";
+         ( "--no-upload",
-      "--max-upload", String (fun i -> config.max_upload_size <- parse_size i),
+           Unit (fun () -> config.upload <- false),
-        " maximum size of files that can be uploaded";
+           " disable file uploading" );
-      "--auto-index",
+         ( "--download",
-      Bool (fun b -> config.dir_behavior <-
+           Unit (fun () -> config.download <- true),
-               (if b then Index_or_lists else Lists)),
+           " enable file downloading" );
-      " <bool> automatically redirect to index.html if present";
+         ( "--no-download",
-      "--delete", Unit (fun () -> config.delete <- true), " enable `delete` on files";
+           Unit (fun () -> config.download <- false),
-      "--no-delete", Unit (fun () -> config.delete <- false), " disable `delete` on files";
+           " disable file downloading" );
+         ( "--max-upload",
+           String (fun i -> config.max_upload_size <- parse_size i),
+           " maximum size of files that can be uploaded" );
+         ( "--auto-index",
+           Bool
+             (fun b ->
+               config.dir_behavior <-
+                 (if b then
+                   Index_or_lists
+                 else
+                   Lists)),
+           " <bool> automatically redirect to index.html if present" );
+         ( "--delete",
+           Unit (fun () -> config.delete <- true),
+           " enable `delete` on files" );
+         ( "--no-delete",
+           Unit (fun () -> config.delete <- false),
+           " disable `delete` on files" );
          "-j", Set_int j, " maximum number of simultaneous connections";
-    ]) (fun s -> dir_ := s) "http_of_dir [options] [dir]";
+       ])
+    (fun s -> dir_ := s)
+    "http_of_dir [options] [dir]";
   match serve ~config !dir_ !addr !port !j with
   | Ok () -> ()
-  | Error e ->
+  | Error e -> raise e
-    raise e
 
 let () = main ()

src/bin/vfs_pack.ml

@@ -1,7 +1,6 @@
-
 let spf = Printf.sprintf
 let fpf = Printf.fprintf
-let now_ = Unix.gettimeofday()
+let now_ = Unix.gettimeofday ()
 let verbose = ref false
 
 type entry =
@@ -15,83 +14,85 @@ let read_file filename =
   let buf = Buffer.create 32 in
   let b = Bytes.create 1024 in
   while
-    let n=input ic b 0 (Bytes.length b) in
+    let n = input ic b 0 (Bytes.length b) in
     Buffer.add_subbytes buf b 0 n;
     n > 0
-  do () done;
+  do
+    ()
+  done;
   close_in ic;
   Buffer.contents buf
 
-let split_comma s = Scanf.sscanf s "%s@,%s" (fun x y -> x,y)
+let split_comma s = Scanf.sscanf s "%s@,%s" (fun x y -> x, y)
 
 let is_url s =
   let is_prefix pre s =
-    String.length s > String.length pre &&
+    String.length s > String.length pre
-    String.sub s 0 (String.length pre) = pre
+    && String.sub s 0 (String.length pre) = pre
   in
   is_prefix "http://" s || is_prefix "https://" s
 
-let emit oc (l:entry list) : unit =
+let emit oc (l : entry list) : unit =
-  fpf oc "let embedded_fs = Tiny_httpd_dir.Embedded_fs.create ~mtime:%f ()\n" now_;
+  fpf oc "let embedded_fs = Tiny_httpd_dir.Embedded_fs.create ~mtime:%f ()\n"
+    now_;
 
   let add_vfs ~mtime vfs_path content =
     fpf oc
-      "let () = Tiny_httpd_dir.Embedded_fs.add_file embedded_fs \n  \
+      "let () = Tiny_httpd_dir.Embedded_fs.add_file embedded_fs \n\
-       ~mtime:%h ~path:%S\n  \
+      \  ~mtime:%h ~path:%S\n\
-       %S\n"
+      \  %S\n"
       mtime vfs_path content
   in
 
   let rec add_entry = function
     | File (vfs_path, actual_path) ->
-      if !verbose then Printf.eprintf "add file %S = %S\n%!" vfs_path actual_path;
+      if !verbose then
+        Printf.eprintf "add file %S = %S\n%!" vfs_path actual_path;
 
       let content = read_file actual_path in
       let mtime = (Unix.stat actual_path).Unix.st_mtime in
       add_vfs ~mtime vfs_path content
-
     | Url (vfs_path, url) ->
       if !verbose then Printf.eprintf "add url %S = %S\n%!" vfs_path url;
 
-      begin match Curly.get ~args:["-L"] url with
+      (match Curly.get ~args:[ "-L" ] url with
       | Ok b ->
         let code = b.Curly.Response.code in
-          if code >= 200 && code < 300 then (
+        if code >= 200 && code < 300 then
           add_vfs ~mtime:now_ vfs_path b.Curly.Response.body
-          ) else (
+        else
-            failwith (Printf.sprintf "download of %S failed with code: %d" url code)
+          failwith
-          )
+            (Printf.sprintf "download of %S failed with code: %d" url code)
       | Error err ->
-          failwith (Format.asprintf "download of %S failed: %a" url Curly.Error.pp err)
+        failwith
-      end
+          (Format.asprintf "download of %S failed: %a" url Curly.Error.pp err))
-
     | Mirror (vfs_path, dir) ->
-      if !verbose then Printf.eprintf "mirror directory %S as %S\n%!" dir vfs_path;
+      if !verbose then
+        Printf.eprintf "mirror directory %S as %S\n%!" dir vfs_path;
 
       let rec traverse rpath =
         let real_path = Filename.concat dir rpath in
         if Sys.is_directory real_path then (
           let arr = Sys.readdir real_path in
           Array.iter (fun e -> traverse (Filename.concat rpath e)) arr
-        ) else (
+        ) else
           add_entry (File (Filename.concat vfs_path rpath, real_path))
-        )
       in
       traverse "."
-
     | Source_file f ->
       if !verbose then Printf.eprintf "read source file %S\n%!" f;
 
       let lines =
-        read_file f |> String.split_on_char '\n'
+        read_file f |> String.split_on_char '\n' |> List.map String.trim
-        |> List.map String.trim
+        |> List.filter (( <> ) "")
-        |> List.filter ((<>) "")
       in
 
       let process_line line =
         let vfs_path, path = split_comma line in
-        if is_url path then add_entry (Url(vfs_path, path))
+        if is_url path then
-        else add_entry (File (vfs_path, path))
+          add_entry (Url (vfs_path, path))
+        else
+          add_entry (File (vfs_path, path))
       in
 
       List.iter process_line lines
@@ -101,8 +102,8 @@ let emit oc (l:entry list) : unit =
   fpf oc "let vfs = Tiny_httpd_dir.Embedded_fs.to_vfs embedded_fs\n";
   ()
 
-
+let help =
-let help = {|vfs-pack [opt]+
+  {|vfs-pack [opt]+
 
 Builds an OCaml module containing a `Tiny_httpd_dir.Embedded_fs.t`
 virtual file system. This is useful to pack assets into an OCaml binary,
@@ -121,7 +122,6 @@ and is processed as previously. If actual_path looks like an http(s) URL
 it is treated as such.
 |}
 
-
 let () =
   let entries = ref [] in
   let out = ref "" in
@@ -133,30 +133,45 @@ let () =
     add_entry (File (vfs_path, path))
   and add_mirror s =
     let vfs_path, path = split_comma s in
-    let vfs_path, path = if path="" then "", vfs_path else vfs_path, path in
+    let vfs_path, path =
+      if path = "" then
+        "", vfs_path
+      else
+        vfs_path, path
+    in
     add_entry (Mirror (vfs_path, path))
   and add_source f = add_entry (Source_file f)
   and add_url s =
     let vfs_path, path = split_comma s in
-    if is_url path then add_entry (Url(vfs_path, path))
+    if is_url path then
-    else invalid_arg (spf "--url: invalid URL %S" path)
+      add_entry (Url (vfs_path, path))
+    else
+      invalid_arg (spf "--url: invalid URL %S" path)
   in
 
-  let opts = [
+  let opts =
+    [
       "-v", Arg.Set verbose, " verbose mode";
       "-o", Arg.Set_string out, " set output file";
       "--file", Arg.String add_file, " <name,file> adds name=file to the VFS";
       "--url", Arg.String add_url, " <name,url> adds name=url to the VFS";
-    "--mirror", Arg.String add_mirror, " <prefix,dir> copies directory dir into the VFS under prefix";
+      ( "--mirror",
-    "-F", Arg.String add_source, " <file> reads entries from the file, on per line";
+        Arg.String add_mirror,
-  ] |> Arg.align in
+        " <prefix,dir> copies directory dir into the VFS under prefix" );
+      ( "-F",
+        Arg.String add_source,
+        " <file> reads entries from the file, on per line" );
+    ]
+    |> Arg.align
+  in
   Arg.parse opts (fun _ -> raise (Arg.Help "no positional arg")) help;
 
   let out, close =
-    if !out="" then stdout,ignore
+    if !out = "" then
-    else open_out !out, close_out
+      stdout, ignore
+    else
+      open_out !out, close_out
   in
   emit out !entries;
   close out;
   exit 0
-

src/camlzip/Tiny_httpd_camlzip.ml

@@ -1,149 +1,134 @@
-
 module S = Tiny_httpd_server
 module BS = Tiny_httpd_stream
 
-let decode_deflate_stream_ ~buf_size (is:S.byte_stream) : S.byte_stream =
+let decode_deflate_stream_ ~buf_size (is : S.byte_stream) : S.byte_stream =
-  S._debug (fun k->k "wrap stream with deflate.decode");
+  S._debug (fun k -> k "wrap stream with deflate.decode");
   let zlib_str = Zlib.inflate_init false in
   let is_done = ref false in
-  BS.make
+  BS.make ~bs:(Bytes.create buf_size)
-    ~bs:(Bytes.create buf_size)
     ~close:(fun _ ->
       Zlib.inflate_end zlib_str;
-        BS.close is
+      BS.close is)
-      )
     ~consume:(fun self len ->
-        if len > self.len then (
+      if len > self.len then
         S.Response.fail_raise ~code:400
           "inflate: error during decompression: invalid consume len %d (max %d)"
-            len self.len
+          len self.len;
-        );
       self.off <- self.off + len;
-        self.len <- self.len - len;
+      self.len <- self.len - len)
-      )
     ~fill:(fun self ->
       (* refill [buf] if needed *)
       if self.len = 0 && not !is_done then (
-          is.fill_buf();
+        is.fill_buf ();
-          begin
+        (try
-            try
            let finished, used_in, used_out =
-                Zlib.inflate zlib_str
+             Zlib.inflate zlib_str self.bs 0 (Bytes.length self.bs) is.bs is.off
-                  self.bs 0 (Bytes.length self.bs)
+               is.len Zlib.Z_SYNC_FLUSH
-                  is.bs is.off is.len Zlib.Z_SYNC_FLUSH
            in
            is.consume used_in;
            self.off <- 0;
            self.len <- used_out;
            if finished then is_done := true;
-              S._debug (fun k->k "decode %d bytes as %d bytes from inflate (finished: %b)"
+           S._debug (fun k ->
-                           used_in used_out finished);
+               k "decode %d bytes as %d bytes from inflate (finished: %b)"
-            with Zlib.Error (e1,e2) ->
+                 used_in used_out finished)
+         with Zlib.Error (e1, e2) ->
            S.Response.fail_raise ~code:400
-                "inflate: error during decompression:\n%s %s" e1 e2
+             "inflate: error during decompression:\n%s %s" e1 e2);
-          end;
+        S._debug (fun k ->
-          S._debug (fun k->k "inflate: refill %d bytes into internal buf" self.len);
+            k "inflate: refill %d bytes into internal buf" self.len)
-        );
+      ))
-      )
     ()
 
-let encode_deflate_stream_ ~buf_size (is:S.byte_stream) : S.byte_stream =
+let encode_deflate_stream_ ~buf_size (is : S.byte_stream) : S.byte_stream =
-  S._debug (fun k->k "wrap stream with deflate.encode");
+  S._debug (fun k -> k "wrap stream with deflate.encode");
   let refill = ref true in
   let zlib_str = Zlib.deflate_init 4 false in
-  BS.make
+  BS.make ~bs:(Bytes.create buf_size)
-    ~bs:(Bytes.create buf_size)
     ~close:(fun _self ->
-        S._debug (fun k->k "deflate: close");
+      S._debug (fun k -> k "deflate: close");
       Zlib.deflate_end zlib_str;
-        BS.close is
+      BS.close is)
-      )
     ~consume:(fun self n ->
       self.off <- self.off + n;
-        self.len <- self.len - n
+      self.len <- self.len - n)
-      )
     ~fill:(fun self ->
-        let rec loop() =
+      let rec loop () =
-          S._debug (fun k->k "deflate.fill.iter out_off=%d out_len=%d"
+        S._debug (fun k ->
-                       self.off self.len);
+            k "deflate.fill.iter out_off=%d out_len=%d" self.off self.len);
-          if self.len > 0 then (
+        if self.len > 0 then
-            () (* still the same slice, not consumed entirely by output *)
+          ()
-          ) else if not !refill then (
+        (* still the same slice, not consumed entirely by output *)
-            () (* empty slice, no refill *)
+        else if not !refill then
-          ) else (
+          ()
+        (* empty slice, no refill *)
+        else (
           (* the output was entirely consumed, we need to do more work *)
-            is.BS.fill_buf();
+          is.BS.fill_buf ();
           if is.len > 0 then (
             (* try to decompress from input buffer *)
             let _finished, used_in, used_out =
-                Zlib.deflate zlib_str
+              Zlib.deflate zlib_str is.bs is.off is.len self.bs 0
-                  is.bs is.off is.len
+                (Bytes.length self.bs) Zlib.Z_NO_FLUSH
-                  self.bs 0 (Bytes.length self.bs)
-                  Zlib.Z_NO_FLUSH
             in
             self.off <- 0;
             self.len <- used_out;
             is.consume used_in;
-              S._debug
+            S._debug (fun k ->
-                (fun k->k "encode %d bytes as %d bytes using deflate (finished: %b)"
+                k "encode %d bytes as %d bytes using deflate (finished: %b)"
                   used_in used_out _finished);
             if _finished then (
-                S._debug (fun k->k "deflate: finished");
+              S._debug (fun k -> k "deflate: finished");
-                refill := false;
+              refill := false
             );
-              loop()
+            loop ()
           ) else (
             (* [is] is done, finish sending the data in current buffer *)
             let _finished, used_in, used_out =
-                Zlib.deflate zlib_str
+              Zlib.deflate zlib_str is.bs is.off is.len self.bs 0
-                  is.bs is.off is.len
+                (Bytes.length self.bs) Zlib.Z_FULL_FLUSH
-                  self.bs 0 (Bytes.length self.bs)
-                  Zlib.Z_FULL_FLUSH
             in
             assert (used_in = 0);
             self.off <- 0;
             self.len <- used_out;
-              if used_out = 0 then (
+            if used_out = 0 then refill := false;
-                refill := false;
+            loop ()
-              );
-              loop()
           )
         )
       in
-        try loop()
+      try loop ()
-        with Zlib.Error (e1,e2) ->
+      with Zlib.Error (e1, e2) ->
         S.Response.fail_raise ~code:400
-            "deflate: error during compression:\n%s %s" e1 e2
+          "deflate: error during compression:\n%s %s" e1 e2)
-      )
     ()
 
-let split_on_char ?(f=fun x->x) c s : string list =
+let split_on_char ?(f = fun x -> x) c s : string list =
   let rec loop acc i =
     match String.index_from s i c with
     | exception Not_found ->
       let acc =
-        if i=String.length s then acc
+        if i = String.length s then
-        else f (String.sub s i (String.length s-i)) :: acc
+          acc
-      in List.rev acc
+        else
+          f (String.sub s i (String.length s - i)) :: acc
+      in
+      List.rev acc
     | j ->
-      let acc = f (String.sub s i (j-i)) :: acc in
+      let acc = f (String.sub s i (j - i)) :: acc in
-      loop acc (j+1)
+      loop acc (j + 1)
   in
   loop [] 0
 
-let accept_deflate (req:_ S.Request.t) =
+let accept_deflate (req : _ S.Request.t) =
-  match
+  match S.Request.get_header req "Accept-Encoding" with
-    S.Request.get_header req "Accept-Encoding"
-  with
   | Some s -> List.mem "deflate" @@ split_on_char ~f:String.trim ',' s
   | None -> false
 
 let has_deflate s =
-  try Scanf.sscanf s "deflate, %s" (fun _ -> true)
+  try Scanf.sscanf s "deflate, %s" (fun _ -> true) with _ -> false
-  with _ -> false
 
 (* decompress [req]'s body if needed *)
-let decompress_req_stream_ ~buf_size (req:BS.t S.Request.t) : _ S.Request.t =
+let decompress_req_stream_ ~buf_size (req : BS.t S.Request.t) : _ S.Request.t =
   match S.Request.get_header ~f:String.trim req "Transfer-Encoding" with
   (* TODO
      | Some "gzip" ->
@@ -151,21 +136,17 @@ let decompress_req_stream_ ~buf_size (req:BS.t S.Request.t) : _ S.Request.t =
        Some (req', decode_gzip_stream_)
   *)
   | Some s when has_deflate s ->
-    begin match Scanf.sscanf s "deflate, %s" (fun s -> s) with
+    (match Scanf.sscanf s "deflate, %s" (fun s -> s) with
     | tr' ->
       let body' = S.Request.body req |> decode_deflate_stream_ ~buf_size in
       req
       |> S.Request.set_header "Transfer-Encoding" tr'
       |> S.Request.set_body body'
-      | exception _ -> req
+    | exception _ -> req)
-    end
   | _ -> req
 
-let compress_resp_stream_
+let compress_resp_stream_ ~compress_above ~buf_size (req : _ S.Request.t)
-    ~compress_above
+    (resp : S.Response.t) : S.Response.t =
-    ~buf_size
-    (req:_ S.Request.t) (resp:S.Response.t) : S.Response.t =
-
   (* headers for compressed stream *)
   let update_headers h =
     h
@@ -177,39 +158,31 @@ let compress_resp_stream_
     match resp.body with
     | `String s when String.length s > compress_above ->
       (* big string, we compress *)
-      S._debug
+      S._debug (fun k ->
-        (fun k->k "encode str response with deflate (size %d, threshold %d)"
+          k "encode str response with deflate (size %d, threshold %d)"
             (String.length s) compress_above);
-      let body =
+      let body = encode_deflate_stream_ ~buf_size @@ BS.of_string s in
-        encode_deflate_stream_ ~buf_size @@ BS.of_string s
-      in
       resp
       |> S.Response.update_headers update_headers
       |> S.Response.set_body (`Stream body)
-
     | `Stream str ->
-      S._debug (fun k->k "encode stream response with deflate");
+      S._debug (fun k -> k "encode stream response with deflate");
       resp
       |> S.Response.update_headers update_headers
       |> S.Response.set_body (`Stream (encode_deflate_stream_ ~buf_size str))
-
     | `String _ | `Void -> resp
-  ) else resp
+  ) else
+    resp
 
-let middleware
+let middleware ?(compress_above = 16 * 1024) ?(buf_size = 16 * 1_024) () :
-    ?(compress_above=16 * 1024)
+    S.Middleware.t =
-    ?(buf_size=16 * 1_024)
-    () : S.Middleware.t =
   let buf_size = max buf_size 1_024 in
   fun h req ~resp ->
     let req = decompress_req_stream_ ~buf_size req in
-    h req
+    h req ~resp:(fun response ->
-      ~resp:(fun response ->
         resp @@ compress_resp_stream_ ~buf_size ~compress_above req response)
 
-let setup
+let setup ?compress_above ?buf_size server =
-    ?compress_above ?buf_size server =
   let m = middleware ?compress_above ?buf_size () in
-  S._debug (fun k->k "setup gzip support");
+  S._debug (fun k -> k "setup gzip support");
   S.add_middleware ~stage:`Encoding server m
-

src/camlzip/Tiny_httpd_camlzip.mli

@@ -1,14 +1,9 @@
-
 val middleware :
-  ?compress_above:int ->
+  ?compress_above:int -> ?buf_size:int -> unit -> Tiny_httpd_server.Middleware.t
-  ?buf_size:int -> unit ->
-  Tiny_httpd_server.Middleware.t
 (** Middleware responsible for deflate compression/decompression.
     @since 0.11 *)
 
-val setup :
+val setup : ?compress_above:int -> ?buf_size:int -> Tiny_httpd_server.t -> unit
-  ?compress_above:int ->
-  ?buf_size:int -> Tiny_httpd_server.t -> unit
 (** Install middleware for tiny_httpd to be able to encode/decode
     compressed streams
     @param compress_above threshold above with string responses are compressed

src/camlzip/dune

@@ -1,4 +1,3 @@
-
 (library
  (name tiny_httpd_camlzip)
  (public_name tiny_httpd_camlzip)

src/dune

@@ -1,4 +1,3 @@
-
 (library
  (name tiny_httpd)
  (public_name tiny_httpd)
@@ -8,5 +7,9 @@
 
 (rule
  (targets Tiny_httpd_html_.ml)
-  (deps (:bin ./gen/gentags.exe))
+ (deps
-  (action (with-stdout-to %{targets} (run %{bin}))))
+  (:bin ./gen/gentags.exe))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run %{bin}))))

src/gen/dune

@@ -1,4 +1,2 @@
 (executable
  (name gentags))
-
-

src/gen/gentags.ml

@@ -1,10 +1,10 @@
-
 (* adapted from https://github.com/sindresorhus/html-tags (MIT licensed) *)
 
 let pf = Printf.printf
 let spf = Printf.sprintf
 
-let void = [
+let void =
+  [
     "area";
     "base";
     "br";
@@ -20,9 +20,10 @@ let void = [
     "source";
     "track";
     "wbr";
-]
+  ]
 
-let normal = [
+let normal =
+  [
     "a";
     "abbr";
     "address";
@@ -140,7 +141,8 @@ let normal = [
     "var";
     "video";
     "wbr";
-] |> List.filter (fun s -> not (List.mem s void))
+  ]
+  |> List.filter (fun s -> not (List.mem s void))
 
 (* obtained via:
    {[
@@ -150,7 +152,8 @@ let normal = [
    ]}
    on https://developer.mozilla.org/en-US/docs/Web/HTML/Attributes
 *)
-let attrs = [
+let attrs =
+  [
     "accept";
     "accept-charset";
     "accesskey";
@@ -275,9 +278,10 @@ let attrs = [
     "value";
     "width";
     "wrap";
-]
+  ]
 
-let prelude = {|
+let prelude =
+  {|
 (** Output for HTML combinators.
 
     This output type is used to produce a string reasonably efficiently from
@@ -431,11 +435,17 @@ let oname = function
   | "Text" -> "text"
   | "type" -> "type_"
   | name ->
-    String.map (function '-' -> '_' | c -> c) name
+    String.map
+      (function
+        | '-' -> '_'
+        | c -> c)
+      name
 
 let emit_void name =
   let oname = oname name in
-  pf "(** tag %S, see {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/%s} mdn} *)\n"
+  pf
+    "(** tag %S, see \
+     {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/%s} mdn} *)\n"
     name name;
   pf "let %s : void = fun ?(if_=true) attrs out ->\n" oname;
   pf "  if if_ then (\n";
@@ -447,12 +457,14 @@ let emit_void name =
 let emit_normal name =
   let oname = oname name in
 
-  pf "(** tag %S, see {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/%s} mdn} *)\n"
+  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 sub out ->\n" oname;
   pf "  if if_ then (\n";
   (* for <pre>, newlines actually matter *)
-  if name="pre" then pf "  Out.with_no_format_nl out @@ fun () ->\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 "    List.iter (fun sub -> Out.add_format_nl out; sub out) sub;\n";
   pf "    if sub <> [] then Out.add_format_nl out;\n";
@@ -461,21 +473,23 @@ let emit_normal name =
 
   (* block version *)
   let oname = oname ^ "'" in
-  pf "(** tag %S, see {{:https://developer.mozilla.org/en-US/docs/Web/HTML/Element/%s} mdn} *)\n"
+  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 l out ->\n" oname;
   pf "  if if_ then (\n";
-  if name="pre" then pf "  Out.with_no_format_nl out @@ fun () ->\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 "    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";
 
-
   ()
 
-let doc_attrs = {|Attributes.
+let doc_attrs =
+  {|Attributes.
 
 This module contains combinator for the standard attributes.
 One can also just use a pair of strings. |}
@@ -498,4 +512,3 @@ let () =
   List.iter emit_attr attrs;
   pf "end\n";
   ()
-

src/qtest/dune

@@ -1,18 +1,18 @@
-
 (executable
  (name qtest)
  (modes native)
  (flags :standard -warn-error -a+8 -w -33)
-  (libraries qcheck-core qcheck ounit2
+ (libraries qcheck-core qcheck ounit2 threads threads.posix tiny_httpd))
-             threads threads.posix tiny_httpd))
 
 (rule
- (deps (glob_files ../*.ml{,i}))
+ (deps
+  (glob_files ../*.ml{,i}))
  (targets qtest.ml)
- (action (run qtest extract --quiet %{deps} -o %{targets})))
+ (action
+  (run qtest extract --quiet %{deps} -o %{targets})))
 
 (rule
  (alias runtest)
  (package tiny_httpd)
-  (action (run ./qtest.exe)))
+ (action
-
+  (run ./qtest.exe)))

tests/dune

@@ -1,64 +1,92 @@
-
 (rule
  (targets echo1.out)
-  (deps (:bin ../examples/echo.exe))
+ (deps
+  (:bin ../examples/echo.exe))
  (locks /port)
-  (enabled_if (= %{system} "linux"))
+ (enabled_if
+  (= %{system} "linux"))
  (package tiny_httpd_camlzip)
-  (action (with-stdout-to %{targets} (run ./echo1.sh %{bin}))))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run ./echo1.sh %{bin}))))
 
 (rule
  (alias runtest)
  (package tiny_httpd_camlzip)
-  (enabled_if (= %{system} "linux"))
+ (enabled_if
-  (action (diff echo1.expect echo1.out)))
+  (= %{system} "linux"))
+ (action
+  (diff echo1.expect echo1.out)))
 
 (rule
  (targets sse_count.out)
-  (deps (:bin ../examples/sse_server.exe))
+ (deps
+  (:bin ../examples/sse_server.exe))
  (locks /port)
-  (enabled_if (= %{system} "linux"))
+ (enabled_if
+  (= %{system} "linux"))
  (package tiny_httpd)
-  (action (with-stdout-to %{targets} (run ./sse_count.sh %{bin}))))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run ./sse_count.sh %{bin}))))
 
 (rule
  (alias runtest)
  (package tiny_httpd)
-  (enabled_if (= %{system} "linux"))
+ (enabled_if
-  (action (diff sse_count.expect sse_count.out)))
+  (= %{system} "linux"))
+ (action
+  (diff sse_count.expect sse_count.out)))
 
 (rule
  (targets upload-out)
-  (deps (:bin ../src/bin/http_of_dir.exe) foo_50)
+ (deps
+  (:bin ../src/bin/http_of_dir.exe)
+  foo_50)
  (locks /port)
  (package tiny_httpd)
-  (enabled_if (= %{system} "linux"))
+ (enabled_if
-  (action (with-stdout-to %{targets}
+  (= %{system} "linux"))
+ (action
+  (with-stdout-to
+   %{targets}
    (run ./upload_chunked.sh %{bin}))))
 
 (rule
  (alias runtest)
  (package tiny_httpd)
-  (enabled_if (= %{system} "linux"))
+ (enabled_if
-  (action (diff upload-out.expect upload-out)))
+  (= %{system} "linux"))
+ (action
+  (diff upload-out.expect upload-out)))
 
 (rule
  (targets dl-out)
-  (deps (:bin ../src/bin/http_of_dir.exe) foo_50)
+ (deps
+  (:bin ../src/bin/http_of_dir.exe)
+  foo_50)
  (locks /port)
  (package tiny_httpd)
-  (enabled_if (= %{system} "linux"))
+ (enabled_if
-  (action (with-stdout-to %{targets}
+  (= %{system} "linux"))
+ (action
+  (with-stdout-to
+   %{targets}
    (run ./download_chunked.sh %{bin}))))
 
 (rule
  (alias runtest)
  (package tiny_httpd)
-  (enabled_if (= %{system} "linux"))
+ (enabled_if
-  (action (diff dl-out.expect dl-out)))
+  (= %{system} "linux"))
+ (action
+  (diff dl-out.expect dl-out)))
 
 (rule
  (targets foo_50)
-  (enabled_if (= %{system} "linux"))
+ (enabled_if
+  (= %{system} "linux"))
  (action
   (bash "dd if=/dev/zero of=%{targets} bs=1M count=50")))

tests/html/dune

@@ -1,22 +1,31 @@
-
 (executable
  (libraries tiny_httpd)
  (name makehtml))
 
 (rule
  (targets t1.out.html)
-  (deps (:bin ./makehtml.exe))
+ (deps
-  (action (with-stdout-to %{targets} (run %{bin} 1))))
+  (:bin ./makehtml.exe))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run %{bin} 1))))
 
 (rule
  (alias runtest)
-  (action (diff t1.expected.html t1.out.html)))
+ (action
+  (diff t1.expected.html t1.out.html)))
 
 (rule
  (targets t2.out.html)
-  (deps (:bin ./makehtml.exe))
+ (deps
-  (action (with-stdout-to %{targets} (run %{bin} 2))))
+  (:bin ./makehtml.exe))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run %{bin} 2))))
 
 (rule
  (alias runtest)
-  (action (diff t2.expected.html t2.out.html)))
+ (action
+  (diff t2.expected.html t2.out.html)))

tests/html/makehtml.ml

@@ -1,41 +1,52 @@
 open Tiny_httpd_html
+
 let spf = Printf.sprintf
 
 let list_init n f =
   let rec loop i =
-    if i=n then []
+    if i = n then
-    else f i :: loop (i+1)
+      []
-  in loop 0
+    else
+      f i :: loop (i + 1)
+  in
+  loop 0
 
-let t1() =
+let t1 () =
-  html [] [
+  html []
+    [
       head [] [];
-    body [] [
+      body []
-      ul [A.style "list-style: circle"] (
+        [
-        li[][pre [] [txt "a"; pre[][txt "c"; txt"d"]; txt "b"]] ::
+          ul
-        list_init 100 (fun i -> li [A.id (spf "l%d" i)] [txt (spf "item %d" i)])
+            [ A.style "list-style: circle" ]
-      )
+            (li [] [ pre [] [ txt "a"; pre [] [ txt "c"; txt "d" ]; txt "b" ] ]
-    ]
+            :: list_init 100 (fun i ->
+                   li [ A.id (spf "l%d" i) ] [ txt (spf "item %d" i) ]));
+        ];
     ]
 
-
+let t2 () =
-let t2() =
+  html []
-  html [] [
+    [
       head [] [];
-    pre [] [txt "a"; txt "b"];
+      pre [] [ txt "a"; txt "b" ];
-    body [] [
+      body []
-      ul' [A.style "list-style: circle"] [
+        [
-        sub_l @@ list_init 100 @@ fun i ->
+          ul'
-        li ~if_:(i<> 42) [A.id (spf "l%d" i)] [txt (spf "item %d" i)]
+            [ 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) ]
+              );
+            ];
+        ];
     ]
 
-let render t =
+let render t = print_endline @@ to_string_top @@ t
-  print_endline @@ to_string_top @@ t
 
 let () =
   match Sys.argv.(1) with
-  | "1" -> render @@ t1()
+  | "1" -> render @@ t1 ()
-  | "2" -> render @@ t2()
+  | "2" -> render @@ t2 ()
   | _ -> failwith "unknown cmd"