From f0ddb8385974f8da9c396bcd4e9e226de21bc650 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Mon, 22 Jul 2024 16:44:39 +0200 Subject: [PATCH] Use failwith instead of Lwt.fail_with Lwt's documentation reads: > In most cases, it is better to use `failwith s` from the standard > library. and > Whenever possible, it is recommended to use `raise exn` instead, as > raise captures a backtrace, while `Lwt.fail` does not. If you call > `raise exn` in a callback that is expected by Lwt to return a > promise, Lwt will automatically wrap `exn` in a rejected promise, > but the backtrace will have been recorded by the OCaml runtime. > > For example, `bind`'s second argument is a callback which returns a > promise. And so it is recommended to use `raise` in the body of that > callback. > > Use `Lwt.fail` only when you specifically want to create a rejected > promise, to pass to another function, or store in a data structure. Prefer to capture backtraces to improve debugability. --- README.md | 15 +++++++-------- cohttp-lwt-jsoo/src/cohttp_lwt_jsoo.ml | 2 +- cohttp-lwt-unix/examples/client_lwt_timeout.ml | 2 +- .../src/cohttp_lwt_unix_test.ml | 2 +- cohttp-lwt-unix/test/test_client.ml | 2 +- cohttp-mirage/src/io.ml | 2 +- cohttp-mirage/src/static.ml | 2 +- 7 files changed, 13 insertions(+), 14 deletions(-) diff --git a/README.md b/README.md index 87f16886dc..2a026f204f 100644 --- a/README.md +++ b/README.md @@ -154,7 +154,7 @@ let compute ~time ~f = let body = let get () = Client.get (Uri.of_string "https://www.reddit.com/") in compute ~time:0.1 ~f:get >>= function - | `Timeout -> Lwt.fail_with "Timeout expired" + | `Timeout -> failwith "Timeout expired" | `Done (resp, body) -> Lwt.return (resp, body) ``` @@ -174,7 +174,7 @@ For example, ```ocaml let get_body ~uri ~timeout = let%bind _, body = Cohttp_async.Client.get ~interrupt:(after (sec timeout)) uri in - Body.to_string body + Body.to_string body let body = let uri = Uri.of_string "https://www.reddit.com/" in @@ -275,19 +275,18 @@ and follow_redirect ~max_redirects request_uri (response, body) = handle_redirect ~permanent:true ~max_redirects request_uri response | `Found | `Temporary_redirect -> handle_redirect ~permanent:false ~max_redirects request_uri response - | `Not_found | `Gone -> Lwt.fail_with "Not found" + | `Not_found | `Gone -> failwith "Not found" | status -> - Lwt.fail_with - (Printf.sprintf "Unhandled status: %s" - (Cohttp.Code.string_of_status status)) + Printf.ksprintf failwith "Unhandled status: %s" + (Cohttp.Code.string_of_status status) and handle_redirect ~permanent ~max_redirects request_uri response = - if max_redirects <= 0 then Lwt.fail_with "Too many redirects" + if max_redirects <= 0 then failwith "Too many redirects" else let headers = Http.Response.headers response in let location = Http.Header.get headers "location" in match location with - | None -> Lwt.fail_with "Redirection without Location header" + | None -> failwith "Redirection without Location header" | Some url -> let open Lwt.Syntax in let uri = Uri.of_string url in diff --git a/cohttp-lwt-jsoo/src/cohttp_lwt_jsoo.ml b/cohttp-lwt-jsoo/src/cohttp_lwt_jsoo.ml index 59d41cc2a6..b0422d7437 100644 --- a/cohttp-lwt-jsoo/src/cohttp_lwt_jsoo.ml +++ b/cohttp-lwt-jsoo/src/cohttp_lwt_jsoo.ml @@ -269,7 +269,7 @@ module Make_client_async (P : Params) = Make_api (struct CLB.to_string body >>= fun body -> let bs = binary_string body in (*Js.Opt.case (File.CoerceTo.blob (Obj.magic blob)) - (fun () -> Lwt.fail_with "could not coerce to blob") + (fun () -> failwith "could not coerce to blob") (fun blob -> Lwt.return (xml##(send_blob blob)))*) (*Lwt.return (xml##send (Js.Opt.return bs)) *) Lwt.return (xml##send (Js.Opt.return (Obj.magic bs)))) diff --git a/cohttp-lwt-unix/examples/client_lwt_timeout.ml b/cohttp-lwt-unix/examples/client_lwt_timeout.ml index 399cc850f3..6c953f5953 100644 --- a/cohttp-lwt-unix/examples/client_lwt_timeout.ml +++ b/cohttp-lwt-unix/examples/client_lwt_timeout.ml @@ -11,7 +11,7 @@ let compute ~time ~f = let body = let get () = Client.get (Uri.of_string "https://www.reddit.com/") in compute ~time:0.1 ~f:get >>= function - | `Timeout -> Lwt.fail_with "Timeout expired" + | `Timeout -> failwith "Timeout expired" | `Done (resp, body) -> let code = resp |> Response.status |> Code.code_of_status in Printf.printf "Response code: %d\n" code; diff --git a/cohttp-lwt-unix/test/cohttp_lwt_unix_test/src/cohttp_lwt_unix_test.ml b/cohttp-lwt-unix/test/cohttp_lwt_unix_test/src/cohttp_lwt_unix_test.ml index 58dd083d98..d399ea1503 100644 --- a/cohttp-lwt-unix/test/cohttp_lwt_unix_test/src/cohttp_lwt_unix_test.ml +++ b/cohttp-lwt-unix/test/cohttp_lwt_unix_test/src/cohttp_lwt_unix_test.ml @@ -20,7 +20,7 @@ let expert ?(rsp = Http.Response.make ()) f _req _body = return (`Expert (rsp, f)) let const rsp _req _body = rsp >|= response -let response_sequence = Cohttp_test.response_sequence Lwt.fail_with +let response_sequence = Cohttp_test.response_sequence failwith let () = Debug.activate_debug () let () = Logs.set_level (Some Info) diff --git a/cohttp-lwt-unix/test/test_client.ml b/cohttp-lwt-unix/test/test_client.ml index db0bd5e7e8..07c6520880 100644 --- a/cohttp-lwt-unix/test/test_client.ml +++ b/cohttp-lwt-unix/test/test_client.ml @@ -54,7 +54,7 @@ let methods (handler : Cohttp_lwt.S.call) uri = Body.drain_body body >>= fun () -> match Response.status res with | `Created | `No_content | `OK -> Lwt.return_unit - | _ -> Lwt.fail_with "put failed" + | _ -> failwith "put failed" and get k = handler `GET Uri.(with_path uri k) >>= fun (res, body) -> match Response.status res with diff --git a/cohttp-mirage/src/io.ml b/cohttp-mirage/src/io.ml index 68d64218ae..1e20f8b03e 100644 --- a/cohttp-mirage/src/io.ml +++ b/cohttp-mirage/src/io.ml @@ -54,7 +54,7 @@ module Make (Channel : Mirage_channel.S) = struct Channel.write_string oc buf 0 (String.length buf); Channel.flush oc >>= function | Ok () -> Lwt.return_unit - | Error `Closed -> Lwt.fail_with "Trying to write on closed channel" + | Error `Closed -> failwith "Trying to write on closed channel" | Error e -> Lwt.fail (Write_exn e) let flush _ = diff --git a/cohttp-mirage/src/static.ml b/cohttp-mirage/src/static.ml index e45199bf5c..26b4c95094 100644 --- a/cohttp-mirage/src/static.ml +++ b/cohttp-mirage/src/static.ml @@ -24,7 +24,7 @@ module HTTP (FS : Mirage_kv.RO) (S : Cohttp_lwt.S.Server) = struct open Lwt.Infix open Astring - let failf fmt = Fmt.kstr Lwt.fail_with fmt + let failf fmt = Fmt.failwith fmt let read_fs t name = FS.get t (Key.v name) >>= function