Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Update ocamlformat to 0.27.0 #1098

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion .ocamlformat
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
version = 0.26.2
version=0.27.0
profile=conventional
break-infix=fit-or-vertical
parse-docstrings=true
6 changes: 3 additions & 3 deletions cohttp-async/bin/cohttp_server_async.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
42 changes: 21 additions & 21 deletions cohttp-async/test/test_async_integration.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
32 changes: 15 additions & 17 deletions cohttp-lwt-jsoo/src/cohttp_lwt_jsoo.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 *)
Expand All @@ -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

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 *)
Expand All @@ -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 *)
Expand Down
24 changes: 12 additions & 12 deletions cohttp-lwt-unix/test/test_sanity.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
21 changes: 10 additions & 11 deletions cohttp-lwt/src/s.ml
Original file line number Diff line number Diff line change
Expand Up @@ -89,15 +89,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
Expand Down Expand Up @@ -191,9 +190,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
Expand Down
10 changes: 5 additions & 5 deletions cohttp-server-lwt-unix/src/cohttp_server_lwt_unix.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 *)
Expand Down
3 changes: 2 additions & 1 deletion cohttp-server-lwt-unix/src/cohttp_server_lwt_unix.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
3 changes: 2 additions & 1 deletion cohttp/src/accept.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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]

Expand Down
3 changes: 2 additions & 1 deletion cohttp/src/code.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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 ? *)
Expand Down
12 changes: 8 additions & 4 deletions cohttp/src/header.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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],
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
4 changes: 3 additions & 1 deletion cohttp/src/request.ml
Original file line number Diff line number Diff line change
Expand Up @@ -119,7 +119,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
Expand Down
10 changes: 4 additions & 6 deletions cohttp/test/test_accept.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 _ ->
Expand All @@ -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
Expand Down
6 changes: 4 additions & 2 deletions http/src/http.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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],
Expand Down Expand Up @@ -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
Expand Down
Loading