From 80400d838a06a0d630eac9ae96b0ad1c312d7a49 Mon Sep 17 00:00:00 2001 From: Louis Gesbert Date: Tue, 18 Jun 2024 15:10:29 +0200 Subject: [PATCH] Messages: improve string padding processing --- build_system/clerk_report.ml | 8 ++++---- compiler/catala_utils/message.ml | 2 ++ compiler/catala_utils/message.mli | 4 ++++ compiler/catala_utils/pos.ml | 15 +++++++++------ compiler/catala_utils/pos.mli | 5 +++++ compiler/catala_utils/string.ml | 8 -------- compiler/catala_utils/string.mli | 3 --- 7 files changed, 24 insertions(+), 21 deletions(-) diff --git a/build_system/clerk_report.ml b/build_system/clerk_report.ml index 2303296e..ef83c31c 100644 --- a/build_system/clerk_report.ml +++ b/build_system/clerk_report.ml @@ -198,10 +198,10 @@ type box = { print_line : 'a. ('a, Format.formatter, unit) format -> 'a } let print_box tcolor ppf title (pcontents : box -> unit) = let columns = Message.terminal_columns () in let tpad = columns - String.width title - 6 in - Format.fprintf ppf "@,%t┏%s @{ %s @} %s┓@}@," tcolor - (String.repeat (tpad / 2) "━") + Format.fprintf ppf "@,%t┏%t @{ %s @} %t┓@}@," tcolor + (Message.pad (tpad / 2) "━") title - (String.repeat (tpad - (tpad / 2)) "━"); + (Message.pad (tpad - (tpad / 2)) "━"); Format.pp_open_tbox ppf (); Format.fprintf ppf "%t@<1>%s@}%*s" tcolor "┃" (columns - 2) ""; Format.pp_set_tab ppf (); @@ -220,7 +220,7 @@ let print_box tcolor ppf title (pcontents : box -> unit) = pcontents box; box.print_line ""; Format.pp_close_tbox ppf (); - Format.fprintf ppf "%t┗%s┛@}@," tcolor (String.repeat (columns - 2) "━") + Format.fprintf ppf "%t┗%t┛@}@," tcolor (Message.pad (columns - 2) "━") let summary ~build_dir tests = let ppf = Message.formatter_of_out_channel stdout () in diff --git a/compiler/catala_utils/message.ml b/compiler/catala_utils/message.ml index f14579cc..055ba412 100644 --- a/compiler/catala_utils/message.ml +++ b/compiler/catala_utils/message.ml @@ -90,6 +90,8 @@ let unformat (f : Format.formatter -> unit) : string = Format.pp_print_flush ppf (); Buffer.contents buf +let pad n s ppf = Pos.pad_fmt n s ppf + (**{2 Message types and output helpers *) type level = Error | Warning | Debug | Log | Result diff --git a/compiler/catala_utils/message.mli b/compiler/catala_utils/message.mli index f094ab8a..d8effcc2 100644 --- a/compiler/catala_utils/message.mli +++ b/compiler/catala_utils/message.mli @@ -75,6 +75,10 @@ val has_color : out_channel -> bool val set_terminal_width_function : (unit -> int) -> unit val terminal_columns : unit -> int +val pad : int -> string -> Format.formatter -> unit +(** Prints the given character the given number of times (assuming it is of + width 1) *) + (* {1 More general color-enabled formatting helpers}*) val formatter_of_out_channel : out_channel -> unit -> Format.formatter diff --git a/compiler/catala_utils/pos.ml b/compiler/catala_utils/pos.ml index 1b14e6b0..552ee2f5 100644 --- a/compiler/catala_utils/pos.ml +++ b/compiler/catala_utils/pos.ml @@ -113,6 +113,11 @@ let utf8_byte_index s ui0 = in aux 0 0 +let rec pad_fmt n s ppf = + if n > 0 then ( + Format.pp_print_as ppf 1 s; + pad_fmt (n - 1) s ppf) + let format_loc_text_parts (pos : t) = let filename = get_file pos in if filename = "" then @@ -191,14 +196,12 @@ let format_loc_text_parts (pos : t) = line; Format.pp_print_cut ppf (); if line_no >= sline && line_no <= eline then - Format.fprintf ppf "@{%s │@} %s@{%a@}" - (String.repeat nspaces " ") - (String.repeat match_start_col " ") - (fun ppf -> Format.pp_print_as ppf match_num_cols) - (String.repeat match_num_cols "‾") + Format.fprintf ppf "@{%*s │@} %*s@{%t@}" nspaces "" + match_start_col "" + (pad_fmt match_num_cols "‾") in let pr_context ppf = - Format.fprintf ppf "@{ %s│@}@," (String.repeat nspaces " "); + Format.fprintf ppf "@{ %*s│@}@," nspaces ""; Format.pp_print_list print_matched_line ppf pos_lines in let legal_pos_lines = diff --git a/compiler/catala_utils/pos.mli b/compiler/catala_utils/pos.mli index a6019e7b..f019bad7 100644 --- a/compiler/catala_utils/pos.mli +++ b/compiler/catala_utils/pos.mli @@ -69,3 +69,8 @@ val format_loc_text_parts : val no_pos : t (** Placeholder position *) + +(**/**) + +val pad_fmt : int -> string -> Format.formatter -> unit +(** Exported as [Message.pad] *) diff --git a/compiler/catala_utils/string.ml b/compiler/catala_utils/string.ml index a488242a..0af8ec76 100644 --- a/compiler/catala_utils/string.ml +++ b/compiler/catala_utils/string.ml @@ -50,14 +50,6 @@ let remove_prefix ~prefix s = sub s plen (length s - plen) else s -let repeat n s = - let slen = length s in - let buf = Bytes.create (n * slen) in - for i = 0 to n - 1 do - Bytes.blit_string s 0 buf (i * slen) slen - 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 *) diff --git a/compiler/catala_utils/string.mli b/compiler/catala_utils/string.mli index 0dce624a..b16b6723 100644 --- a/compiler/catala_utils/string.mli +++ b/compiler/catala_utils/string.mli @@ -56,6 +56,3 @@ val width : string -> int (** Returns the width of a given string in screen columns (assuming a monospace font). Useful for alignment. This takes unicode (except composite chars) and tabs into account, but not escape sequences. *) - -val repeat : int -> string -> string -(** Repeats the given string the given number of times *)