[Playground] Show alerts

bin/jsoo_main.ml

@@ -42,11 +42,8 @@ let warnings_collected : Location.report list ref = ref []
 (* We need to overload the original warning printer to capture the warnings
    and not let them go through default printer (which will end up in browser
    console) *)
-let playground_warning_reporter (loc : Location.t) w : Location.report option =
-  let mk ~is_error id =
-    if is_error then Location.Report_warning_as_error id else Report_warning id
-  in
-  match Warnings.report w with
+let playground_reporter ~f ~mk (loc : Location.t) w : Location.report option =
+  match f w with
   | `Inactive -> None
   | `Active { Warnings.id; message; is_error; sub_locs } ->
       let msg_of_str str ppf = Format.pp_print_string ppf str in
@@ -61,6 +58,18 @@ let playground_warning_reporter (loc : Location.t) w : Location.report option =
       warnings_collected := { Location.kind; main; sub } :: !warnings_collected;
       None
 
+let playground_warning_reporter =
+  let mk ~is_error id =
+    if is_error then Location.Report_warning_as_error id else Report_warning id
+  in
+  playground_reporter ~f:Warnings.report ~mk
+
+let playground_alert_reporter =
+  let mk ~is_error id =
+    if is_error then Location.Report_alert_as_error id else Report_alert id
+  in
+  playground_reporter ~f:Warnings.report_alert ~mk
+
 let error_of_exn e =
   match Location.error_of_exn e with
   | Some (`Ok e) -> Some e
@@ -259,7 +268,10 @@ let compile =
       | None -> (
           let default =
             lazy
-              (Js.obj [| ("js_warning_error_msg", Js.string (Printexc.to_string e)) |])
+              (Js.obj
+                 [|
+                   ("js_warning_error_msg", Js.string (Printexc.to_string e));
+                 |])
           in
           match e with
           | Warnings.Errors -> (
@@ -297,6 +309,7 @@ let () =
   Clflags.binary_annotations := false;
   Clflags.color := None;
   Location.warning_reporter := playground_warning_reporter;
+  Location.alert_reporter := playground_alert_reporter;
   (* To add a directory to the load path *)
   Load_path.add_dir "/static"
 

test/blackbox-tests/melange-playground/compile-ml-warning-alert.t

@@ -0,0 +1,51 @@
+  $ cat > input.js <<EOF
+  > require(process.env.DUNE_SOURCEROOT + '/_build/default/bin/jsoo_main.bc.js');
+  > require(process.env.DUNE_SOURCEROOT + '/_build/default/bin/melange-cmijs.js');
+  > console.log(ocaml.compileML("let t = Js.Vector.length"));
+  > EOF
+
+  $ node input.js
+  {
+    js_code: '// Generated by Melange\n' +
+      '\n' +
+      '\n' +
+      'function t(prim) {\n' +
+      '  return prim.length;\n' +
+      '}\n' +
+      '\n' +
+      'export {\n' +
+      '  t ,\n' +
+      '}\n' +
+      '/* No side effect */\n',
+    warnings: [
+      {
+        js_warning_error_msg: 'Line 1, 8:\n  Alert: deprecated module Js.Vector\nUse Belt.Array instead',
+        row: 0,
+        column: 8,
+        endRow: 0,
+        endColumn: 24,
+        text: 'module Js.Vector\nUse Belt.Array instead',
+        type: 'alert'
+      }
+    ],
+    type_hints: [
+      {
+        start: [Object],
+        end: [Object],
+        kind: 'expression',
+        hint: "'a Js.Vector.t -> int"
+      },
+      {
+        start: [Object],
+        end: [Object],
+        kind: 'pattern_type',
+        hint: "'a Js.Vector.t -> int"
+      },
+      {
+        start: [Object],
+        end: [Object],
+        kind: 'binding',
+        hint: "'a Js.Vector.t -> int"
+      }
+    ]
+  }