Messages: improve string padding processing

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 @{<bold;reverse> %s @} %s┓@}@," tcolor
+  Format.fprintf ppf "@,%t┏%t @{<bold;reverse> %s @} %t┓@}@," tcolor
-    (String.repeat (tpad / 2) "━")
+    (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

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

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

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 "@{<blue>%s │@} %s@{<bold;red>%a@}"
+            Format.fprintf ppf "@{<blue>%*s │@} %*s@{<bold;red>%t@}" nspaces ""
-              (String.repeat nspaces " ")
+              match_start_col ""
-              (String.repeat match_start_col " ")
+              (pad_fmt match_num_cols "‾")
-              (fun ppf -> Format.pp_print_as ppf match_num_cols)
-              (String.repeat match_num_cols "‾")
         in
         let pr_context ppf =
-          Format.fprintf ppf "@{<blue> %s│@}@," (String.repeat nspaces " ");
+          Format.fprintf ppf "@{<blue> %*s│@}@," nspaces "";
           Format.pp_print_list print_matched_line ppf pos_lines
         in
         let legal_pos_lines =

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] *)

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 *)

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 *)