add "no color" mode to diagnostics (fixes #34)

pinc-official · Mar 24, 2024 · 9d3e9bc · 9d3e9bc
1 parent f220e38
commit 9d3e9bc
Show file tree

Hide file tree

Showing 19 changed files with 117 additions and 106 deletions.
diff --git a/lib/pinc_diagnostics/Pinc_Diagnostics.ml b/lib/pinc_diagnostics/Pinc_Diagnostics.ml
@@ -1,14 +1,20 @@
 module Location = Pinc_Location
 
+let set_renderer ppf =
+  match Sys.getenv_opt "NO_COLOR" with
+  | None | Some "" -> Fmt.set_style_renderer ppf `Ansi_tty
+  | Some _ -> Fmt.set_style_renderer ppf `None
+;;
+
 let error location message =
   let ppf = Format.err_formatter in
-  Fmt.set_style_renderer ppf `Ansi_tty;
+  set_renderer ppf;
   Fmt.pf ppf "@[<v>@,%a@,%s@,@]" (Pinc_Printer.print ~kind:`error) location message;
   exit 1
 ;;
 
 let warn location message =
   let ppf = Format.err_formatter in
-  Fmt.set_style_renderer ppf `Ansi_tty;
+  set_renderer ppf;
   Fmt.pf ppf "@[<v>@,%a@,%s@,@]" (Pinc_Printer.print ~kind:`warning) location message
 ;;
diff --git a/lib/pinc_diagnostics/Pinc_Printer.ml b/lib/pinc_diagnostics/Pinc_Printer.ml
@@ -2,34 +2,6 @@ module Source = Pinc_Core.Source
 module Location = Pinc_Location
 module Position = Pinc_Position
 
-let _seek_lines_before ~count source_code pos =
-  let original_line = pos.Position.line in
-  source_code
-  |> String.fold_left
-       (fun (current_line, current_char) curr ->
-         if current_line + count >= original_line then
-           (current_line, current_char)
-         else (
-           match curr with
-           | '\n' -> (current_line + 1, current_char + 1)
-           | _ -> (current_line, current_char + 1)))
-       (1, 0)
-;;
-
-let _seek_lines_after ~count source_code pos =
-  let original_line = pos.Position.line in
-  source_code
-  |> String.fold_left
-       (fun (line_number, char_number) curr ->
-         if line_number - count - 1 >= original_line then
-           (line_number, char_number)
-         else (
-           match curr with
-           | '\n' -> (line_number + 1, char_number + 1)
-           | _ -> (line_number, char_number + 1)))
-       (1, 0)
-;;
-
 let print_code ~color ~loc source_code =
   let context_lines = 1 in
   let start_pos = loc.Location.loc_start in
@@ -51,52 +23,76 @@ let print_code ~color ~loc source_code =
     |> List.mapi (fun i line ->
            let line_number = i + first_shown_line in
            (line_number, line))
-    (* try
-         String.sub source_code start_char_offset (end_char_offset - start_char_offset)
-         |> String.split_on_char '\n'
-         |> List.mapi (fun i line ->
-                let line_number = i + first_shown_line in
-                (line_number, line))
-       with Invalid_argument _ -> [] *)
   in
 
   let buf = Buffer.create 400 in
   let ppf = Format.formatter_of_buffer buf in
-  Fmt.set_style_renderer ppf `Ansi_tty;
-  lines
-  |> List.iter (fun (line_number, line) ->
-         if line_number >= highlight_line_start && line_number <= highlight_line_end then
-           Fmt.pf
-             ppf
-             "%a"
-             Fmt.(styled `Bold (styled (`Fg color) (fun ppf -> Fmt.pf ppf "%4d")))
-             line_number
-         else
-           Fmt.pf ppf "%4d" line_number;
-         Fmt.pf ppf " %a " Fmt.(styled `Faint string) "│";
+  Fmt.set_style_renderer
+    ppf
+    (if color <> `None then
+       `Ansi_tty
+     else
+       `None);
+
+  let () =
+    lines
+    |> List.iter @@ fun (line_number, line) ->
+       if line_number >= highlight_line_start && line_number <= highlight_line_end then
+         Fmt.pf
+           ppf
+           "%a"
+           Fmt.(styled `Bold (styled color (fun ppf -> Fmt.pf ppf "%4d")))
+           line_number
+       else
+         Fmt.pf ppf "%4d" line_number;
+
+       Fmt.pf ppf " %a " Fmt.(styled `Faint string) "│";
+
+       let did_highlight = ref false in
+
+       let should_highlight column_number =
+         let on_line_start = Int.equal line_number highlight_line_start in
+         let after_column_start = column_number >= highlight_column_start in
+         let between_lines =
+           line_number >= highlight_line_start && line_number <= highlight_line_end
+         in
+         let between_columns =
+           column_number >= highlight_column_start
+           && column_number <= highlight_column_end
+         in
+         let on_line_end = Int.equal line_number highlight_line_end in
+         let before_column_start = column_number <= highlight_column_end in
+
+         (on_line_start && (not on_line_end) && after_column_start)
+         || (between_lines && between_columns)
+         || (on_line_end && (not on_line_start) && before_column_start)
+       in
+
+       let () =
          line
-         |> String.iteri (fun column_index ch ->
-                let column_number = column_index + 1 in
-                let on_line_start = Int.equal line_number highlight_line_start in
-                let after_column_start = column_number >= highlight_column_start in
-                let between_lines =
-                  line_number >= highlight_line_start && line_number <= highlight_line_end
-                in
-                let between_columns =
-                  column_number >= highlight_column_start
-                  && column_number <= highlight_column_end
-                in
-                let on_line_end = Int.equal line_number highlight_line_end in
-                let before_column_start = column_number <= highlight_column_end in
-                if
-                  (on_line_start && (not on_line_end) && after_column_start)
-                  || (between_lines && between_columns)
-                  || (on_line_end && (not on_line_start) && before_column_start)
-                then
-                  Fmt.pf ppf "%a" Fmt.(styled `Bold (styled (`Fg color) char)) ch
-                else
-                  Fmt.pf ppf "%a" Fmt.(styled `None char) ch);
-         Format.pp_print_newline ppf ());
+         |> String.iteri @@ fun column_index ch ->
+            let column_number = column_index + 1 in
+            if should_highlight column_number then (
+              Fmt.pf ppf "%a" Fmt.(styled `Bold (styled color char)) ch;
+              did_highlight := true)
+            else
+              Fmt.pf ppf "%a" Fmt.(styled `None char) ch
+       in
+
+       let () =
+         if !did_highlight && color = `None then (
+           Format.pp_print_newline ppf ();
+           Fmt.pf ppf "     %a " Fmt.(styled `Faint string) "│";
+           line
+           |> String.iteri @@ fun column_index _ch ->
+              if should_highlight (succ column_index) then
+                Fmt.pf ppf "^"
+              else
+                Fmt.pf ppf " ")
+       in
+
+       Format.pp_print_newline ppf ()
+  in
 
   Buffer.contents buf
 ;;
@@ -135,10 +131,17 @@ let print_header ppf ~color text =
 ;;
 
 let print ~kind ppf (loc : Location.t) =
-  let color, header =
+  let color =
+    match (Sys.getenv_opt "NO_COLOR", kind) with
+    | (None | Some ""), `warning -> `Yellow
+    | (None | Some ""), `error -> `Red
+    | _ -> `None
+  in
+
+  let header =
     match kind with
-    | `warning -> (`Yellow, "WARNING")
-    | `error -> (`Red, "ERROR")
+    | `warning -> "WARNING"
+    | `error -> "ERROR"
   in
   Fmt.pf ppf "@[%a@] " (print_header ~color) header;
   Fmt.pf ppf "@[%a@]@," print_loc loc;

diff --git a/test/array/run.t b/test/array/run.t
@@ -1,4 +1,4 @@
-  $ print . C
+  $ NO_COLOR="1" print . C
   <section>
       0
   1

diff --git a/test/char/run.t b/test/char/run.t
@@ -1,4 +1,4 @@
-  $ print . C
+  $ NO_COLOR="1" print . C
   <section>
       String.uppercase_ascii("abcàäöüß"): ABCàäöüß
       String.lowercase_ascii("ABCÁÄÖÜß"): abcÁÄÖÜß

diff --git a/test/component/run.t b/test/component/run.t
@@ -1,11 +1,11 @@
-  $ print . Component
+  $ NO_COLOR="1" print . Component
   <section class="Section">
 
       <h2 class="HeadlineSecondary ">
   Hello, Headline Secondary!</h2>
     </section>
 
-  $ print . Foo
+  $ NO_COLOR="1" print . Foo
 
   ERROR 
 

diff --git a/test/context/run.t b/test/context/run.t
@@ -1,4 +1,4 @@
-  $ print . Component
+  $ NO_COLOR="1" print . Component
   <section class="Section">
       <h3 class="HeadlineSecondary ">
   Hello, Headline Secondary!</h3>

diff --git a/test/function/run.t b/test/function/run.t
@@ -1,4 +1,4 @@
-  $ print . Component
+  $ NO_COLOR="1" print . Component
   <section>
       max(1, 5) = 5
       min(1, 5) = 1
@@ -27,4 +27,3 @@
   9
   16
     </section>
-
diff --git a/test/interpreter_error/run.t b/test/interpreter_error/run.t
@@ -1,16 +1,17 @@
-  $ print . NotExistingDefinition
+  $ NO_COLOR="1" print . NotExistingDefinition
 
   ERROR 
 
   Declaration with name `NotExistingDefinition` was not found.
   [1]
 
-  $ print . UseNonLibrary
+  $ NO_COLOR="1" print . UseNonLibrary
 
   ERROR in file ./data.pi:2:7-19
 
      1 │ component UseNonLibrary {
      2 │   use NotALibrary;
+       │       ^^^^^^^^^^^^
      3 │ }
 
   Attempted to use a non library definition. 

diff --git a/test/loop/run.t b/test/loop/run.t
@@ -1,4 +1,4 @@
-  $ print . Component
+  $ NO_COLOR="1" print . Component
   <section>
       <h1>EXCLUSIVE RANGES</h1>
 

diff --git a/test/mutation/run.t b/test/mutation/run.t
@@ -1,4 +1,4 @@
-  $ print . Component
+  $ NO_COLOR="1" print . Component
   <section>
       a: mutated
       b: mutated

diff --git a/test/operators/run.t b/test/operators/run.t
@@ -1,4 +1,4 @@
-  $ print . Component
+  $ NO_COLOR="1" print . Component
   <div>
       ![1] = false
       ![] = true

diff --git a/test/parse_error/mutation_without_expression.pi b/test/parse_error/mutation_without_expression.pi
@@ -1,8 +1,6 @@
 component Component {
   let mutable fail = "";
-  fail := 
-
-  ;
+  fail := ;
 
   <div class="Section">
     {fail}

diff --git a/test/parse_error/run.t b/test/parse_error/run.t
@@ -1,4 +1,4 @@
-  $ print ./empty_template_expression.pi Component
+  $ NO_COLOR="1" print ./empty_template_expression.pi Component
   <div class="Section">
 
     </div>
@@ -7,53 +7,56 @@
 
      3 │   <div class="Section">
      4 │     {}
+       │     ^^
      5 │   </div>
 
   Expected to see an expression between these braces. 
   This is currently not doing anything, so you can safely remove it.
   If you wanted to have an empty record here, you need to write `{{}}`
 
-  $ print ./tag_transformer_function.pi Component
+  $ NO_COLOR="1" print ./tag_transformer_function.pi Component
 
   ERROR in file ./tag_transformer_function.pi:2:22-34
 
      1 │ component Component {
      2 │   let fail = #String :: fn _ -> ;
+       │                      ^^^^^^^^^^^^
      3 │ 
 
   This tag transformer does not have a valid body.
   [1]
 
-  $ print ./let_without_expression.pi Component
+  $ NO_COLOR="1" print ./let_without_expression.pi Component
 
   ERROR in file ./let_without_expression.pi:2:3-15
 
      1 │ component Component {
      2 │   let fail = ;
+       │   ^^^^^^^^^^^^
      3 │ 
 
   Expected expression as right hand side of let declaration
   [1]
 
-  $ print ./mutation_without_expression.pi Component
+  $ NO_COLOR="1" print ./mutation_without_expression.pi Component
 
-  ERROR in file ./mutation_without_expression.pi:3:3-5:4
+  ERROR in file ./mutation_without_expression.pi:3:3-12
 
      2 │   let mutable fail = "";
-     3 │   fail := 
-     4 │    
-     5 │   ;
-     6 │ 
+     3 │   fail := ;
+       │   ^^^^^^^^^
+     4 │ 
 
   Expected expression as right hand side of mutation statement
   [1]
 
-  $ print ./string_interpolation.pi Component
+  $ NO_COLOR="1" print ./string_interpolation.pi Component
 
   ERROR in file ./string_interpolation.pi:4:25-27
 
      3 │ 
      4 │   <div class="Section $(if fail "A" else "B")">
+       │                         ^^^                    
      5 │     {fail}
 
   Only lowercase identifiers are allowed as string interpolation placeholders.

diff --git a/test/portal/run.t b/test/portal/run.t
@@ -1,4 +1,4 @@
-  $ print . Main
+  $ NO_COLOR="1" print . Main
   <html>
       <head>
       <link href="path/to/base.css" rel="stylesheet" />

diff --git a/test/record/run.t b/test/record/run.t
@@ -1,4 +1,4 @@
-  $ print . Component
+  $ NO_COLOR="1" print . Component
   <section>
 
       1

diff --git a/test/slot/run.t b/test/slot/run.t
@@ -1,4 +1,4 @@
-  $ print . Component
+  $ NO_COLOR="1" print . Component
   <div class="SlotProvider">
       <area class="slot_default"><div>Hello Default</div></area>
       <area class="slot_restricted"><div class="SubComponent" data-foo="9">
@@ -35,12 +35,13 @@
       <area class="slot_nothing"></area>
     </div>
 
-  $ print . ErrorComponent
+  $ NO_COLOR="1" print . ErrorComponent
 
   ERROR in file ./data.pi:38:5-44
 
     37 │   <SlotProvider>
     38 │     <div slot="nothing">Hello Default</div>
+       │     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
     39 │   </SlotProvider>
 
   Child with tag `div` may not be used inside this #Slot. 

diff --git a/test/store/run.t b/test/store/run.t
@@ -1,4 +1,4 @@
-  $ print . StoreValueProvider
+  $ NO_COLOR="1" print . StoreValueProvider
   <div>
       Somewhere in the World ... or am I??
   some@email.invalid