diff --git a/build_system/clerk_report.ml b/build_system/clerk_report.ml index f5c1885d..f2753d95 100644 --- a/build_system/clerk_report.ml +++ b/build_system/clerk_report.ml @@ -69,31 +69,87 @@ let has_command cmd = let check_cmd = Printf.sprintf "type %s >/dev/null 2>&1" cmd in Sys.command check_cmd = 0 +let longuest_common_prefix_length s1 s2 = + let len = min (String.length s1) (String.length s2) in + let rec aux i = + if i >= len then i + else + let c1 = String.get_utf_8_uchar s1 i in + let c2 = String.get_utf_8_uchar s2 i in + if c1 = c2 then aux (i + Uchar.utf_decode_length c1) else i + in + aux 0 + let diff_command = lazy - (if - disp_flags.use_patdiff - && has_command "patdiff" - && Message.has_color stdout - then ["patdiff"; "-alt-old"; "expected"; "-alt-new"; "result"] - else - [ - "diff"; - "-y"; - "-t"; - (* "--suppress-common-lines"; "--horizon-lines=3"; *) - "-W"; - string_of_int (Message.terminal_columns () - 5); - (* "-b"; *) - ("--color=" ^ if Message.has_color stdout then "always" else "never"); - "--palette=ad=31:de=32"; - "--label"; - "expected"; - "--label"; - "result"; - ]) + begin + if + disp_flags.use_patdiff + && has_command "patdiff" + && Message.has_color stdout + then + ( ["patdiff"; "-alt-old"; "expected"; "-alt-new"; "result"], + fun ppf s -> + s + |> String.split_on_char '\n' + |> List.filter (( <> ) "") + |> Format.pp_print_list Format.pp_print_string ppf ) + else + let width = Message.terminal_columns () - 5 in + ( [ + "diff"; + "-y"; + "-t"; + "-W"; + string_of_int (Message.terminal_columns () - 5); + ], + fun ppf s -> + let mid = (width - 1) / 2 in + Format.fprintf ppf "@{%*sReference%*s│%*sResult%*s@}@," + ((mid - 9) / 2) + "" + (mid - 9 - ((mid - 9) / 2)) + "" + ((width - mid - 7) / 2) + "" + (width - mid - 7 - ((width - mid - 7) / 2)) + ""; + s + |> String.trim_end + |> String.split_on_char '\n' + |> Format.pp_print_list + (fun ppf li -> + let rec find_cut col index = + if index >= String.length li then None + else if col = mid then Some index + else + let c = String.get_utf_8_uchar li index in + find_cut (col + 1) (index + Uchar.utf_decode_length c) + in + match find_cut 0 0 with + | None -> + if li = "" then Format.fprintf ppf "%*s@{│@}" mid "" + else Format.pp_print_string ppf li + | Some i -> ( + let l, c, r = + ( String.sub li 0 i, + li.[i], + String.sub li (i + 1) (String.length li - i - 1) ) + in + match c with + | ' ' -> Format.fprintf ppf "%s@{│@}%s" l r + | '>' -> Format.fprintf ppf "%s@{│@}@{%s@}" l r + | '<' -> Format.fprintf ppf "%s@{│@}@{-@}" l + | '|' -> + let w = longuest_common_prefix_length (" " ^ l) r in + Format.fprintf ppf "%s@{│@}%s@{%s@}" l + (String.sub r 0 w) + (String.sub r w (String.length r - w)) + | _ -> Format.pp_print_string ppf li)) + ppf ) + end -let get_diff p1 p2 = +let print_diff ppf p1 p2 = let get_str (pstart, pend) = assert (pstart.Lexing.pos_fname = pend.Lexing.pos_fname); File.with_in_channel pstart.Lexing.pos_fname @@ -106,9 +162,10 @@ let get_diff p1 p2 = File.with_temp_file "clerk_diff" "b" ~contents:(get_str p2) @@ fun f2 -> match Lazy.force diff_command with - | [] -> assert false - | cmd :: args -> + | [], _ -> assert false + | cmd :: args, printer -> File.process_out ~check_exit:(fun _ -> ()) cmd (args @ [f1; f2]) + |> printer ppf let catala_commands_with_output_flag = ["makefile"; "html"; "latex"; "ocaml"; "python"; "r"; "c"] @@ -155,10 +212,7 @@ let display ~build_dir file ppf t = print_command (); if disp_flags.diffs then ( Format.pp_print_cut ppf (); - get_diff t.expected t.result - |> String.split_on_char '\n' - |> List.filter (( <> ) "") - |> Format.pp_print_list Format.pp_print_string ppf)); + print_diff ppf t.expected t.result)); Format.pp_close_box ppf () let display_file ~build_dir ppf t = @@ -255,7 +309,8 @@ let summary ~build_dir tests = result_box (fun box -> box.print_line "@{
    %-5s %10s %10s %10s@}" "" "FAILED" "PASSED" "TOTAL"; if files > 1 then - box.print_line "%-5s @{%a@} @{%a@} %10d@}" "files" + box.print_line "%-5s @{%a@} @{%a@} @{%10d@}" + "files" (fun ppf -> function | 0 -> Format.fprintf ppf "@{%10d@}" 0 | n -> Format.fprintf ppf "%10d" n) @@ -264,7 +319,8 @@ let summary ~build_dir tests = | 0 -> Format.fprintf ppf "@{%10d@}" 0 | n -> Format.fprintf ppf "%10d" n) success_files files; - box.print_line "%-5s @{%a@} @{%a@} %10d" "tests" + box.print_line "%-5s @{%a@} @{%a@} @{%10d@}" + "tests" (fun ppf -> function | 0 -> Format.fprintf ppf "@{%10d@}" 0 | n -> Format.fprintf ppf "%10d" n) diff --git a/compiler/catala_utils/string.ml b/compiler/catala_utils/string.ml index 0af8ec76..16c7ff6a 100644 --- a/compiler/catala_utils/string.ml +++ b/compiler/catala_utils/string.ml @@ -50,6 +50,18 @@ let remove_prefix ~prefix s = sub s plen (length s - plen) else s +let trim_end s = + let rec stop n = + if n < 0 then n + else + match get s n with + | ' ' | '\x0c' | '\n' | '\r' | '\t' -> stop (n - 1) + | _ -> n + in + let last = length s - 1 in + let i = stop last in + if i = last then s else sub s 0 (i + 1) + (* 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 *) diff --git a/compiler/catala_utils/string.mli b/compiler/catala_utils/string.mli index b16b6723..338cf2d6 100644 --- a/compiler/catala_utils/string.mli +++ b/compiler/catala_utils/string.mli @@ -50,6 +50,9 @@ val remove_prefix : prefix:string -> string -> string - if [str] starts with [prefix], a string [s] such that [prefix ^ s = str] - otherwise, [str] unchanged *) +val trim_end : string -> string +(** Like [Stdlib.String.trim], but only trims at the end of the string *) + val format : Format.formatter -> string -> unit val width : string -> int