clean up super_error

Author: mununki

jscomp/bsc/dune

@@ -8,5 +8,4 @@
  (public_name bsc)
  (flags
   (:standard -w +a-4-9-30-40-41-42-48-70))
- (libraries common core depends gentype js_parser syntax super_errors
-   outcome_printer))
+ (libraries common core depends gentype js_parser syntax outcome_printer))

jscomp/bsc/rescript_compiler_main.ml

@@ -25,8 +25,7 @@ let setup_compiler_printer (syntax_kind : [ syntax_kind | `default])=
    | `default -> ()  
    | #syntax_kind as k -> Config.syntax_kind := k);   
   let syntax_kind = !Config.syntax_kind in
-  if syntax_kind = `rescript then begin 
-    Lazy.force Super_main.setup;  
+  if syntax_kind = `rescript then begin
     Lazy.force Res_outcome_printer.setup  
   end  
 
@@ -206,7 +205,6 @@ let print_version_string () =
 
 let [@inline] set s : Bsc_args.spec = Unit (Unit_set s)
 let [@inline] clear s : Bsc_args.spec = Unit (Unit_clear s)
-let [@inline] unit_lazy s : Bsc_args.spec = Unit(Unit_lazy s)
 let [@inline] string_call s : Bsc_args.spec = 
   String (String_call s)
 let [@inline] string_optional_set s : Bsc_args.spec = 
@@ -294,10 +292,6 @@ let buckle_script_flags : (string * Bsc_args.spec * string) array =
 
     (******************************************************************************)
 
-
-    "-bs-super-errors", unit_lazy Super_main.setup,
-    "*internal* Better error message combined with other tools ";
-
     "-unboxed-types", set Clflags.unboxed_types,
     "*internal* Unannotated unboxable types will be unboxed";
 

jscomp/build_tests/super_errors/input.js

@@ -27,7 +27,7 @@ let atLeastOneTaskFailed = false
 
 fixtures.forEach(fileName => {
   const fullFilePath = path.join(__dirname, 'fixtures', fileName)
-  const command = `${prefix} -color always -bs-super-errors ${fullFilePath}`
+  const command = `${prefix} -color always ${fullFilePath}`
   console.log(`running ${command}`)
   child_process.exec(command, (err, stdout, stderr) => {
     doneTasksCount++

jscomp/gentype_tests/typescript-react-example/bsconfig.json

@@ -15,7 +15,7 @@
     "exportInterfaces": false
   },
   "name": "sample-typescript-app",
-  "bsc-flags": ["-bs-super-errors"],
+  "bsc-flags": [],
   "jsx": { "version": 3 },
   "bs-dependencies": ["@rescript/react"],
   "sources": [

jscomp/super_errors/super_code_frame.ml renamed to jscomp/ml/code_frame.ml

@@ -2276,32 +2276,42 @@ let env_of_only_summary env_from_summary env =
 
 open Format
 
+(* taken from https://github.com/rescript-lang/ocaml/blob/d4144647d1bf9bc7dc3aadc24c25a7efa3a67915/typing/env.ml#L1842 *)
+(* modified branches are commented *)
 let report_error ppf = function
-  | Illegal_renaming(modname, ps_name, filename) -> fprintf ppf
-      "Wrong file naming: %a@ contains the compiled interface for @ \
-       %s when %s was expected"
-      Location.print_filename filename ps_name modname
-  | Inconsistent_import(name, source1, source2) -> fprintf ppf
+  | Illegal_renaming(name, modname, _filename) ->
+    (* modified *)
+    fprintf ppf
+      "@[You referred to the module %s, but we've found one called %s instead.@ \
+       Is the name's casing right?@]"
+      name modname
+  | Inconsistent_import(name, source1, source2) ->
+    (* modified *)
+    fprintf ppf "@[<v>\
+                 @[@{<info>It's possible that your build is stale.@}@ Try to clean the artifacts and build again?@]@,@,\
+                 @[@{<info>Here's the original error message@}@]@,\
+                 @]";
+    fprintf ppf
       "@[<hov>The files %a@ and %a@ \
-              make inconsistent assumptions@ over interface %s@]"
+       make inconsistent assumptions@ over interface %s@]"
       Location.print_filename source1 Location.print_filename source2 name
   | Need_recursive_types(import, export) ->
-      fprintf ppf
-        "@[<hov>Unit %s imports from %s, which uses recursive types.@ %s@]"
-        export import "The compilation flag -rectypes is required"
+    fprintf ppf
+      "@[<hov>Unit %s imports from %s, which uses recursive types.@ %s@]"
+      export import "The compilation flag -rectypes is required"
   | Missing_module(_, path1, path2) ->
-      fprintf ppf "@[@[<hov>";
-      if Path.same path1 path2 then
-        fprintf ppf "Internal path@ %s@ is dangling." (Path.name path1)
-      else
-        fprintf ppf "Internal path@ %s@ expands to@ %s@ which is dangling."
-          (Path.name path1) (Path.name path2);
-      fprintf ppf "@]@ @[%s@ %s@ %s.@]@]"
-        "The compiled interface for module" (Ident.name (Path.head path2))
-        "was not found"
+    fprintf ppf "@[@[<hov>";
+    if Path.same path1 path2 then
+      fprintf ppf "Internal path@ %s@ is dangling." (Path.name path1)
+    else
+      fprintf ppf "Internal path@ %s@ expands to@ %s@ which is dangling."
+        (Path.name path1) (Path.name path2);
+    fprintf ppf "@]@ @[%s@ %s@ %s.@]@]"
+      "The compiled interface for module" (Ident.name (Path.head path2))
+      "was not found"
   | Illegal_value_name(_loc, name) ->
-      fprintf ppf "'%s' is not a valid value identifier."
-        name
+    fprintf ppf "'%s' is not a valid value identifier."
+      name
 
 let () =
   Location.register_error_of_exn

jscomp/ml/env.ml

@@ -254,7 +254,7 @@ let report_error ppf = function
   | Unterminated_string_in_comment (_, loc) ->
       fprintf ppf "This comment contains an unterminated string literal@.\
                    %aString literal begins here"
-              Location.print_error loc
+              (Location.print_error "") loc
   | Keyword_as_label kwd ->
       fprintf ppf "`%s' is a keyword, it cannot be used as label name" kwd
   | Invalid_literal s ->

jscomp/ml/lexer.mll

@@ -104,40 +104,114 @@ let print_filename ppf file =
 let reset () =
   num_loc_lines := 0
 
-let (msg_file, msg_line, msg_chars, msg_to, msg_colon) =
-  ("File \"", "\", line ", ", characters ", "-", ":")
-
 (* return file, line, char from the given position *)
 let get_pos_info pos =
   (pos.pos_fname, pos.pos_lnum, pos.pos_cnum - pos.pos_bol)
 ;;
 
 let setup_colors () =
-  Misc.Color.setup !Clflags.color
-
-let print_loc ppf loc =
+  Misc.Color.setup !Clflags.color;
+  Code_frame.setup !Clflags.color
+
+(* 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
+   starting from the first erroring character?) *)
+let normalize_range loc =
+  (* TODO: lots of the handlings here aren't needed anymore because the new
+  rescript syntax has much stronger invariants regarding positions, e.g.
+  no -1 *)
+  let (_, start_line, start_char) = get_pos_info loc.loc_start in
+  let (_, end_line, end_char) = get_pos_info loc.loc_end in
+  (* line is 1-indexed, column is 0-indexed. We convert all of them to 1-indexed to avoid confusion *)
+  (* start_char is inclusive, end_char is exclusive *)
+  if start_char == -1 || end_char == -1 then
+    (* happens sometimes. Syntax error for example *)
+    None
+  else if start_line = end_line && start_char >= end_char then
+    (* in some errors, starting char and ending char can be the same. But
+      since ending char was supposed to be exclusive, here it might end up
+      smaller than the starting char if we naively did start_char + 1 to
+      just the starting char and forget ending char *)
+    let same_char = start_char + 1 in
+    Some ((start_line, same_char), (end_line, same_char))
+  else
+    (* again: end_char is exclusive, so +1-1=0 *)
+    Some ((start_line, start_char + 1), (end_line, end_char))
+
+let print_loc ppf (loc : t) =
   setup_colors ();
-  let (file, line, startchar) = get_pos_info loc.loc_start in
-  let startchar =  startchar + 1 in 
-  let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in
-  begin
-    fprintf ppf "%s@{<loc>%a%s%i" msg_file print_filename file msg_line line;
-    if startchar >= 0 then
-      fprintf ppf "%s%i%s%i" msg_chars startchar msg_to endchar;
-    fprintf ppf "@}"
-  end
+  let normalized_range = normalize_range loc in
+  let dim_loc ppf = function
+    | None -> ()
+    | Some ((start_line, start_line_start_char), (end_line, end_line_end_char)) ->
+      if start_line = end_line then
+        if start_line_start_char = end_line_end_char then
+          fprintf ppf ":@{<dim>%i:%i@}" start_line start_line_start_char
+        else
+          fprintf ppf ":@{<dim>%i:%i-%i@}" start_line start_line_start_char end_line_end_char
+      else
+        fprintf ppf ":@{<dim>%i:%i-%i:%i@}" start_line start_line_start_char end_line end_line_end_char
+  in
+  fprintf ppf "@{<filename>%a@}%a" print_filename loc.loc_start.pos_fname dim_loc normalized_range
 ;;
 
-let default_printer ppf loc =
-  setup_colors ();
-  fprintf ppf "@{<loc>%a@}%s@," print_loc loc msg_colon
+let print ~message_kind intro ppf (loc : 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;
+  (* 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
+     starting from the first erroring character?) *)
+  let (file, start_line, start_char) = get_pos_info loc.loc_start in
+  let (_, end_line, end_char) = get_pos_info loc.loc_end in
+  (* line is 1-indexed, column is 0-indexed. We convert all of them to 1-indexed to avoid confusion *)
+  (* start_char is inclusive, end_char is exclusive *)
+  let normalizedRange =
+    (* TODO: lots of the handlings here aren't needed anymore because the new
+      rescript syntax has much stronger invariants regarding positions, e.g.
+      no -1 *)
+    if start_char == -1 || end_char == -1 then
+      (* happens sometimes. Syntax error for example *)
+      None
+    else if start_line = end_line && start_char >= end_char then
+      (* in some errors, starting char and ending char can be the same. But
+         since ending char was supposed to be exclusive, here it might end up
+         smaller than the starting char if we naively did start_char + 1 to
+         just the starting char and forget ending char *)
+      let same_char = start_char + 1 in
+      Some ((start_line, same_char), (end_line, same_char))
+    else
+      (* again: end_char is exclusive, so +1-1=0 *)
+      Some ((start_line, start_char + 1), (end_line, end_char))
+  in
+  fprintf ppf "  @[%a@]@," print_loc loc;
+  match normalizedRange with
+  | None -> ()
+  | Some _ -> begin
+      try
+        let src = Ext_io.load_file file in
+        (* we're putting the line break `@,` here rather than above, because this
+           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 "@,%s"
+          (Code_frame.print
+            ~is_warning:(message_kind=`warning)
+            ~src
+            ~startPos:loc.loc_start
+            ~endPos:loc.loc_end
+          )
+      with
+      (* this might happen if the file is e.g. "", "_none_" or any of the fake file name placeholders.
+         we've already printed the location above, so nothing more to do here. *)
+      | Sys_error _ -> ()
+    end
 ;;
 
-let printer = ref default_printer
-let print ppf loc = !printer ppf loc
-
 let error_prefix = "Error"
-let warning_prefix = "Warning"
 
 let print_error_prefix ppf =
   setup_colors ();
@@ -153,30 +227,22 @@ let print_compact ppf loc =
   end
 ;;
 
-let print_error ppf loc =
-  fprintf ppf "%a%t:" print loc print_error_prefix;
+let print_error intro ppf loc =
+  fprintf ppf "%a%t:" (print ~message_kind:`error intro) loc print_error_prefix;
 ;;
 
-let print_error_cur_file ppf () = print_error ppf (in_file !input_name);;
-
 let default_warning_printer loc ppf w =
   match Warnings.report w with
   | `Inactive -> ()
-  | `Active { Warnings. number; message; is_error; sub_locs } ->
+  | `Active { Warnings. number = _; message = _; is_error; sub_locs = _} ->
     setup_colors ();
-    fprintf ppf "@[<v>";
-    print ppf loc;
-    if is_error
-    then
-      fprintf ppf "%t (%s %d): %s@," print_error_prefix
-           (String.uncapitalize_ascii warning_prefix) number message
-    else fprintf ppf "@{<warning>%s@} %d: %s@," warning_prefix number message;
-    List.iter
-      (fun (loc, msg) ->
-         if loc <> none then fprintf ppf "  %a  %s@," print loc msg
-      )
-      sub_locs;
-    fprintf ppf "@]"
+    let message_kind = if is_error then `warning_as_error else `warning in
+    Format.fprintf ppf "@[<v>@,  %a@,  %s@,@]@."
+      (print ~message_kind ("Warning number " ^ (Warnings.number w |> string_of_int)))
+      loc
+      (Warnings.message w);
+    (* at this point, you can display sub_locs too, from e.g. https://github.com/ocaml/ocaml/commit/f6d53cc38f87c67fbf49109f5fb79a0334bab17a
+       but we won't bother for now *)
 ;;
 
 let warning_printer = ref default_warning_printer ;;
@@ -225,10 +291,13 @@ let pp_ksprintf ?before k fmt =
       k msg)
     ppf fmt
 
+(* taken from https://github.com/rescript-lang/ocaml/blob/d4144647d1bf9bc7dc3aadc24c25a7efa3a67915/parsing/location.ml#L354 *)
 (* Shift the formatter's offset by the length of the error prefix, which
    is always added by the compiler after the message has been formatted *)
 let print_phanton_error_prefix ppf =
-  Format.pp_print_as ppf (String.length error_prefix + 2 (* ": " *)) ""
+  (* modified from the original. We use only 2 indentations for error report
+     (see super_error_reporter above) *)
+  Format.pp_print_as ppf 2 ""
 
 let errorf ?(loc = none) ?(sub = []) ?(if_highlight = "") fmt =
   pp_ksprintf
@@ -258,11 +327,14 @@ let error_of_exn exn =
      in
      loop !error_of_exn
 
-
+(* 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 default_error_reporter ppf ({loc; msg; sub}) =
-    fprintf ppf "@[<v>%a %s" print_error loc msg;
-    List.iter (Format.fprintf ppf "@,@[<2>%a@]" default_error_reporter) sub;
-    fprintf ppf "@]"
+  setup_colors ();
+  (* open a vertical box. Everything in our message is indented 2 spaces *)
+  Format.fprintf ppf "@[<v>@,  %a@,  %s@,@]" (print ~message_kind:`error "We've found a bug for you!") loc msg;
+  List.iter (Format.fprintf ppf "@,@[%a@]" default_error_reporter) sub
+(* no need to flush here; location's report_exception (which uses this ultimately) flushes *)
 
 let error_reporter = ref default_error_reporter
 

jscomp/ml/location.ml

@@ -56,16 +56,12 @@ val input_lexbuf: Lexing.lexbuf option ref
 
 val get_pos_info: Lexing.position -> string * int * int (* file, line, char *)
 val print_loc: formatter -> t -> unit
-val print_error: formatter -> t -> unit
-val print_error_cur_file: formatter -> unit -> unit
+val print_error: tag -> formatter -> t -> unit
 
 val prerr_warning: t -> Warnings.t -> unit
 val echo_eof: unit -> unit
 val reset: unit -> unit
 
-val default_printer : formatter -> t -> unit
-val printer : (formatter -> t -> unit) ref
-
 val warning_printer : (t -> formatter -> Warnings.t -> unit) ref
 (** Hook for intercepting warnings. *)
 
@@ -82,7 +78,7 @@ type 'a loc = {
 val mknoloc : 'a -> 'a loc
 val mkloc : 'a -> t -> 'a loc
 
-val print: formatter -> t -> unit
+val print: message_kind:[< `error | `warning | `warning_as_error > `warning] -> string -> formatter -> t -> unit
 val print_compact: formatter -> t -> unit
 val print_filename: formatter -> string -> unit