From 824312f7bd09dc958031d3925d0c43d57ad6e677 Mon Sep 17 00:00:00 2001
From: Fermin Reig <fermin.reig@ahrefs.com>
Date: Wed, 16 Oct 2024 17:57:41 +0100
Subject: [PATCH] use Stdlib.raise and Lwt.reraise instead of Lwt.fail for
 better backtraces

---
 daemon.ml   | 2 +-
 exn_lwt.ml  | 2 +-
 httpev.ml   | 2 +-
 lwt_mark.ml | 2 +-
 lwt_util.ml | 2 +-
 nix.ml      | 2 +-
 web.ml      | 4 ++--
 7 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/daemon.ml b/daemon.ml
index 72243ce..c0e5343 100644
--- a/daemon.ml
+++ b/daemon.ml
@@ -40,7 +40,7 @@ let wait_exit =
     Bind to should_exit_lwt only once, because every bind will create an immutable waiter on
     should_exit_lwt's sleeper, that is only removed after should_exit_lwt thread terminates.
   *)
-  let thread = lazy (Lwt.bind should_exit_lwt (fun () -> Lwt.fail ShouldExit)) in
+  let thread = lazy (Lwt.bind should_exit_lwt (fun () -> raise ShouldExit)) in
   fun () -> Lazy.force thread
 
 (** [break_lwt = Lwt.wrap break] *)
diff --git a/exn_lwt.ml b/exn_lwt.ml
index 0b48d40..9a72041 100644
--- a/exn_lwt.ml
+++ b/exn_lwt.ml
@@ -9,4 +9,4 @@ let map f x = Lwt.try_bind (fun () -> f x) (fun r -> Lwt.return (`Ok r)) (fun ex
 
 let fail = Exn.fail
 
-let invalid_arg fmt = ksprintf Lwt.fail_invalid_arg fmt
+let invalid_arg fmt = ksprintf Stdlib.invalid_arg fmt
diff --git a/httpev.ml b/httpev.ml
index 1e6b847..20ba071 100644
--- a/httpev.ml
+++ b/httpev.ml
@@ -606,7 +606,7 @@ let handle_lwt ?(single=false) fd k =
     let pause = 2. in
     log #error "too many open files, disabling accept for %s" (Time.duration_str pause);
     Lwt_unix.sleep pause
-  | `Exn Lwt.Canceled -> log #info "canceling accept loop"; Lwt.fail Lwt.Canceled
+  | `Exn (Lwt.Canceled as exn) -> log #info "canceling accept loop"; Lwt.reraise exn
   | `Exn exn -> log #warn ~exn "accept"; Lwt.return_unit
   | `Ok (fd,addr as peer) ->
     let task =
diff --git a/lwt_mark.ml b/lwt_mark.ml
index 72e347f..001a5fa 100644
--- a/lwt_mark.ml
+++ b/lwt_mark.ml
@@ -119,7 +119,7 @@ let with_mark v f =
 let run_thread on_success on_failure func =
   match func () with
   | thr -> Lwt.on_any thr on_success on_failure; thr
-  | exception exn -> on_failure exn; Lwt.fail exn
+  | exception exn -> on_failure exn; Lwt.reraise exn
 
 let mark_or_orphan id =
   try Hashtbl.find marks id with Not_found -> orphan_mark
diff --git a/lwt_util.ml b/lwt_util.ml
index 2551c69..a76a3b4 100644
--- a/lwt_util.ml
+++ b/lwt_util.ml
@@ -54,7 +54,7 @@ let suppress_exn name cleanup t =
 let action name f x =
   log #info "action %s started" name;
   match%lwt f x with
-  | exception exn -> log #error ~exn "action %s aborted" name; Lwt.fail exn
+  | exception exn -> log #error ~exn "action %s aborted" name; Lwt.reraise exn
   | x -> log #info "action %s done" name; Lwt.return x
 
 let action_do name f = action name f ()
diff --git a/nix.ml b/nix.ml
index 4f9b3b1..9c10fe1 100644
--- a/nix.ml
+++ b/nix.ml
@@ -308,7 +308,7 @@ let connect_lwt fd sockaddr =
   let open Lwt_unix in
   Lwt.catch
     (fun () -> connect fd sockaddr)
-    (function Unix_error (e, f, "") -> Lwt.fail (Unix_error (e, f, show_addr sockaddr)) | exn -> Lwt.fail exn)
+    (function Unix_error (e, f, "") -> raise (Unix_error (e, f, show_addr sockaddr)) | exn -> Lwt.reraise exn)
 
 let get_xdg_dir ~env dir =
   try Sys.getenv env with Not_found ->
diff --git a/web.ml b/web.ml
index d617e53..22bcaa0 100644
--- a/web.ml
+++ b/web.ml
@@ -359,8 +359,8 @@ module IO_lwt = struct
   let bracket mresource destroy k =
     let%lwt resource = mresource in
     (k resource) [%finally destroy resource]
-  let fail = Exn_lwt.fail
-  let raise = Lwt.fail
+  let fail = Exn.fail
+  let raise = raise
   let sleep = Lwt_unix.sleep
   let map_s = Lwt_list.map_s
   let catch = Lwt.catch