From 3d1e9a56bf35dc0bc3b3f2ba37150be378fa77fc Mon Sep 17 00:00:00 2001
From: Louis Gesbert <louis.gesbert@ocamlpro.com>
Date: Sat, 4 May 2024 17:45:22 +0200
Subject: [PATCH] Fix adjustment of format width to terminal

---
 compiler/catala_utils/file.ml     | 10 +++++----
 compiler/catala_utils/message.ml  | 35 ++++++++++++++++---------------
 compiler/catala_utils/message.mli |  2 +-
 3 files changed, 25 insertions(+), 22 deletions(-)

diff --git a/compiler/catala_utils/file.ml b/compiler/catala_utils/file.ml
index ff7cdcaa..02fbe6f1 100644
--- a/compiler/catala_utils/file.ml
+++ b/compiler/catala_utils/file.ml
@@ -114,7 +114,7 @@ let with_in_channel filename f =
   finally (fun () -> close_in oc) (fun () -> f oc)
 
 let with_formatter_of_out_channel oc f =
-  let fmt = Message.formatter_of_out_channel oc in
+  let fmt = Message.formatter_of_out_channel oc () in
   finally (fun () -> Format.pp_print_flush fmt ()) @@ fun () -> f fmt
 
 let with_formatter_of_file filename f =
@@ -186,15 +186,17 @@ let () =
   let default = 80 in
   let get_terminal_cols () =
     let count =
-      try (* terminfo *)
-          process_out "tput" ["cols"] |> int_of_string
+      try
+        (* terminfo *)
+        process_out "tput" ["cols"] |> String.trim |> int_of_string
       with Failure _ -> (
         try
           (* stty *)
           process_out "stty" ["size"]
+          |> String.trim
           |> fun s ->
           let i = String.rindex s ' ' + 1 in
-          String.sub s (i + 1) (String.length s - i) |> int_of_string
+          String.sub s i (String.length s - i) |> int_of_string
         with Failure _ | Not_found | Invalid_argument _ -> (
           try int_of_string (Sys.getenv "COLUMNS")
           with Not_found | Failure _ -> 0))
diff --git a/compiler/catala_utils/message.ml b/compiler/catala_utils/message.ml
index 154d1a22..1b977d3f 100644
--- a/compiler/catala_utils/message.ml
+++ b/compiler/catala_utils/message.ml
@@ -56,21 +56,22 @@ let has_color oc =
 
 let formatter_of_out_channel oc =
   let tty = lazy Unix.(isatty (descr_of_out_channel oc)) in
-  let ppf = Format.formatter_of_out_channel oc in
   let ppf =
-    if has_color_raw ~tty then color_formatter ppf else unstyle_formatter ppf
+    lazy
+      (let ppf = Format.formatter_of_out_channel oc in
+       if has_color_raw ~tty then color_formatter ppf else unstyle_formatter ppf)
   in
-  let out, flush = Format.pp_get_formatter_output_functions ppf () in
-  let flush () =
+  fun () ->
+    let ppf = Lazy.force ppf in
     if Lazy.force tty then Format.pp_set_margin ppf (terminal_columns ());
-    flush ()
-  in
-  Format.pp_set_formatter_output_functions ppf out flush;
-  ppf
+    ppf
 
-let std_ppf = lazy (formatter_of_out_channel stdout)
-let err_ppf = lazy (formatter_of_out_channel stderr)
-let ignore_ppf = lazy (Format.make_formatter (fun _ _ _ -> ()) (fun () -> ()))
+let std_ppf = formatter_of_out_channel stdout
+let err_ppf = formatter_of_out_channel stderr
+
+let ignore_ppf =
+  let ppf = lazy (Format.make_formatter (fun _ _ _ -> ()) (fun () -> ())) in
+  fun () -> Lazy.force ppf
 
 let unformat (f : Format.formatter -> unit) : string =
   let buf = Buffer.create 1024 in
@@ -94,10 +95,10 @@ let unformat (f : Format.formatter -> unit) : string =
 type level = Error | Warning | Debug | Log | Result
 
 let get_ppf = function
-  | Result -> Lazy.force std_ppf
-  | Debug when not Global.options.debug -> Lazy.force ignore_ppf
-  | Warning when Global.options.disable_warnings -> Lazy.force ignore_ppf
-  | Error | Log | Debug | Warning -> Lazy.force err_ppf
+  | Result -> std_ppf ()
+  | Debug when not Global.options.debug -> ignore_ppf ()
+  | Warning when Global.options.disable_warnings -> ignore_ppf ()
+  | Error | Log | Debug | Warning -> err_ppf ()
 
 (**{3 Markers}*)
 
@@ -354,9 +355,9 @@ let make
     ~level =
   match level with
   | Debug when not Global.options.debug ->
-    Format.ikfprintf (fun _ -> cont [] level) (Lazy.force ignore_ppf)
+    Format.ikfprintf (fun _ -> cont [] level) (ignore_ppf ())
   | Warning when Global.options.disable_warnings ->
-    Format.ikfprintf (fun _ -> cont [] level) (Lazy.force ignore_ppf)
+    Format.ikfprintf (fun _ -> cont [] level) (ignore_ppf ())
   | _ ->
     Format.kdprintf
     @@ fun message ->
diff --git a/compiler/catala_utils/message.mli b/compiler/catala_utils/message.mli
index 3e97c9a8..26bb8676 100644
--- a/compiler/catala_utils/message.mli
+++ b/compiler/catala_utils/message.mli
@@ -75,7 +75,7 @@ val set_terminal_width_function : (unit -> int) -> unit
 
 (* {1 More general color-enabled formatting helpers}*)
 
-val formatter_of_out_channel : out_channel -> Format.formatter
+val formatter_of_out_channel : out_channel -> unit -> Format.formatter
 (** Creates a new formatter from the given out channel, with correct handling of
     the ocolor tags. Actual use of escape codes in the output depends on
     [Cli.style_flag] -- and wether the channel is a tty if that is set to auto. *)