fix(melange): don't crash when transitive PPX isn't found

Signed-off-by: Antonio Nuno Monteiro <anmonteiro@gmail.com>

src/dune_rules/melange/melange_rules.ml

@@ -469,7 +469,6 @@ let setup_emit_js_rules ~dir_contents ~dir ~scope ~sctx mel =
     let* modules_for_js, _obj_dir =
       modules_for_js_and_obj_dir ~sctx ~dir_contents ~scope mel
     in
-    Resolve.push_frames resolve_error @@ fun () ->
     let module_systems = mel.module_systems in
     let output = `Private_library_or_emit target_dir in
     let loc = mel.loc in
@@ -478,5 +477,8 @@ let setup_emit_js_rules ~dir_contents ~dir ~scope ~sctx mel =
             let file_targets = [ make_js_name ~output ~js_ext m ] in
             Super_context.add_rule sctx ~dir ~loc ~mode
               (Action_builder.fail
-                 { fail = (fun () -> Resolve.raise_error resolve_error) }
+                 { fail =
+                     (fun () ->
+                       Resolve.raise_error_with_stack_trace resolve_error)
+                 }
               |> Action_builder.with_file_targets ~file_targets)))

src/dune_rules/resolve.ml

@@ -54,9 +54,20 @@ let push_frames { stack_frames; message = _ } f =
   in
   loop stack_frames
 
-let raise_error { message; _ } = raise (User_error.E message)
-
-let error_to_memo error = push_frames error (fun () -> raise_error error)
+let error_to_memo error =
+  push_frames error (fun () -> raise (User_error.E error.message))
+
+let raise_error_with_stack_trace { message; stack_frames } =
+  match
+    Dune_util.Report_error.format_memo_stack
+      (List.map stack_frames ~f:Lazy.force)
+  with
+  | None -> raise (User_error.E message)
+  | Some stack ->
+    let message =
+      { message with paragraphs = message.paragraphs @ [ stack ] }
+    in
+    raise (User_error.E message)
 
 let read_memo = function
   | Ok x -> Memo.return x

src/dune_rules/resolve.mli

@@ -108,9 +108,7 @@ type error
 
 val to_result : 'a t -> ('a, error) result
 
-val raise_error : error -> 'a
-
-val push_frames : error -> (unit -> 'a Memo.t) -> 'a Memo.t
+val raise_error_with_stack_trace : error -> 'a
 
 (** Read a [Resolve.t] value inside the action builder monad. *)
 val read : 'a t -> 'a Action_builder.t

src/dune_util/report_error.mli

@@ -22,3 +22,6 @@ exception Already_reported
 
 (** Print the memo stacks of errors. *)
 val print_memo_stacks : bool ref
+
+(** Format a list of Memo stack frames into a user-friendly presentation *)
+val format_memo_stack : 'a Pp.t list -> 'a Pp.t option

test/blackbox-tests/test-cases/melange/transitive-ppx.t

@@ -20,8 +20,6 @@ Test interaction of melange.emit library ppx dependencies
   > EOF
   $ touch lib/impl/subdir.ml
 
-Depending on the `subdir` library (preprocessed by a missing PPX) crashes dune
-
   $ cat > lib/test/dune <<EOF
   > (melange.emit
   >  (target dist)
@@ -30,5 +28,22 @@ Depending on the `subdir` library (preprocessed by a missing PPX) crashes dune
   >  (libraries subdir))
   > EOF
 
-  $ dune build 2>&1 | grep "must not crash"
-  I must not crash.  Uncertainty is the mind-killer. Exceptions are the
+  $ dune build
+  File "lib/impl/dune", line 5, characters 18-29:
+  5 |  (preprocess (pps not-present)))
+                        ^^^^^^^^^^^
+  Error: Library "not-present" not found.
+  -> required by library "mel-subdir" in _build/default/lib/impl
+  -> required by melange target dist
+  -> required by alias lib/test/all
+  -> required by alias default
+  File "lib/impl/dune", line 5, characters 18-29:
+  5 |  (preprocess (pps not-present)))
+                        ^^^^^^^^^^^
+  Error: Library "not-present" not found.
+  -> required by melange target dist
+  -> required by library "mel-subdir" in _build/default/lib/impl
+  -> required by _build/default/lib/test/dist/lib/test/.dist.mobjs/melange.js
+  -> required by alias lib/test/all
+  -> required by alias default
+  [1]