Merge pull request rescript-lang#4664 from rescript-lang/simplify_warning_reporting

start simplify warning reporting

Author: bobzhang

jscomp/build_tests/super_errors/expected/highlighting4.re.expected

@@ -1,5 +1,5 @@
 
-  Warning number 3 (configured as error) 
+  Warning number 3
   /.../fixtures/highlighting4.re:5:10
 
   3 │ [@deprecated]

jscomp/core/js_implementation.ml

@@ -12,11 +12,16 @@
 
 (* adapted by rescript from [driver/compile.ml] for convenience    *)
 
-open Format
-open Typedtree
-open Compenv
-
-
+let module_of_filename  outputprefix =
+  let basename = Filename.basename outputprefix in
+  let name =
+    try
+      let pos = String.index basename '.' in
+      String.sub basename 0 pos
+    with Not_found -> basename
+  in
+  String.capitalize_ascii name 
+;;
 
 let fprintf = Format.fprintf
 
@@ -71,7 +76,7 @@ let after_parsing_sig ppf  outputprefix ast  =
     Warnings.check_fatal()
   else 
     begin 
-      let modulename = module_of_filename ppf !Location.input_name outputprefix in
+      let modulename = module_of_filename outputprefix in
       Lam_compile_env.reset () ;
       let initial_env = Res_compmisc.initial_env () in
       Env.set_unit_name modulename;
@@ -83,7 +88,7 @@ let after_parsing_sig ppf  outputprefix ast  =
       let sg = tsg.sig_type in
       if !Clflags.print_types then
         Printtyp.wrap_printing_env initial_env (fun () ->
-            fprintf std_formatter "%a@."
+            fprintf Format.std_formatter "%a@."
               Printtyp.signature (Typemod.simplify_signature sg));
       ignore (Includemod.signatures initial_env sg sg);
       Typecore.force_delayed_checks ();

jscomp/super_errors/super_location.ml

@@ -25,12 +25,8 @@ let print_loc ~normalizedRange ppf (loc : Location.t) =
   fprintf ppf "@{<filename>%a@}%a" print_filename loc.loc_start.pos_fname dim_loc normalizedRange
 ;;
 
-let print ~message_kind intro ppf (loc : Location.t) =
-    begin match message_kind with
-    | `warning -> fprintf ppf "@[@{<info>%s@}@]@," intro
-    | `warning_as_error -> fprintf ppf "@[@{<error>%s@} (configured as error) @]@," intro
-    | `error -> fprintf ppf "@[@{<error>%s@}@]@," intro
-    end;
+let print intro ppf (loc : Location.t) =
+    fprintf ppf "@[@{<error>%s@}@]@," intro;
     (* ocaml's reported line/col numbering is horrible and super error-prone
       when being handled programmatically (or humanly for that matter. If you're
       an ocaml contributor reading this: who the heck reads the character count
@@ -64,7 +60,7 @@ let print ~message_kind intro ppf (loc : Location.t) =
            branch might not be reached (aka no inline file content display) so
            we don't wanna end up with two line breaks in the the consequent *)
         fprintf ppf "@,%a"
-          (Super_misc.print_file ~is_warning:(message_kind=`warning) ~lines ~range)
+          (Super_misc.print_file  ~lines ~range)
           ()
       with
       (* this might happen if the file is e.g. "", "_none_" or any of the fake file name placeholders.
@@ -75,37 +71,23 @@ let print ~message_kind intro ppf (loc : Location.t) =
 
 (* taken from https://github.com/rescript-lang/ocaml/blob/d4144647d1bf9bc7dc3aadc24c25a7efa3a67915/parsing/location.ml#L380 *)
 (* This is the error report entry point. We'll replace the default reporter with this one. *)
-let rec super_error_reporter ppf ({Location.loc; msg; sub; if_highlight} as err) =
-  let highlighted =
-    if if_highlight <> "" then
-      let rec collect_locs locs {Location.loc; sub; if_highlight = _; _} =
-        List.fold_left collect_locs (loc :: locs) sub
-      in
-      let locs = collect_locs [] err in
-      Location.highlight_locations ppf locs
-    else
-      false
-  in
-  if highlighted then
-    Format.pp_print_string ppf if_highlight
-  else begin
-    setup_colors ();
-    (* open a vertical box. Everything in our message is indented 2 spaces *)
-    Format.fprintf ppf "@[<v 2>@,%a@,%s@,@]" (print ~message_kind:`error "We've found a bug for you!") loc msg;
-    List.iter (Format.fprintf ppf "@,@[%a@]" super_error_reporter) sub;
+let rec super_error_reporter ppf ({loc; msg; sub} : Location.error) =
+  setup_colors ();
+  (* open a vertical box. Everything in our message is indented 2 spaces *)
+  Format.fprintf ppf "@[<v 2>@,%a@,%s@,@]" (print  "We've found a bug for you!") loc msg;
+  List.iter (Format.fprintf ppf "@,@[%a@]" super_error_reporter) sub
     (* no need to flush here; location's report_exception (which uses this ultimately) flushes *)
-  end
+
 
 (* extracted from https://github.com/rescript-lang/ocaml/blob/d4144647d1bf9bc7dc3aadc24c25a7efa3a67915/parsing/location.ml#L299 *)
 (* This is the warning report entry point. We'll replace the default printer with this one *)
 let super_warning_printer loc ppf w =
   match Warnings.report w with
   | `Inactive -> ()
-  | `Active { Warnings. number = _; message = _; is_error; sub_locs = _} ->
-    setup_colors ();
-    let message_kind = if is_error then `warning_as_error else `warning in
-    Format.fprintf ppf "@[<v 2>@,%a@,%s@,@]"
-      (print ~message_kind ("Warning number " ^ (Warnings.number w |> string_of_int)))
+  | `Active { Warnings. number = _; message = _;  sub_locs = _} ->
+    setup_colors ();    
+    Format.fprintf ppf "@[<v 2>@,%a@,%s@,@]@."
+      (print  ("Warning number " ^ (Warnings.number w |> string_of_int)))
       loc
       (Super_warnings.message w);
     (* at this point, you can display sub_locs too, from e.g. https://github.com/ocaml/ocaml/commit/f6d53cc38f87c67fbf49109f5fb79a0334bab17a

jscomp/super_errors/super_location.mli

@@ -0,0 +1,15 @@
+
+
+val error_of_printer :
+  Location.t -> 
+  (Format.formatter -> 'a -> unit) -> 
+  'a -> 
+  Location.error
+
+val error_of_printer_file :
+  (Format.formatter -> 'a -> unit) -> 
+  'a -> 
+  Location.error
+
+  
+val setup : unit -> unit

jscomp/super_errors/super_misc.ml

@@ -36,7 +36,7 @@ type current_printed_line_status =
 (* Range coordinates all 1-indexed, like for editors. Otherwise this code
   would have way too many off-by-one errors *)
 let print_file 
-~is_warning 
+
 (* start_line_start_char inclusive, end_line_end_char exclusive *)
 ~range:((start_line, start_line_start_char), (end_line, end_line_end_char)) 
 ~lines
@@ -69,10 +69,10 @@ ppf
   | Some n -> n
   in
   (* coloring *)
-  let highlighted_line_number : _ format = if is_warning then "@{<info>%s@}%a" else "@{<error>%s@}%a" in
+  let highlighted_line_number : _ format = "@{<error>%s@}%a" in
 
   let print_char_maybe_highlight ~begin_highlight_line ~end_highlight_line ch =
-    let highlighted_open_tag: _ format = if is_warning then "@{<info>" else "@{<error>" in
+    let highlighted_open_tag: _ format = "@{<error>" in
     if begin_highlight_line then fprintf ppf highlighted_open_tag;
     fprintf ppf "%c@," ch;
     if end_highlight_line then fprintf ppf "@}"

jscomp/super_errors/super_misc.mli

@@ -1,3 +1,5 @@
 (** Range coordinates all 1-indexed, like for editors. Otherwise this code
   would have way too many off-by-one errors *)
-val print_file: is_warning:bool -> range:(int * int) * (int * int) -> lines:string array -> Format.formatter -> unit -> unit
+val print_file: 
+  range:(int * int) * (int * int) ->
+  lines:string array -> Format.formatter -> unit -> unit

jscomp/super_errors/super_pparse.ml

@@ -1,9 +1,9 @@
-let fprintf = Format.fprintf
+
 
 (* taken from https://github.com/rescript-lang/ocaml/blob/d4144647d1bf9bc7dc3aadc24c25a7efa3a67915/driver/pparse.ml#L170 *)
 (* modified branches are commented *)
 let report_error ppf () = 
-      fprintf ppf
+      Format.fprintf ppf
         "@[<v>@{<info>There's been an error running Reason's parser on a file.@}@,\
           If the message doesn't help, check for errors slightly above.@,\
           @[Please file an issue on@ github.com/facebook/reason.@ Thanks!@]@]"