Fix underline of code errors when code contains utf8

This commit is contained in:
Louis Gesbert 2022-11-25 11:36:53 +01:00
parent af2f5dbe19
commit c92fe5e72d
6 changed files with 58 additions and 39 deletions

View File

@ -102,6 +102,27 @@ let string_repeat n s =
done;
Bytes.to_string buf
(* Note: this should do, but remains incorrect for combined unicode characters
that display as one (e.g. `e` + postfix `'`). We should switch to Uuseg at
some poing *)
let string_columns s =
let len = String.length s in
let rec aux ncols i =
if i >= len then ncols
else if s.[i] = '\t' then aux (ncols + 8) (i + 1)
else
aux (ncols + 1) (i + Uchar.utf_decode_length (String.get_utf_8_uchar s i))
in
aux 0 0
let utf8_byte_index s ui0 =
let rec aux bi ui =
if ui >= ui0 then bi
else
aux (bi + Uchar.utf_decode_length (String.get_utf_8_uchar s bi)) (ui + 1)
in
aux 0 0
let retrieve_loc_text (pos : t) : string =
try
let filename = get_file pos in
@ -132,34 +153,32 @@ let retrieve_loc_text (pos : t) : string =
let print_matched_line (line : string) (line_no : int) : string =
let line_indent = indent_number line in
let error_indicator_style = [ANSITerminal.red; ANSITerminal.Bold] in
line
^
if line_no >= sline && line_no <= eline then
"\n"
^
if line_no = sline && line_no = eline then
Cli.with_style error_indicator_style "%*s%s"
(get_start_column pos - 1)
""
(string_repeat
(max (get_end_column pos - get_start_column pos) 0)
"")
else if line_no = sline && line_no <> eline then
Cli.with_style error_indicator_style "%*s%s"
(get_start_column pos - 1)
""
(string_repeat
(max (String.length line - get_start_column pos) 0)
"")
else if line_no <> sline && line_no <> eline then
Cli.with_style error_indicator_style "%*s%s" line_indent ""
(string_repeat (max (String.length line - line_indent) 0) "")
else if line_no <> sline && line_no = eline then
Cli.with_style error_indicator_style "%*s%*s" line_indent ""
(get_end_column pos - 1 - line_indent)
(string_repeat (max (get_end_column pos - line_indent) 0) "")
else assert false (* should not happen *)
else ""
let match_start_index =
utf8_byte_index line
(if line_no = sline then get_start_column pos - 1 else line_indent)
in
let match_end_index =
if line_no = eline then utf8_byte_index line (get_end_column pos - 1)
else String.length line
in
let unmatched_prefix = String.sub line 0 match_start_index in
let matched_substring =
String.sub line match_start_index
(max 0 (match_end_index - match_start_index))
in
let match_start_col = string_columns unmatched_prefix in
let match_num_cols = string_columns matched_substring in
String.concat ""
(line
:: "\n"
::
(if line_no >= sline && line_no <= eline then
[
string_repeat match_start_col " ";
Cli.with_style error_indicator_style "%s"
(string_repeat match_num_cols "");
]
else []))
in
let include_extra_count = 0 in
let rec get_lines (n : int) : string list =

View File

@ -23,11 +23,11 @@ $ catala Interpret -s A
┌─⯈ tests/test_enum/bad/missing_case.catala_en:14.24-16.21:
└──┐
14 │ definition out equals match e with pattern
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
15 │ -- Case1 of i : i = 0
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
16 │ -- Case2 of b : b
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
└─ Article
#return code 255#
```

View File

@ -27,7 +27,7 @@ Ambiguous exception
12 │ exception
│ ‾‾‾‾‾‾‾‾‾
13 │ definition x equals 2
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
└─ Test
Candidate definition

View File

@ -26,11 +26,11 @@ Cyclic exception for definition of variable "x", declared here:
┌─⯈ tests/test_exception/bad/exceptions_cycle.catala_en:16.2-18.23:
└──┐
16 │ label exception_exception_x
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
17 │ exception exception_x
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
18 │ definition x equals 2
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
Used here in the definition of another cyclic exception for defining "x":
@ -44,11 +44,11 @@ Cyclic exception for definition of variable "x", declared here:
┌─⯈ tests/test_exception/bad/exceptions_cycle.catala_en:12.2-14.23:
└──┐
12 │ label exception_x
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
13 │ exception base_x
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
14 │ definition x equals 1
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
Used here in the definition of another cyclic exception for defining "x":
@ -62,11 +62,11 @@ Cyclic exception for definition of variable "x", declared here:
┌─⯈ tests/test_exception/bad/exceptions_cycle.catala_en:8.2-10.23:
└──┐
8 │ label base_x
│ ‾‾‾‾‾‾‾‾‾‾‾
│ ‾‾‾‾‾‾‾‾‾‾‾
9 │ exception exception_exception_x
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
10 │ definition x equals 0
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
Used here in the definition of another cyclic exception for defining "x":

View File

@ -20,7 +20,7 @@ $ catala Interpret -s A
8 │ exception
│ ‾‾‾‾‾‾‾‾‾
9 │ definition x equals 1
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
└─ Test
#return code 255#
```

View File

@ -33,7 +33,7 @@ Ambiguous exception
18 │ exception
│ ‾‾‾‾‾‾‾‾‾
19 │ definition y equals 3
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
│ ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾
└─ Test
Candidate definition