Reduce color numbers, remove semantic tags, simplify setup

Author: chenglou

jscomp/ext/ext_color.ml

@@ -81,9 +81,11 @@ let style_of_tag s = match s with
  | "error" -> [Bold; FG Red]
  | "warning" -> [Bold; FG Magenta]
  | "info" -> [Bold; FG Yellow]
+ | "dim" -> [Dim]
+ | "filename" -> [FG Cyan]
  | _ -> []
 
-let ansi_of_tag ?(style_of_tag=style_of_tag) s = 
+let ansi_of_tag s = 
  let l = style_of_tag s in
  let s = String.concat ";" (List.map code_of_style l) in
  "\x1b[" ^ s ^ "m"

jscomp/ext/ext_color.mli

@@ -39,6 +39,6 @@ type style
  | Dim
 
 (** Input is the tag for example `@{<warning>@}` return escape code *)
-val ansi_of_tag : ?style_of_tag:(string -> style list) -> string -> string 
+val ansi_of_tag : string -> string 
 
 val reset_lit : string

jscomp/super_errors/super_location.ml

@@ -45,25 +45,30 @@ let print_loc ppf loc =
  end
 ;;
 
-let print intro ppf loc =
+let print ~is_warning intro ppf loc =
  setup_colors ();
  (* TODO: handle locations such as _none_ and "" *)
  if loc.loc_start.pos_fname = "//toplevel//"
  && highlight_locations ppf [loc] then ()
  else
- fprintf ppf "@[@{<intro>%s@}@]@," intro; 
+ if is_warning then 
+ fprintf ppf "@[@{<info>%s@}@]@," intro
+ else begin
+ fprintf ppf "@[@{<error>%s@}@]@," intro
+ end;
  fprintf ppf "@[%a@]@,@," print_loc loc;
  let (file, start_line, start_char) = Location.get_pos_info loc.loc_start in
  let (_, end_line, end_char) = Location.get_pos_info loc.loc_end in
  (* things to special-case: startchar & endchar2 both -1 *)
  if start_char == -1 || end_char == -1 then
  (* happens sometimes. Syntax error for example *)
- fprintf ppf "This is likely a syntax error. The more relevant message should be just above!@ If it's not, please file an issue here:@ github.com/facebook/reason/issues@,"
+ fprintf ppf "Is there an error before this one? If so, it's likely a syntax error. The more relevant message should be just above!@ If it's not, please file an issue here:@ github.com/facebook/reason/issues@,"
  else begin
  try 
  let lines = file_lines file in
  fprintf ppf "%a"
  (Super_misc.print_file
+ ~is_warning
  ~lines
  ~range:(
  (start_line, start_char + 1), (* make everything 1-index based. See justifications in Super_mic.print_file *)
@@ -79,14 +84,6 @@ let print intro ppf loc =
 (* taken from https://github.com/ocaml/ocaml/blob/4.02/parsing/location.ml#L337 *)
 (* 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) =
- Super_misc.colorize_tagged_string ppf (function
- | "intro" -> [Bold; FG Red]
- | "filename" -> [FG Cyan]
- | "affected_line_number" -> [Bold; FG Red]
- | "affected_line_content" -> [FG Red]
- | "separator" -> [Dim]
- | _ -> []
- );
  let highlighted =
  if if_highlight <> "" then
  let rec collect_locs locs {Location.loc; sub; if_highlight; _} =
@@ -100,8 +97,9 @@ let rec super_error_reporter ppf ({Location.loc; msg; sub; if_highlight} as err)
  if highlighted then
  Format.pp_print_string ppf if_highlight
  else begin
+ Super_misc.setup_colors ppf;
  (* 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;
+ Format.fprintf ppf "@[<v 2>@,%a@,%s@,@]" (print ~is_warning:false "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
@@ -110,18 +108,11 @@ let rec super_error_reporter ppf ({Location.loc; msg; sub; if_highlight} as err)
 (* This is the warning report entry point. We'll replace the default printer with this one *)
 let super_warning_printer loc ppf w =
  if Warnings.is_active w then begin
- Super_misc.colorize_tagged_string ppf (function
- | "intro" -> [Bold; FG Yellow]
- | "filename" -> [FG Cyan]
- | "affected_line_number" -> [Bold; FG Yellow]
- | "affected_line_content" -> [FG Yellow]
- | "separator" -> [Dim]
- | _ -> []
- );
+ Super_misc.setup_colors ppf;
  Misc.Color.setup !Clflags.color;
  (* open a vertical box. Everything in our message is indented 2 spaces *)
  Format.fprintf ppf "@[<v 2>@,%a@,%a@,@]" 
- (print ("Warning number " ^ (Super_warnings.number w |> string_of_int))) 
+ (print ~is_warning:true ("Warning number " ^ (Super_warnings.number w |> string_of_int))) 
  loc 
  Super_warnings.print 
  w

jscomp/super_errors/super_misc.ml

@@ -32,7 +32,7 @@ let leading_space_count str =
  starting from the first erroring character?) *)
 (* Range coordinates all 1-indexed, like for editors. Otherwise this code
  would have way too many off-by-one errors *)
-let print_file ~range:((start_line, start_char), (end_line, end_char)) ~lines ppf () =
+let print_file ~is_warning ~range:((start_line, start_char), (end_line, end_char)) ~lines ppf () =
  (* show 2 lines before & after the erroring lines *)
  let first_shown_line = max 1 (start_line - 2) in
  let last_shown_line = min (Array.length lines) (end_line + 2) in
@@ -62,6 +62,11 @@ let print_file ~range:((start_line, start_char), (end_line, end_char)) ~lines pp
  (* btw, these are unicode chars. They're not of length 1. Careful; we need to
  explicitly tell Format to treat them as length 1 below *)
  let separator = if columns_to_cut = 0 then "│" else "┆" in
+ (* coloring *)
+ let (highlighted_line_number, highlighted_content): (string -> string -> unit, Format.formatter, unit) format * (unit, Format.formatter, unit) format = 
+ if is_warning then ("@{<info>%s@}@{<dim> @<1>%s @}", "@{<info>")
+ else ("@{<error>%s@}@{<dim> @<1>%s @}", "@{<error>")
+ in
 
  fprintf ppf "@[<v 0>";
  (* inclusive *)
@@ -77,10 +82,10 @@ let print_file ~range:((start_line, start_char), (end_line, end_char)) ~lines pp
  (* this is where you insrt the vertical separator. Mark them as legnth 1 as explained above *)
  if i < start_line || i > end_line then begin
  (* normal, non-highlighted line *)
- fprintf ppf "%s@{<separator> @<1>%s @}" padded_line_number separator
+ fprintf ppf "%s@{<dim> @<1>%s @}" padded_line_number separator
  end else begin
- (* highlighted row *)
- fprintf ppf "@{<affected_line_number>%s@}@{<separator> @<1>%s @}" padded_line_number separator
+ (* highlighted *)
+ fprintf ppf highlighted_line_number padded_line_number separator
  end;
 
  fprintf ppf "@]"; (* h *)
@@ -89,7 +94,7 @@ let print_file ~range:((start_line, start_char), (end_line, end_char)) ~lines pp
 
  let current_line_strictly_between_start_and_end_line = i > start_line && i < end_line in
 
- if current_line_strictly_between_start_and_end_line then fprintf ppf "@{<affected_line_content>";
+ if current_line_strictly_between_start_and_end_line then fprintf ppf highlighted_content;
 
  let current_line_cut_length = String.length current_line_cut in
  (* inclusive. To be consistent with using 1-indexed indices and count and i, j will be 1-indexed too *)
@@ -98,11 +103,11 @@ let print_file ~range:((start_line, start_char), (end_line, end_char)) ~lines pp
  if current_line_strictly_between_start_and_end_line then
  fprintf ppf "%c@," current_char
  else if i = start_line then begin
- if j == (start_char - columns_to_cut) then fprintf ppf "@{<affected_line_content>";
+ if j == (start_char - columns_to_cut) then fprintf ppf highlighted_content;
  fprintf ppf "%c@," current_char;
  if j == (end_char - columns_to_cut) then fprintf ppf "@}"
  end else if i = end_line then begin
- if j == 1 then fprintf ppf "@{<affected_line_content>";
+ if j == 1 then fprintf ppf highlighted_content;
  fprintf ppf "%c@," current_char;
  if j == (end_char - columns_to_cut) then fprintf ppf "@}"
  end else
@@ -120,11 +125,9 @@ let print_file ~range:((start_line, start_char), (end_line, end_char)) ~lines pp
  done;
  fprintf ppf "@]" (* v *)
 
-(* This allows you to, just like css, define which tag gets colored in which
- way. See usage in e.g. Super_location.super_error_reporter *)
-let colorize_tagged_string ppf f =
+let setup_colors ppf =
  Format.pp_set_formatter_tag_functions ppf
  ({ (Format.pp_get_formatter_tag_functions ppf () ) with
- mark_open_tag = Ext_color.ansi_of_tag ~style_of_tag:f;
+ mark_open_tag = Ext_color.ansi_of_tag;
  mark_close_tag = (fun _ -> Ext_color.reset_lit);
  })

jscomp/super_errors/super_misc.mli

@@ -1,6 +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: range:(int * int) * (int * int) -> lines:string array -> Format.formatter -> unit -> unit
+val print_file: is_warning:bool -> range:(int * int) * (int * int) -> lines:string array -> Format.formatter -> unit -> unit
 
-(** This will be called in super_main. This is how you override the default error and warning printers *)
-val colorize_tagged_string: Format.formatter -> (string -> Ext_color.style list) -> unit
+val setup_colors: Format.formatter -> unit

jscomp/super_errors/super_typecore.ml

@@ -48,9 +48,9 @@ let report_error env ppf = function
  (* modified *)
  report_unification_error ppf env trace
  (function ppf ->
- fprintf ppf "@{<Expr_type_clash.this>This is:@}")
+ fprintf ppf "@{<error>This is:@}")
  (function ppf ->
- fprintf ppf "@{<Expr_type_clash.wanted>but somewhere wanted:@}")
+ fprintf ppf "@{<info>but somewhere wanted:@}")
  | Apply_non_function typ ->
  (* modified *)
  reset_and_mark_loops typ;
@@ -233,11 +233,7 @@ let report_error env ppf = function
 
 (* https://github.com/ocaml/ocaml/blob/4.02/typing/typecore.ml#L3979 *)
 let report_error env ppf err =
- Super_misc.colorize_tagged_string ppf (function
- | "Expr_type_clash.this" -> [Bold; FG Red]
- | "Expr_type_clash.wanted" -> [Bold; FG Yellow]
- | _ -> []
- );
+ Super_misc.setup_colors ppf;
  wrap_printing_env env (fun () -> report_error env ppf err)
 
 (* This will be called in super_main. This is how you'd override the default error printer from the compiler & register new error_of_exn handlers *)