[log] add colors to console output

Summary: Make errors stand out with colours. Also improve error messages around save states.

Reviewed By: mbouaziz

Differential Revision: D7928794

fbshipit-source-id: c81cfe2

infer/src/base/CommandLineOption.ml

@@ -877,7 +877,9 @@ let parse_args ~usage initial_action ?initial_command args =
         if !anon_arg_action.on_unknown <> `Reject && is_unknown usage_msg then (
           anon_fun !args_to_parse.(!arg_being_parsed) ;
           parse_loop () )
-        else Pervasives.(prerr_string usage_msg ; exit 1)
+        else (
+          ANSITerminal.prerr_string L.(term_styles_of_style Fatal) usage_msg ;
+          Pervasives.exit 1 )
     | Arg.Help _ ->
         (* we handle --help by ourselves and error on -help, so Arg has no way to raise Help
            anymore *)

infer/src/base/Config.ml

@@ -2265,9 +2265,9 @@ let post_parsing_initialization command_opt =
     in
     let print_exception () =
       let error prefix msg =
-        ANSITerminal.(prerr_string [Bold; Foreground Red]) prefix ;
-        ANSITerminal.(prerr_string [Bold; Foreground Red]) msg ;
-        Out_channel.newline stderr
+        ANSITerminal.prerr_string L.(term_styles_of_style Fatal) prefix ;
+        ANSITerminal.prerr_string L.(term_styles_of_style Fatal) msg ;
+        ANSITerminal.prerr_string L.(term_styles_of_style Normal) "\n"
       in
       match exn with
       | Failure msg ->
@@ -2281,19 +2281,17 @@ let post_parsing_initialization command_opt =
       | L.InferExit _ ->
           ()
       | _ ->
-          error "Uncaught error: " (Exn.to_string exn)
+          error "Uncaught Internal Error: " (Exn.to_string exn)
     in
-    if not is_infer_exit_zero && (should_print_backtrace_default || !developer_mode) then (
-      Out_channel.newline stderr ;
-      ANSITerminal.(prerr_string [Foreground Red]) "Error backtrace:" ;
-      Out_channel.newline stderr ;
-      ANSITerminal.(prerr_string [Foreground Red]) backtrace ) ;
     print_exception () ;
+    if not is_infer_exit_zero && (should_print_backtrace_default || !developer_mode) then (
+      ANSITerminal.prerr_string L.(term_styles_of_style Error) "Error backtrace:\n" ;
+      ANSITerminal.prerr_string L.(term_styles_of_style Error) backtrace ) ;
     if not is_infer_exit_zero then Out_channel.newline stderr ;
-    if suggest_keep_going then (
-      ANSITerminal.(prerr_string [])
-        "Run the command again with `--keep-going` to try and ignore this error." ;
-      Out_channel.newline stderr ) ;
+    if suggest_keep_going then
+      ANSITerminal.prerr_string
+        L.(term_styles_of_style Normal)
+        "Run the command again with `--keep-going` to try and ignore this error.\n" ;
     let exitcode = L.exit_code_of_exception exn in
     L.log_uncaught_exception exn ~exitcode ;
     Epilogues.late () ;

infer/src/base/Die.ml

@@ -50,3 +50,16 @@ let exit_code_of_exception = function
       exitcode
   | _ ->
       (* exit code 2 is used by the OCaml runtime in cases of uncaught exceptions *) 2
+
+
+type style = Error | Fatal | Normal | Warning
+
+let term_styles_of_style = function
+  | Error ->
+      ANSITerminal.[Foreground Red]
+  | Fatal ->
+      ANSITerminal.[Bold; Foreground Red]
+  | Normal ->
+      [ANSITerminal.default]
+  | Warning ->
+      ANSITerminal.[Foreground Yellow]

infer/src/base/Die.mli

@@ -35,3 +35,7 @@ val die : error -> ('a, Format.formatter, unit, _) format4 -> 'a
 (** Raise the corresponding exception. *)
 
 val raise_error : error -> msg:string -> 'a
+
+type style = Error | Fatal | Normal | Warning
+
+val term_styles_of_style : style -> ANSITerminal.style list

infer/src/base/Logging.ml

@@ -87,9 +87,25 @@ let mk_file_formatter file_fmt category0 =
   f
 
 
+let color_console ?(use_stdout= false) scheme =
+  let scheme = Option.value scheme ~default:Normal in
+  let formatter = if use_stdout then F.std_formatter else F.err_formatter in
+  let can_colorize = Unix.(isatty (if use_stdout then stdout else stderr)) in
+  if can_colorize then (
+    let styles = term_styles_of_style scheme in
+    let out_string s p n =
+      let print = if use_stdout then ANSITerminal.print_string else ANSITerminal.prerr_string in
+      print styles (String.slice s p n)
+    in
+    F.pp_set_formatter_out_functions formatter
+      {(F.pp_get_formatter_out_functions formatter ()) with F.out_string} ;
+    formatter )
+  else formatter
+
+
 let register_formatter =
   let all_prefixes = ref [] in
-  fun ?(use_stdout= false) prefix ->
+  fun ?use_stdout ?color_scheme prefix ->
     all_prefixes := prefix :: !all_prefixes ;
     (* lazy so that we get a chance to register all prefixes before computing their max length for
        alignment purposes *)
@@ -101,7 +117,7 @@ let register_formatter =
        in
        let justified_prefix = fill ^ prefix in
        let mk_formatters () =
-         let console = if use_stdout then F.std_formatter else F.err_formatter in
+         let console = color_console ?use_stdout color_scheme in
          match !log_file with
          | Some (file_fmt, _) ->
              let file = mk_file_formatter file_fmt justified_prefix in
@@ -167,11 +183,11 @@ let debug_dev_file_fmts = register_formatter "local debug"
 
 let environment_info_file_fmts = register_formatter "environment"
 
-let external_warning_file_fmts = register_formatter "extern warn"
+let external_warning_file_fmts = register_formatter ~color_scheme:Warning "extern warn"
 
-let external_error_file_fmts = register_formatter "extern err"
+let external_error_file_fmts = register_formatter ~color_scheme:Error "extern err"
 
-let internal_error_file_fmts = register_formatter "intern err"
+let internal_error_file_fmts = register_formatter ~color_scheme:Error "intern err"
 
 let phase_file_fmts = register_formatter "phase"
 
@@ -179,9 +195,9 @@ let progress_file_fmts = register_formatter "progress"
 
 let result_file_fmts = register_formatter ~use_stdout:true "result"
 
-let user_warning_file_fmts = register_formatter "user warn"
+let user_warning_file_fmts = register_formatter ~color_scheme:Warning "user warn"
 
-let user_error_file_fmts = register_formatter "user err"
+let user_error_file_fmts = register_formatter ~color_scheme:Fatal "user err"
 
 let phase fmt = log ~to_console:false phase_file_fmts fmt
 

infer/src/base/ResultsDir.ml

@@ -59,10 +59,12 @@ let create_results_dir () =
     RunState.load_and_validate ()
     |> Result.iter_error ~f:(fun error ->
            if Config.force_delete_results_dir then (
-             L.user_warning
-               "%s@\nDeleting results dir because --force-delete-results-dir was passed@." error ;
+             L.user_warning "WARNING: %s@\n" error ;
+             L.progress "Deleting results dir because --force-delete-results-dir was passed@." ;
              remove_results_dir () )
-           else L.die UserError "%s@\nPlease remove '%s' and try again" error Config.results_dir ) ;
+           else
+             L.die UserError "ERROR: %s@\nPlease remove '%s' and try again" error
+               Config.results_dir ) ;
   Unix.mkdir_p Config.results_dir ;
   Unix.mkdir_p (Config.results_dir ^/ Config.events_dir_name) ;
   List.iter ~f:Unix.mkdir_p results_dir_dir_markers ;

infer/src/base/RunState.ml

@@ -45,27 +45,26 @@ let load_and_validate () =
       (fun err_msg ->
         Error
           (Printf.sprintf
-             "Incompatible results directory '%s':\n\
+             "'%s' already exists but it is not an empty directory and it does not look like an \
+              infer results directory:\n  \
               %s\n\
-              Was '%s' created using an older version of infer?"
-             Config.results_dir err_msg Config.results_dir) )
+              Was it created using an older version of infer?"
+             Config.results_dir err_msg) )
       msg
   in
-  if Sys.file_exists state_file_path <> `Yes then error "save state not found"
+  if Sys.file_exists state_file_path <> `Yes then
+    error "save state not found: '%s' does not exist" state_file_path
   else
-    try
-      let loaded_state = Ag_util.Json.from_file Runstate_j.read_t state_file_path in
-      if
-        not
-          (String.equal !state.Runstate_t.results_dir_format
-             loaded_state.Runstate_t.results_dir_format)
-      then
-        error "Incompatible formats: found\n  %s\n\nbut expected this format:\n  %s\n\n"
-          loaded_state.results_dir_format !state.Runstate_t.results_dir_format
-      else (
+    match Ag_util.Json.from_file Runstate_j.read_t state_file_path with
+    | {Runstate_t.results_dir_format} as loaded_state
+      when String.equal !state.Runstate_t.results_dir_format results_dir_format ->
         state := loaded_state ;
-        Ok () )
-    with _ -> Error "error reading the save state"
+        Ok ()
+    | {Runstate_t.results_dir_format} ->
+        error "Incompatible formats: found\n  %s\n\nbut expected this format:\n  %s\n\n"
+          results_dir_format !state.Runstate_t.results_dir_format
+    | exception e ->
+        error "could not read the save state '%s': %s" state_file_path (Exn.to_string e)
 
 
 let reset () = state := state0

infer/src/infer.ml

@@ -129,7 +129,7 @@ let () =
         | Some cluster ->
             F.fprintf fmt "of cluster %s" (Filename.basename cluster)
       in
-      L.environment_info "Starting analysis %a" pp_cluster_opt Config.cluster_cmdline ;
+      L.progress "Starting analysis %a" pp_cluster_opt Config.cluster_cmdline ;
       run Driver.Analyze
   | Capture | Compile | Run ->
       run (Lazy.force Driver.mode_from_command_line)
@@ -140,7 +140,7 @@ let () =
       ( match (Config.report_current, Config.report_previous) with
       | None, None ->
           L.(die UserError)
-            "Expected at least one argument among 'report-current' and 'report-previous'"
+            "Expected at least one argument among '--report-current' and '--report-previous'"
       | _ ->
           () ) ;
       ReportDiff.reportdiff ~current_report:Config.report_current

infer/src/integration/Driver.ml

@@ -372,7 +372,7 @@ let error_nothing_to_analyze mode =
   | None ->
       L.user_warning "%s%s Try cleaning the build first.@." nothing_to_compile_msg
         please_run_capture_msg ) ;
-  L.user_error "There was nothing to analyze.@\n@."
+  L.progress "There was nothing to analyze.@."
 
 
 let analyze_and_report ?suppress_console_report ~changed_files mode =