From 38a93424a81360b593386ba114d34cf1aec29ba6 Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Fri, 21 Jun 2024 15:41:44 +0200 Subject: [PATCH] Clerk reports: postprocess diff output This relies less on specific color flags of GNU diff, and reformats and colorises the output. (it may still depend on the specific layout of GNU diff with the `-y` flag though) --- build_system/clerk_report.ml | 116 +++++++++++++++++++++++-------- compiler/catala_utils/string.ml | 12 ++++ compiler/catala_utils/string.mli | 3 + 3 files changed, 101 insertions(+), 30 deletions(-) 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