Merge pull request mirage#1098 from smorimoto/ocamlformat-0.27

Update ocamlformat to 0.27.0

Author: samoht

.ocamlformat

@@ -1,4 +1,4 @@
-version = 0.26.2
+version=0.27.0
 profile=conventional
 break-infix=fit-or-vertical
 parse-docstrings=true

cohttp-async/bin/cohttp_server_async.ml

@@ -116,9 +116,9 @@ let start_server docroot port index cert_file key_file verbose () =
   Server.create
     ~on_handler_error:
       (`Call
-        (fun addr exn ->
-          Logs.err (fun f -> f "Error from %s" (Socket.Address.to_string addr));
-          Logs.err (fun f -> f "%s" @@ Exn.to_string exn)))
+         (fun addr exn ->
+           Logs.err (fun f -> f "Error from %s" (Socket.Address.to_string addr));
+           Logs.err (fun f -> f "%s" @@ Exn.to_string exn)))
     ~mode
     (Tcp.Where_to_listen.of_port port)
     (handler ~info ~docroot ~index)

cohttp-async/test/test_async_integration.ml

@@ -28,27 +28,27 @@ let server =
   ]
   (* pipelined_chunk *)
   @ (response_bodies |> List.map ~f:(Fn.compose const ok))
-  @ (* large response chunked *)
-  [
-    (fun _ _ ->
-      let body =
-        let r, w = Pipe.create () in
-        let chunk = chunk chunk_size in
-        for _ = 0 to chunks - 1 do
-          Pipe.write_without_pushback w chunk
-        done;
-        Pipe.close w;
-        r
-      in
-      Server.respond_with_pipe ~code:`OK body >>| response);
-    (* pipelined_expert *)
-    expert (fun _ic oc ->
-        Async_unix.Writer.write oc "8\r\nexpert 1\r\n0\r\n\r\n";
-        Async_unix.Writer.flushed oc);
-    expert (fun ic oc ->
-        Async_unix.Writer.write oc "8\r\nexpert 2\r\n0\r\n\r\n";
-        Async_unix.Writer.flushed oc >>= fun () -> Async_unix.Reader.close ic);
-  ]
+  (* large response chunked *)
+  @ [
+      (fun _ _ ->
+        let body =
+          let r, w = Pipe.create () in
+          let chunk = chunk chunk_size in
+          for _ = 0 to chunks - 1 do
+            Pipe.write_without_pushback w chunk
+          done;
+          Pipe.close w;
+          r
+        in
+        Server.respond_with_pipe ~code:`OK body >>| response);
+      (* pipelined_expert *)
+      expert (fun _ic oc ->
+          Async_unix.Writer.write oc "8\r\nexpert 1\r\n0\r\n\r\n";
+          Async_unix.Writer.flushed oc);
+      expert (fun ic oc ->
+          Async_unix.Writer.write oc "8\r\nexpert 2\r\n0\r\n\r\n";
+          Async_unix.Writer.flushed oc >>= fun () -> Async_unix.Reader.close ic);
+    ]
   |> response_sequence
 
 let ts =

cohttp-lwt-jsoo/src/cohttp_lwt_jsoo.ml

@@ -63,11 +63,11 @@ module Body_builder (P : Params) = struct
     let chunkerizer () =
       if !pos = body_len then Lwt.return C.Transfer.Done
       else if !pos + P.chunk_size >= body_len then (
-        let str = text ## (substring_toEnd !pos) in
+        let str = text##(substring_toEnd !pos) in
         pos := body_len;
         Lwt.return (C.Transfer.Final_chunk (P.convert_body_string str)))
       else
-        let str = text ## (substring !pos (!pos + P.chunk_size)) in
+        let str = text##(substring !pos (!pos + P.chunk_size)) in
         pos := !pos + P.chunk_size;
         Lwt.return (C.Transfer.Chunk (P.convert_body_string str))
     in
@@ -205,11 +205,10 @@ module Make_client_async (P : Params) = Make_api (struct
       xml##.responseType := Js.string "arraybuffer";
     let (res : (Http.Response.t Lwt.t * CLB.t) Lwt.t), wake = Lwt.task () in
     let () =
-      xml
-      ## (_open
-            (Js.string (C.Code.string_of_method meth))
-            (Js.string (Uri.to_string uri))
-            Js._true)
+      xml##(_open
+              (Js.string (C.Code.string_of_method meth))
+              (Js.string (Uri.to_string uri))
+              Js._true)
       (* asynchronous call *)
     in
     (* set request headers *)
@@ -221,7 +220,7 @@ module Make_client_async (P : Params) = Make_api (struct
             (fun k v ->
               (* some headers lead to errors in the javascript console, should
                  we filter then out here? *)
-              xml ## (setRequestHeader (Js.string k) (Js.string v)))
+              xml##(setRequestHeader (Js.string k) (Js.string v)))
             headers
     in
 
@@ -264,7 +263,7 @@ module Make_client_async (P : Params) = Make_api (struct
 
     (* perform call *)
     (match body with
-    | None -> Lwt.return xml ## (send Js.null)
+    | None -> Lwt.return xml##(send Js.null)
     | Some body ->
         CLB.to_string body >>= fun body ->
         let bs = binary_string body in
@@ -292,11 +291,10 @@ module Make_client_sync (P : Params) = Make_api (struct
     if Lazy.force xhr_response_supported then
       xml##.responseType := Js.string "arraybuffer";
     let () =
-      xml
-      ## (_open
-            (Js.string (C.Code.string_of_method meth))
-            (Js.string (Uri.to_string uri))
-            Js._false)
+      xml##(_open
+              (Js.string (C.Code.string_of_method meth))
+              (Js.string (Uri.to_string uri))
+              Js._false)
       (* synchronous call *)
     in
     (* set request headers *)
@@ -308,16 +306,16 @@ module Make_client_sync (P : Params) = Make_api (struct
             (fun k v ->
               (* some headers lead to errors in the javascript console, should
                  we filter then out here? *)
-              xml ## (setRequestHeader (Js.string k) (Js.string v)))
+              xml##(setRequestHeader (Js.string k) (Js.string v)))
             headers
     in
     (* perform call *)
     (match body with
-    | None -> Lwt.return xml ## (send Js.null)
+    | None -> Lwt.return xml##(send Js.null)
     | Some body ->
         CLB.to_string body >|= fun body ->
         let bs = binary_string body in
-        xml ## (send (Js.Opt.return (Obj.magic bs))))
+        xml##(send (Js.Opt.return (Obj.magic bs))))
     >>= fun _body ->
     let body = Bb.construct_body xml in
     (* (re-)construct the response *)

cohttp-lwt-unix/test/test_sanity.ml

@@ -50,22 +50,22 @@ let server =
       (fun _ _ ->
         Lwt.return
           (`Expert
-            (let headers =
-               Http.(
-                 Header.add_transfer_encoding (Header.init ()) Transfer.Chunked)
-             in
-             ( Http.Response.make ~headers (),
-               fun _ic oc -> Lwt_io.write oc "8\r\nexpert 1\r\n0\r\n\r\n" ))));
+             (let headers =
+                Http.(
+                  Header.add_transfer_encoding (Header.init ()) Transfer.Chunked)
+              in
+              ( Http.Response.make ~headers (),
+                fun _ic oc -> Lwt_io.write oc "8\r\nexpert 1\r\n0\r\n\r\n" ))));
       (fun _ _ ->
         Lwt.return
           (`Expert
-            ( (* Alternatively, cohttp.response.make injects the Chunked encoding when no
+             ( (* Alternatively, cohttp.response.make injects the Chunked encoding when no
                  encoding is already in the headers. *)
-              Cohttp.Response.make (),
-              fun ic oc ->
-                Lwt_io.write oc "8\r\nexpert 2\r\n0\r\n\r\n" >>= fun () ->
-                Lwt_io.flush oc >>= fun () ->
-                Cohttp_lwt_unix.Private.Input_channel.close ic )));
+               Cohttp.Response.make (),
+               fun ic oc ->
+                 Lwt_io.write oc "8\r\nexpert 2\r\n0\r\n\r\n" >>= fun () ->
+                 Lwt_io.flush oc >>= fun () ->
+                 Cohttp_lwt_unix.Private.Input_channel.close ic )));
     ]
   |> response_sequence
 

cohttp-lwt/src/s.ml

@@ -94,15 +94,14 @@ type call =
       module can be used to consume [response_body]. Use {!Body.drain_body} if
       you don't consume the body by other means.
 
-      Leaks are detected by the GC and logged as debug messages, these can be
-      enabled activating the debug logging. For example, this can be done as
-      follows in
-      [cohttp-lwt-unix]
+    Leaks are detected by the GC and logged as debug messages, these can be
+    enabled activating the debug logging. For example, this can be done as
+    follows in [cohttp-lwt-unix]
 
-      {[
-        Cohttp_lwt_unix.Debug.activate_debug ();
-        Logs.set_level (Some Logs.Warning)
-      ]}
+    {[
+      Cohttp_lwt_unix.Debug.activate_debug ();
+      Logs.set_level (Some Logs.Warning)
+    ]}
 
     @raise {!Connection.Retry}
       on recoverable errors like the remote endpoint closing the connection
@@ -199,9 +198,9 @@ module type Client = sig
         {!val:Connection_cache.Make_no_cache.create} is used to resolve uri and
         create a dedicated connection with [ctx].
 
-        In most cases you should use the more specific helper calls in the
-        interface rather than invoke this function directly. See {!head}, {!get}
-        and {!post} for some examples. *)
+      In most cases you should use the more specific helper calls in the
+      interface rather than invoke this function directly. See {!head}, {!get}
+      and {!post} for some examples. *)
   include
     Cohttp.Generic.Client.S
       with type 'a io = 'a Lwt.t

cohttp-server-lwt-unix/src/cohttp_server_lwt_unix.ml

@@ -205,11 +205,11 @@ module Context = struct
     Int64.of_string_opt ("0x" ^ hex)
 
   let step_chunked :
-        'a.
-        t ->
-        f:(Body.Substring.t -> 'acc -> 'acc Lwt.t) ->
-        init:'acc ->
-        'acc option Lwt.t =
+      'a.
+      t ->
+      f:(Body.Substring.t -> 'acc -> 'acc Lwt.t) ->
+      init:'acc ->
+      'acc option Lwt.t =
    fun t ~f ~init ->
     Input_channel.read_line_opt t.ic >>= function
     | None -> Lwt.return_none (* TODO invalid input *)

cohttp-server-lwt-unix/src/cohttp_server_lwt_unix.mli

@@ -61,7 +61,8 @@ module Body : sig
   (** [stream ?encoding f] respond with body generated by repeatedly applying
       [f]. When [f] returns [None], it will be considered terminated.
 
-      [?encoding] is the encoding to use. By default this is [Encoding.chunked]. *)
+      [?encoding] is the encoding to use. By default this is [Encoding.chunked].
+  *)
 end
 
 module Context : sig

cohttp/src/accept.mli

@@ -50,7 +50,8 @@ type encoding = Accept_types.encoding =
 (** Basic language range tag. ["en-gb"] is represented as
     [Language ["en"; "gb"]].
 
-    @see <https://tools.ietf.org/html/rfc7231#section-5.3.5> the specification. *)
+    @see <https://tools.ietf.org/html/rfc7231#section-5.3.5> the specification.
+*)
 type language = Accept_types.language = Language of string list | AnyLanguage
 [@@deriving sexp]
 

cohttp/src/code.mli

@@ -171,7 +171,8 @@ val reason_phrase_of_code : int -> string
 (** Give a description of the given int code. *)
 
 val is_informational : int -> bool
-(** Is the given int code belong to the class of "informational" return code ? *)
+(** Is the given int code belong to the class of "informational" return code ?
+*)
 
 val is_success : int -> bool
 (** Is the given int code belong to the class of "success" return code ? *)

cohttp/src/header.mli

@@ -40,7 +40,8 @@ val to_list : t -> (string * string) list
 (** [to_list h] converts HTTP headers [h] to a list. Order and case is
     preserved.
 
-    {e Invariant (with case insensitive comparison):} [to_list (of_list l) = l] *)
+    {e Invariant (with case insensitive comparison):} [to_list (of_list l) = l]
+*)
 
 val init_with : string -> string -> t
 (** [init_with k v] construct a fresh HTTP headers with a single header with
@@ -118,7 +119,8 @@ val get_multi_concat : ?list_value_only:bool -> t -> string -> string option
     the last value paired with [k] in [h].
 
     {e Invariant:}
-    [forall h, k not a list-value header. get_multi_concat ~list-value-only:true h k = get h k] *)
+    [forall h, k not a list-value header. get_multi_concat ~list-value-only:true
+     h k = get h k] *)
 
 val update : t -> string -> (string option -> string option) -> t
 (** [update h k f] returns an header list containing the same headers as [h],
@@ -190,7 +192,8 @@ val clean_dup : t -> t
 
     Finally, following
     {{:https://tools.ietf.org/html/rfc7230#section-3.2.2} RFC7230§3.2.2}, the
-    header [Set-cookie] is treated as an exception and ignored by [clean_dup]. *)
+    header [Set-cookie] is treated as an exception and ignored by [clean_dup].
+*)
 
 val get_content_range : t -> Int64.t option
 val get_media_type : t -> string option
@@ -213,7 +216,8 @@ val add_links : t -> Link.t list -> t
 val get_links : t -> Link.t list
 
 val user_agent : string
-(** The User-Agent header used by this library, including the version of cohttp. *)
+(** The User-Agent header used by this library, including the version of cohttp.
+*)
 
 val prepend_user_agent : t -> string -> t
 (** Prepend [user_agent] to the product token already declared in the

cohttp/src/request.ml

@@ -131,7 +131,9 @@ let uri { resource; headers; meth; _ } =
       | Some _ -> (
           Uri.(
             (* we have an absoluteURI *)
-            match path uri with "" -> with_path uri "/" | _ -> uri))
+            match path uri with
+            | "" -> with_path uri "/"
+            | _ -> uri))
       | None -> (
           let empty = Uri.of_string "" in
           let empty_base = Uri.of_string "///" in

cohttp/test/test_accept.ml

@@ -16,16 +16,14 @@
 
 module A = Cohttp.Accept
 
-let suite_of :
-    type a.
+let suite_of : type a.
     (string option -> a) -> a Alcotest.testable -> (string * a) list -> _ list =
  fun pf t ->
   List.map (fun (s, expected) ->
       let test () = Alcotest.check t s (pf (Some s)) expected in
       (s, `Quick, test))
 
-let suite_of_fail :
-    type a.
+let suite_of_fail : type a.
     (string option -> a) -> a Alcotest.testable -> (string * exn) list -> _ list
     =
  fun pf _ ->
@@ -41,8 +39,8 @@ let suite_to_string_of : type a. (a -> string) -> (a * string) list -> _ list =
       let test () = Alcotest.(check string expected_str expected_str (pf v)) in
       (expected_str, `Quick, test))
 
-let suite_to_string_of_fail :
-    type a. (a -> string) -> (a * string * exn) list -> _ list =
+let suite_to_string_of_fail : type a.
+    (a -> string) -> (a * string * exn) list -> _ list =
  fun pf ->
   List.map (fun (v, descr, e) ->
       let test () = Alcotest.(check_raises descr e (fun () -> ignore (pf v))) in

http/src/http.mli

@@ -278,7 +278,8 @@ module Header : sig
       returned value is the last value paired with [k] in [h].
 
       {e Invariant:}
-      [forall h, k not a list-value header. get_multi_concat ~list-value-only:true h k = get h k] *)
+      [forall h, k not a list-value header. get_multi_concat
+       ~list-value-only:true h k = get h k] *)
 
   val update : t -> string -> (string option -> string option) -> t
   (** [update h k f] returns an header list containing the same headers as [h],
@@ -357,7 +358,8 @@ module Header : sig
 
       Finally, following
       {{:https://tools.ietf.org/html/rfc7230#section-3.2.2} RFC7230§3.2.2}, the
-      header [Set-cookie] is treated as an exception and ignored by [clean_dup]. *)
+      header [Set-cookie] is treated as an exception and ignored by [clean_dup].
+  *)
 
   val get_content_range : t -> Int64.t option
   val get_connection_close : t -> bool