hphp/hack/src/client/clientCheckStatus.ml

   1 (**
   2  * Copyright (c) 2015, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the BSD-style license found in the
   6  * LICENSE file in the "hack" directory of this source tree. An additional grant
   7  * of patent rights can be found in the PATENTS file in the same directory.
   8  *
   9  *)
  10
  11 open Core
  12 open String_utils
  13
  14 module C = Tty
  15
  16 let print_reason_color ~(first:bool) ~(code:int) ((p, s): Pos.absolute * string) =
  17   let line, start, end_ = Pos.info_pos p in
  18   let code_clr = C.Normal C.Yellow in
  19   let err_clr  = if first then C.Bold C.Red else C.Normal C.Green in
  20   let file_clr = if first then C.Bold C.Red else C.Normal C.Red in
  21   let line_clr = C.Normal C.Yellow in
  22   let col_clr  = C.Normal C.Cyan in
  23
  24   let to_print_code = if not first then [] else [
  25     (C.Normal C.Default, " (");
  26     (code_clr,       Errors.error_code_to_string code);
  27     (C.Normal C.Default, ")");
  28   ] in
  29   let to_print = [
  30     (line_clr,           string_of_int line);
  31     (C.Normal C.Default, ":");
  32     (col_clr,            string_of_int start);
  33     (C.Normal C.Default, ",");
  34     (col_clr,            string_of_int end_);
  35     (C.Normal C.Default, ": ");
  36     (err_clr,            s);
  37   ] @ to_print_code @ [(C.Normal C.Default, "\n")] in
  38
  39   if not first then Printf.printf "  " else ();
  40   if Unix.isatty Unix.stdout
  41   then
  42     let cwd = Filename.concat (Sys.getcwd ()) "" in
  43     let file_path = [
  44       (file_clr, lstrip (Pos.filename p) cwd);
  45       (C.Normal C.Default, ":");
  46     ] in
  47     C.cprint (file_path @ to_print)
  48   else
  49     let strings = List.map to_print (fun (_,x) -> x) in
  50     Printf.printf "%s:" (Pos.filename p);
  51     List.iter strings (Printf.printf "%s")
  52
  53 let print_error_color e =
  54   let code = Errors.get_code e in
  55   let msg_list = Errors.to_list e in
  56   print_reason_color ~first:true ~code (List.hd_exn msg_list);
  57   List.iter (List.tl_exn msg_list) (print_reason_color ~first:false ~code)