From 595af2fb94acf69cc8aa6abce0323cce74f0775e Mon Sep 17 00:00:00 2001
From: Michael Thomas <mjt@meta.com>
Date: Fri, 14 Oct 2022 05:44:15 -0700
Subject: [PATCH] Improve exception details for `Future_failure`

Summary:
The `error` union inside a `Future_failure` exception uses a first-class module within the `External` case. As a result, OCaml does not render the inner error (it is existentially bound) and we don't get any useful information about these exceptions.

This diff registers a pretty printer for the `Future_failure` exception which uses `error_to_string` to render the inner `Error.t`

Reviewed By: hgoldstein

Differential Revision: D40224847

fbshipit-source-id: 825cbe48c1005b11bed6489583ce932151789419
---
 hphp/hack/src/utils/process/future.ml       |  5 +++++
 hphp/hack/test/unit/process/process_test.ml | 18 ++++++++++++++++++
 2 files changed, 23 insertions(+)

diff --git a/hphp/hack/src/utils/process/future.ml b/hphp/hack/src/utils/process/future.ml
index 2803218c079..cca5e3a2b0d 100644
--- a/hphp/hack/src/utils/process/future.ml
+++ b/hphp/hack/src/utils/process/future.ml
@@ -205,6 +205,11 @@ let error_to_string_verbose err : verbose_error =
     let module I = (val err : Error_instance) in
     I.Error.to_string_verbose I.this
 
+let () =
+  Stdlib.Printexc.register_printer (function
+      | Future_failure e -> Some (error_to_string e)
+      | _ -> None)
+
 (* Must explicitly make recursive functions polymorphic. *)
 let rec get : 'value. ?timeout:int -> 'value t -> ('value, error) result =
  fun ?(timeout = default_timeout) (promise, _) ->
diff --git a/hphp/hack/test/unit/process/process_test.ml b/hphp/hack/test/unit/process/process_test.ml
index 9440d741d6b..3eacc1cc617 100644
--- a/hphp/hack/test/unit/process/process_test.ml
+++ b/hphp/hack/test/unit/process/process_test.ml
@@ -1,5 +1,22 @@
 open Asserter
 
+let test_exception_pp () =
+  let prefix = "Bang!!!" in
+  let err_inst = Future.create_default_error_instance prefix in
+  let gv ~timeout:_ = Error err_inst in
+  let future = Future.make (gv, (fun _ -> true)) in
+  try
+    Future.get_exn future;
+    failwith "Expected future to throw an exception"
+  with
+  | exn ->
+    let e = Exception.wrap exn in
+    Bool_asserter.assert_equals
+      true
+      (String.starts_with ~prefix @@ Exception.to_string e)
+      "Expected error to be rendered correctly";
+    true
+
 let test_delayed_future () =
   let future = Future.delayed_value ~delays:3 "Delayed value" in
   Bool_asserter.assert_equals false (Future.is_ready future) "First delay";
@@ -206,6 +223,7 @@ let test_bound_future_idempotency () =
 
 let tests =
   [
+    ("test_exception_pp", test_exception_pp);
     ("test_delayed_future", test_delayed_future);
     ("test_continue_delayed_future_with", test_continue_delayed_future_with);
     ("test_of_error", test_of_error);
-- 
2.11.4.GIT