diff --git a/build_release.sh b/build_release.sh index 9bc21ced..2f249054 100755 --- a/build_release.sh +++ b/build_release.sh @@ -18,7 +18,6 @@ CUSTOM_LINKING_CATALA_Z3="\ -cclib -lzarith -cclib -lgmp -cclib -lcamlstr - -cclib -lANSITerminal_stubs -cclib -lalcotest_stubs -cclib -lunix)" diff --git a/build_system/dune b/build_system/dune index 50c30752..acd36da3 100644 --- a/build_system/dune +++ b/build_system/dune @@ -13,7 +13,7 @@ ninja_utils cmdliner re - ANSITerminal) + ocolor) (modules clerk_driver)) (rule diff --git a/catala.opam b/catala.opam index 3d68ef5d..a98e0124 100644 --- a/catala.opam +++ b/catala.opam @@ -18,7 +18,7 @@ license: "Apache-2.0" homepage: "https://github.com/CatalaLang/catala" bug-reports: "https://github.com/CatalaLang/catala/issues" depends: [ - "ANSITerminal" {>= "0.8.2"} + "ocolor" {>= "1.3.0"} "benchmark" {>= "1.6"} "bindlib" {>= "5.0.1"} "cmdliner" {>= "1.1.0"} diff --git a/clerk.opam b/clerk.opam index 05ee3727..b70e2497 100644 --- a/clerk.opam +++ b/clerk.opam @@ -14,7 +14,7 @@ depends: [ "ocaml" {>= "4.11.0"} "cmdliner" {>= "1.1.0"} "re" {>= "1.9.0"} - "ANSITerminal" {>= "0.8.2"} + "ocolor" {>= "1.3.0"} "alcotest" {with-test & >= "1.5.0"} "catala" {= version} "ninja_utils" {= version} diff --git a/compiler/catala_utils/cli.ml b/compiler/catala_utils/cli.ml index bac4b685..88c28fb0 100644 --- a/compiler/catala_utils/cli.ml +++ b/compiler/catala_utils/cli.ml @@ -474,43 +474,3 @@ let info = in let exits = Cmd.Exit.defaults @ [Cmd.Exit.info ~doc:"on error." 1] in Cmd.info "catala" ~version ~doc ~exits ~man - -(* let with_style - * (styles : ANSITerminal.style list) - * (str : ('a, unit, string) format) = - * if !style_flag then ANSITerminal.sprintf styles str else Printf.sprintf str - * - * let format_with_style (styles : ANSITerminal.style list) fmt (str : string) = - * if !style_flag then - * Format.pp_print_as fmt (String.length str) - * (ANSITerminal.sprintf styles "%s" str) - * else Format.pp_print_string fmt str - * - * let call_unstyled f = - * let prev = !style_flag in - * style_flag := false; - * let res = f () in - * style_flag := prev; - * res - * - * let concat_with_line_depending_prefix_and_suffix - * (prefix : int -> string) - * (suffix : int -> string) - * (ss : string list) = - * match ss with - * | [] -> prefix 0 - * | _ :: _ -> - * let len = List.length ss in - * let suffix i = if i < len - 1 then suffix i else "" in - * String.concat "" - * @@ List.concat - * @@ List.mapi - * (fun i s -> [prefix i; (if s = "" then "" else " "); s; suffix i]) - * ss - * - * (\** The int argument of the prefix corresponds to the line number, starting at 0 *\) - * let add_prefix_to_each_line (s : string) (prefix : int -> string) = - * concat_with_line_depending_prefix_and_suffix - * (fun i -> prefix i) - * (fun _ -> "\n") - * (String.split_on_char '\n' s) *) diff --git a/compiler/catala_utils/file.ml b/compiler/catala_utils/file.ml index ce6bd57a..ee31a3ab 100644 --- a/compiler/catala_utils/file.ml +++ b/compiler/catala_utils/file.ml @@ -41,7 +41,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 = Format.formatter_of_out_channel oc in + let fmt = Messages.formatter_of_out_channel oc in finally (fun () -> Format.pp_print_flush fmt ()) @@ fun () -> f fmt let with_formatter_of_file filename f = diff --git a/compiler/catala_utils/messages.ml b/compiler/catala_utils/messages.ml index 3a9ce620..c12a2e84 100644 --- a/compiler/catala_utils/messages.ml +++ b/compiler/catala_utils/messages.ml @@ -3,7 +3,7 @@ (**{1 Terminal formatting}*) (* Adds handling of color tags in the formatter *) -let[@ocaml.warning "-32"] color_formatter ppf = +let color_formatter ppf = Ocolor_format.prettify_formatter ppf; ppf @@ -23,30 +23,26 @@ let unstyle_formatter ppf = (* SIDE EFFECT AT MODULE LOAD: this turns on handling of tags in [Format.sprintf] etc. functions (ignoring them) *) let () = ignore (unstyle_formatter Format.str_formatter) + (* Note: we could do the same for std_formatter, err_formatter... but we'd rather promote the use of the formatting functions of this module and the below std_ppf / err_ppf *) -let has_color unix_fd = +let has_color oc = match !Cli.style_flag with | Cli.Never -> false | Always -> true - | Auto -> Unix.isatty unix_fd + | Auto -> Unix.(isatty (descr_of_out_channel oc)) -(* Here we affect the Ocolor printers to stderr/stdout, which remain separate - from the ones used by [Format.printf] / [Format.eprintf] (which remain - unchanged) *) +(* Here we create new formatters to stderr/stdout that remain separate from the + ones used by [Format.printf] / [Format.eprintf] (which remain unchanged) *) -let std_ppf = - lazy - (if has_color Unix.stdout then Ocolor_format.raw_std_formatter - else unstyle_formatter Ocolor_format.raw_std_formatter) - -let err_ppf = - lazy - (if has_color Unix.stderr then Ocolor_format.raw_err_formatter - else unstyle_formatter Ocolor_format.raw_err_formatter) +let formatter_of_out_channel oc = + let ppf = Format.formatter_of_out_channel oc in + if has_color oc then color_formatter ppf else unstyle_formatter 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 unformat (f : Format.formatter -> unit) : string = diff --git a/compiler/catala_utils/messages.mli b/compiler/catala_utils/messages.mli index c638323f..2b533fcf 100644 --- a/compiler/catala_utils/messages.mli +++ b/compiler/catala_utils/messages.mli @@ -92,22 +92,19 @@ val emit_log : ('a, Format.formatter, unit) format -> 'a val emit_debug : ('a, Format.formatter, unit) format -> 'a -(* {1 Common result emission}*) +(** {1 Common result emission}*) val emit_result : ('a, Format.formatter, unit) format -> 'a -(* {1 Some formatting helpers}*) +(** {1 Some formatting helpers}*) val unformat : (Format.formatter -> unit) -> string -(* Converts [f] to a string, discarding formatting and skipping newlines and - indents *) +(** Converts [f] to a string, discarding formatting and skipping newlines and + indents *) -(* (**{2 Markers}*) +(* {1 More general color-enabled formatting helpers}*) - val with_style : ANSITerminal.style list -> ('a, unit, string) format -> 'a - - val format_with_style : ANSITerminal.style list -> Format.formatter -> string - -> unit - - val call_unstyled : (unit -> 'a) -> 'a (** [call_unstyled f] calls the - function [f] with the [style_flag] set to false during the execution. *) *) +val formatter_of_out_channel : out_channel -> 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. *) diff --git a/french_law/catala_legifrance/catala_legifrance.ml b/french_law/catala_legifrance/catala_legifrance.ml index 92eda991..a0070fe0 100644 --- a/french_law/catala_legifrance/catala_legifrance.ml +++ b/french_law/catala_legifrance/catala_legifrance.ml @@ -113,20 +113,16 @@ let compare_to_versions (law_article_text : law_article_text) (access_token : Api.access_token) : unit Lwt.t = let print_diff msg diff = - Messages.emit_warning "%s\n%s" msg - (String.concat "\n" - (List.map - (fun chunk -> - match chunk with - | Diff.Equal words -> - ANSITerminal.sprintf [] " %s" (String.concat " " words) - | Diff.Added words -> - ANSITerminal.sprintf [ANSITerminal.green] "(+) %s" - (String.concat " " words) - | Diff.Deleted words -> - ANSITerminal.sprintf [ANSITerminal.red] "(-) %s" - (String.concat " " words)) - diff)) + Messages.emit_warning "@[%s@,%a@]" msg + (Format.pp_print_list (fun ppf chunk -> + match chunk with + | Diff.Equal words -> + Format.fprintf ppf " %s" (String.concat " " words) + | Diff.Added words -> + Format.fprintf ppf "@{(+) %s@}" (String.concat " " words) + | Diff.Deleted words -> + Format.fprintf ppf "@{(-) %s@}" (String.concat " " words))) + diff in let* _checl = match law_article_text.current_version with diff --git a/french_law/catala_legifrance/dune b/french_law/catala_legifrance/dune index 61bff043..a63a7a45 100644 --- a/french_law/catala_legifrance/dune +++ b/french_law/catala_legifrance/dune @@ -10,7 +10,7 @@ cohttp-lwt-unix yojson re - ANSITerminal)) + ocolor)) (documentation (package catala_legifrance)) diff --git a/french_law/ocaml/law_source/unit_tests/dune b/french_law/ocaml/law_source/unit_tests/dune index cb7cc2a4..a3b5a5c3 100644 --- a/french_law/ocaml/law_source/unit_tests/dune +++ b/french_law/ocaml/law_source/unit_tests/dune @@ -1,7 +1,7 @@ (executable (name run_tests) (modes native) - (libraries catala.runtime_ocaml ANSITerminal)) + (libraries catala.runtime_ocaml ocolor)) (copy_files# ../../../../examples/allocations_familiales/tests/tests_allocations_familiales.ml) diff --git a/french_law/ocaml/law_source/unit_tests/run_tests.ml b/french_law/ocaml/law_source/unit_tests/run_tests.ml index 95476666..556a30a8 100644 --- a/french_law/ocaml/law_source/unit_tests/run_tests.ml +++ b/french_law/ocaml/law_source/unit_tests/run_tests.ml @@ -3,14 +3,10 @@ let failure = ref false let try_test msg test = try test (); - Format.printf "%s %s\n" - (ANSITerminal.sprintf [ANSITerminal.green] "PASS") - (ANSITerminal.sprintf [ANSITerminal.magenta] msg) + Format.printf "@{PASS@} @{%s@}\n" msg with Runtime_ocaml.Runtime.AssertionFailed _ -> failure := true; - Format.printf "%s %s\n" - (ANSITerminal.sprintf [ANSITerminal.red] "FAIL") - (ANSITerminal.sprintf [ANSITerminal.magenta] msg) + Format.printf "@{FAIL@} @{%s@}\n" msg let _ = try_test "Allocations familiales #1" Tests_allocations_familiales.test1;