colorize output filenames

src/ansi_color.ml

@@ -3,17 +3,44 @@ open Import
 include struct
   [@@@warning "-37"]
   type color =
-    | Black | Red | Green | Yellow | Blue | Magenta | Cyan | White | Default
+    | Black
-    | Bright_black | Bright_red | Bright_green | Bright_yellow | Bright_blue
+    | Red
-    | Bright_magenta | Bright_cyan | Bright_white
+    | Green
+    | Yellow
+    | Blue
+    | Magenta
+    | Cyan
+    | White
+    | Default
+    | Bright_black
+    | Bright_red
+    | Bright_green
+    | Bright_yellow
+    | Bright_blue
+    | Bright_magenta
+    | Bright_cyan
+    | Bright_white
 
   type style =
-    | Reset | Bold | Underlined | Dim | Blink | Inverse | Hidden
+    | Reset
-    | Bold_off | Underlined_off | Dim_off | Blink_off | Inverse_off | Hidden_off
+    | Bold
+    | Underlined
+    | Dim
+    | Blink
+    | Inverse
+    | Hidden
+    | Bold_off
+    | Underlined_off
+    | Dim_off
+    | Blink_off
+    | Inverse_off
+    | Hidden_off
     | Foreground of color
     | Background of color
 end
 
+type styles = style list
+
 let ansi_code_of_style = function
   | Reset                     -> "0"
   | Bold                      -> "1"
@@ -137,6 +164,15 @@ let setup_env_for_ocaml_colors = lazy(
   end
 )
 
+let styles_of_tag = function
+  | "loc" -> [Bold]
+  | "error" -> [Bold; Foreground Red]
+  | "warning" -> [Bold; Foreground Magenta]
+  | "kwd" -> [Bold; Foreground Blue]
+  | "id" -> [Bold; Foreground Yellow]
+  | "prompt" -> [Bold; Foreground Green]
+  | _ -> []
+
 let setup_err_formatter_colors () =
   let open Format in
   if Lazy.force stderr_supports_colors then begin
@@ -146,15 +182,8 @@ let setup_err_formatter_colors () =
     pp_set_formatter_tag_functions ppf
       { funcs with
         mark_close_tag = (fun _ -> ansi_escape_of_styles [Reset])
-      ; mark_open_tag = (fun tag ->
+      ; mark_open_tag = (fun tag -> ansi_escape_of_styles (styles_of_tag tag))
-        ansi_escape_of_styles
-          (match tag with
-           | "loc" -> [Bold]
-           | "error" -> [Bold; Foreground Red]
-           | "warning" -> [Bold; Foreground Magenta]
-           | "kwd" -> [Bold; Foreground Blue]
-           | "id" -> [Bold; Foreground Yellow]
-           | "prompt" -> [Bold; Foreground Green]
-           | _ -> []))
       }
   end
+
+let output_filename = [Bold; Foreground Green]

src/ansi_color.mli

@@ -1,4 +1,5 @@
 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
@@ -8,3 +9,9 @@ val strip_colors_for_stderr : string -> string
 
 (** Enable the interpretation of color tags for [Format.err_formatter] *)
 val setup_err_formatter_colors : unit -> unit
+
+type styles
+
+val output_filename : styles
+
+val apply_string : styles -> string -> string

src/future.ml

@@ -228,10 +228,16 @@ module Scheduler = struct
       before ^ Ansi_color.colorize ~key key ^ after
     end
 
+  let rec colorize_args = function
+    | [] -> []
+    | "-o" :: fn :: rest ->
+      "-o" :: Ansi_color.(apply_string output_filename) fn :: colorize_args rest
+    | x :: rest -> x :: colorize_args rest
+
   let command_line { prog; args; dir; stdout_to; _ } =
     let quote = quote_for_shell in
     let prog = colorize_prog (quote prog) in
-    let s = String.concat (prog :: List.map args ~f:quote) ~sep:" " in
+    let s = String.concat (prog :: colorize_args (List.map args ~f:quote)) ~sep:" " in
     let s =
       match stdout_to with
       | None -> s