a bit more colors

bin/main.ml

@@ -200,5 +200,6 @@ let () =
     | `Error _ -> exit 1
     | _ -> exit 0
   with exn ->
+    Ansi_color.setup_err_formatter_colors ();
     Format.eprintf "%a@?" (Main.report_error ?map_fname:None) exn;
     exit 1

src/ansi_color.ml

@@ -117,6 +117,12 @@ let stderr_supports_colors = lazy(
   | _ -> true
 )
 
+let strip_colors_for_stderr s =
+  if Lazy.force stderr_supports_colors then
+    s
+  else
+    strip s
+
 (* We redirect the output of all commands, so by default the compiler will disable
    colors. Since we support colors in the output of commands, we force it via OCAMLPARAM
    if stderr supports colors. *)
@@ -131,3 +137,21 @@ let setup_env_for_ocaml_colors = lazy(
   end
 )
 
+let setup_err_formatter_colors () =
+  let open Format in
+  if Lazy.force stderr_supports_colors then begin
+    let ppf = err_formatter in
+    let funcs = pp_get_formatter_tag_functions ppf () in
+    pp_set_mark_tags ppf true;
+    pp_set_formatter_tag_functions ppf
+      { funcs with
+        mark_close_tag = (fun _ -> ansi_escape_of_styles [Reset])
+      ; mark_open_tag = (fun tag ->
+        ansi_escape_of_styles
+          (match tag with
+           | "loc" -> [Bold]
+           | "error" -> [Bold; Foreground Red]
+           | "warning" -> [Bold; Foreground Magenta]
+           | _ -> []))
+      }
+  end

src/ansi_color.mli

@@ -2,3 +2,10 @@ val colorize : key:string -> string -> string
 val strip : string -> string
 val stderr_supports_colors : bool Lazy.t
 val setup_env_for_ocaml_colors : unit Lazy.t
+
+(** Strip colors in [not (Lazy.force stderr_supports_colors)] *)
+val strip_colors_for_stderr : string -> string
+
+(** Enable the interpretation of ["loc"], ["error"] and ["warning"] tags for
+    [Format.err_formatter] *)
+val setup_err_formatter_colors : unit -> unit

src/future.ml

@@ -223,12 +223,6 @@ module Scheduler = struct
     | _ -> true
   )
 
-  let strip_colors_for_stderr s =
-    if Lazy.force Ansi_color.stderr_supports_colors then
-      s
-    else
-      Ansi_color.strip s
-
   type running_job =
     { id              : int
     ; job             : job
@@ -279,14 +273,14 @@ module Scheduler = struct
       | WEXITED n ->
         Printf.eprintf "\nCommand [%d] exited with code %d:\n$ %s\n%s%!"
           job.id n
-          (strip_colors_for_stderr job.command_line)
+          (Ansi_color.strip_colors_for_stderr job.command_line)
-          (strip_colors_for_stderr output);
+          (Ansi_color.strip_colors_for_stderr output);
         die ""
       | WSIGNALED n ->
         Printf.eprintf "\nCommand [%d] got signal %d:\n$ %s\n%s%!"
           job.id n
-          (strip_colors_for_stderr job.command_line)
+          (Ansi_color.strip_colors_for_stderr job.command_line)
-          (strip_colors_for_stderr output);
+          (Ansi_color.strip_colors_for_stderr output);
         die ""
       | WSTOPPED _ -> assert false
     end
@@ -332,7 +326,7 @@ module Scheduler = struct
         let command_line = command_line job in
         if !Clflags.debug_run then
           Printf.eprintf "Running[%d]: %s\n%!" id
-            (strip_colors_for_stderr command_line);
+            (Ansi_color.strip_colors_for_stderr command_line);
         Option.iter job.dir ~f:(fun dir -> Sys.chdir dir);
         let argv = Array.of_list (job.prog :: job.args) in
         let output_filename = Filename.temp_file "jbuilder" ".output" in

src/jbuild_types.ml

@@ -813,9 +813,7 @@ module Stanza = struct
 
   let resolve_packages ts ~dir ~visible_packages =
     let error fmt =
-      die ("File \"%s\", line 1, characters 0-0:\n\
+      Loc.fail (Loc.in_file (Path.to_string (Path.relative dir "jbuild"))) fmt
-            Error: " ^^ fmt)
-        (Path.to_string (Path.relative dir "jbuild"))
     in
     let known_packages () =
       let visible_packages = String_map.bindings visible_packages in

src/main.ml

@@ -49,8 +49,8 @@ let report_error ?(map_fname=fun x->x) ppf exn ~backtrace =
     let start_c = start.pos_cnum - start.pos_bol in
     let stop_c  = stop.pos_cnum  - start.pos_bol in
     Format.fprintf ppf
-      "File \"%s\", line %d, characters %d-%d:\n\
+      "@{<loc>File \"%s\", line %d, characters %d-%d:@}\n\
-       Error: %s\n"
+       @{<error>Error@}: %s\n"
       (map_fname start.pos_fname) start.pos_lnum start_c stop_c msg
   | Fatal_error "" -> ()
   | Fatal_error msg ->