mirror of
https://github.com/CatalaLang/catala.git
synced 2024-09-19 16:28:12 +03:00
Correctly setup ocolor on all output channels
(and some cleanup of the remaining deps to ANSITerminal)
This commit is contained in:
parent
16c93fbb0c
commit
c564e70636
@ -18,7 +18,6 @@ CUSTOM_LINKING_CATALA_Z3="\
|
|||||||
-cclib -lzarith
|
-cclib -lzarith
|
||||||
-cclib -lgmp
|
-cclib -lgmp
|
||||||
-cclib -lcamlstr
|
-cclib -lcamlstr
|
||||||
-cclib -lANSITerminal_stubs
|
|
||||||
-cclib -lalcotest_stubs
|
-cclib -lalcotest_stubs
|
||||||
-cclib -lunix)"
|
-cclib -lunix)"
|
||||||
|
|
||||||
|
@ -13,7 +13,7 @@
|
|||||||
ninja_utils
|
ninja_utils
|
||||||
cmdliner
|
cmdliner
|
||||||
re
|
re
|
||||||
ANSITerminal)
|
ocolor)
|
||||||
(modules clerk_driver))
|
(modules clerk_driver))
|
||||||
|
|
||||||
(rule
|
(rule
|
||||||
|
@ -18,7 +18,7 @@ license: "Apache-2.0"
|
|||||||
homepage: "https://github.com/CatalaLang/catala"
|
homepage: "https://github.com/CatalaLang/catala"
|
||||||
bug-reports: "https://github.com/CatalaLang/catala/issues"
|
bug-reports: "https://github.com/CatalaLang/catala/issues"
|
||||||
depends: [
|
depends: [
|
||||||
"ANSITerminal" {>= "0.8.2"}
|
"ocolor" {>= "1.3.0"}
|
||||||
"benchmark" {>= "1.6"}
|
"benchmark" {>= "1.6"}
|
||||||
"bindlib" {>= "5.0.1"}
|
"bindlib" {>= "5.0.1"}
|
||||||
"cmdliner" {>= "1.1.0"}
|
"cmdliner" {>= "1.1.0"}
|
||||||
|
@ -14,7 +14,7 @@ depends: [
|
|||||||
"ocaml" {>= "4.11.0"}
|
"ocaml" {>= "4.11.0"}
|
||||||
"cmdliner" {>= "1.1.0"}
|
"cmdliner" {>= "1.1.0"}
|
||||||
"re" {>= "1.9.0"}
|
"re" {>= "1.9.0"}
|
||||||
"ANSITerminal" {>= "0.8.2"}
|
"ocolor" {>= "1.3.0"}
|
||||||
"alcotest" {with-test & >= "1.5.0"}
|
"alcotest" {with-test & >= "1.5.0"}
|
||||||
"catala" {= version}
|
"catala" {= version}
|
||||||
"ninja_utils" {= version}
|
"ninja_utils" {= version}
|
||||||
|
@ -474,43 +474,3 @@ let info =
|
|||||||
in
|
in
|
||||||
let exits = Cmd.Exit.defaults @ [Cmd.Exit.info ~doc:"on error." 1] in
|
let exits = Cmd.Exit.defaults @ [Cmd.Exit.info ~doc:"on error." 1] in
|
||||||
Cmd.info "catala" ~version ~doc ~exits ~man
|
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) *)
|
|
||||||
|
@ -41,7 +41,7 @@ let with_in_channel filename f =
|
|||||||
finally (fun () -> close_in oc) (fun () -> f oc)
|
finally (fun () -> close_in oc) (fun () -> f oc)
|
||||||
|
|
||||||
let with_formatter_of_out_channel oc f =
|
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
|
finally (fun () -> Format.pp_print_flush fmt ()) @@ fun () -> f fmt
|
||||||
|
|
||||||
let with_formatter_of_file filename f =
|
let with_formatter_of_file filename f =
|
||||||
|
@ -3,7 +3,7 @@
|
|||||||
(**{1 Terminal formatting}*)
|
(**{1 Terminal formatting}*)
|
||||||
|
|
||||||
(* Adds handling of color tags in the formatter *)
|
(* Adds handling of color tags in the formatter *)
|
||||||
let[@ocaml.warning "-32"] color_formatter ppf =
|
let color_formatter ppf =
|
||||||
Ocolor_format.prettify_formatter ppf;
|
Ocolor_format.prettify_formatter ppf;
|
||||||
ppf
|
ppf
|
||||||
|
|
||||||
@ -23,30 +23,26 @@ let unstyle_formatter ppf =
|
|||||||
(* SIDE EFFECT AT MODULE LOAD: this turns on handling of tags in
|
(* SIDE EFFECT AT MODULE LOAD: this turns on handling of tags in
|
||||||
[Format.sprintf] etc. functions (ignoring them) *)
|
[Format.sprintf] etc. functions (ignoring them) *)
|
||||||
let () = ignore (unstyle_formatter Format.str_formatter)
|
let () = ignore (unstyle_formatter Format.str_formatter)
|
||||||
|
|
||||||
(* Note: we could do the same for std_formatter, err_formatter... but we'd
|
(* 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
|
rather promote the use of the formatting functions of this module and the
|
||||||
below std_ppf / err_ppf *)
|
below std_ppf / err_ppf *)
|
||||||
|
|
||||||
let has_color unix_fd =
|
let has_color oc =
|
||||||
match !Cli.style_flag with
|
match !Cli.style_flag with
|
||||||
| Cli.Never -> false
|
| Cli.Never -> false
|
||||||
| Always -> true
|
| 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
|
(* Here we create new formatters to stderr/stdout that remain separate from the
|
||||||
from the ones used by [Format.printf] / [Format.eprintf] (which remain
|
ones used by [Format.printf] / [Format.eprintf] (which remain unchanged) *)
|
||||||
unchanged) *)
|
|
||||||
|
|
||||||
let std_ppf =
|
let formatter_of_out_channel oc =
|
||||||
lazy
|
let ppf = Format.formatter_of_out_channel oc in
|
||||||
(if has_color Unix.stdout then Ocolor_format.raw_std_formatter
|
if has_color oc then color_formatter ppf else unstyle_formatter ppf
|
||||||
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 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 ignore_ppf = lazy (Format.make_formatter (fun _ _ _ -> ()) (fun () -> ()))
|
||||||
|
|
||||||
let unformat (f : Format.formatter -> unit) : string =
|
let unformat (f : Format.formatter -> unit) : string =
|
||||||
|
@ -92,22 +92,19 @@ val emit_log : ('a, Format.formatter, unit) format -> 'a
|
|||||||
|
|
||||||
val emit_debug : ('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
|
val emit_result : ('a, Format.formatter, unit) format -> 'a
|
||||||
|
|
||||||
(* {1 Some formatting helpers}*)
|
(** {1 Some formatting helpers}*)
|
||||||
|
|
||||||
val unformat : (Format.formatter -> unit) -> string
|
val unformat : (Format.formatter -> unit) -> string
|
||||||
(* Converts [f] to a string, discarding formatting and skipping newlines and
|
(** Converts [f] to a string, discarding formatting and skipping newlines and
|
||||||
indents *)
|
indents *)
|
||||||
|
|
||||||
(* (**{2 Markers}*)
|
(* {1 More general color-enabled formatting helpers}*)
|
||||||
|
|
||||||
val with_style : ANSITerminal.style list -> ('a, unit, string) format -> 'a
|
val formatter_of_out_channel : out_channel -> Format.formatter
|
||||||
|
(** Creates a new formatter from the given out channel, with correct handling of
|
||||||
val format_with_style : ANSITerminal.style list -> Format.formatter -> string
|
the ocolor tags. Actual use of escape codes in the output depends on
|
||||||
-> unit
|
[Cli.style_flag] -- and wether the channel is a tty if that is set to auto. *)
|
||||||
|
|
||||||
val call_unstyled : (unit -> 'a) -> 'a (** [call_unstyled f] calls the
|
|
||||||
function [f] with the [style_flag] set to false during the execution. *) *)
|
|
||||||
|
@ -113,20 +113,16 @@ let compare_to_versions
|
|||||||
(law_article_text : law_article_text)
|
(law_article_text : law_article_text)
|
||||||
(access_token : Api.access_token) : unit Lwt.t =
|
(access_token : Api.access_token) : unit Lwt.t =
|
||||||
let print_diff msg diff =
|
let print_diff msg diff =
|
||||||
Messages.emit_warning "%s\n%s" msg
|
Messages.emit_warning "@[<v>%s@,%a@]" msg
|
||||||
(String.concat "\n"
|
(Format.pp_print_list (fun ppf chunk ->
|
||||||
(List.map
|
|
||||||
(fun chunk ->
|
|
||||||
match chunk with
|
match chunk with
|
||||||
| Diff.Equal words ->
|
| Diff.Equal words ->
|
||||||
ANSITerminal.sprintf [] " %s" (String.concat " " words)
|
Format.fprintf ppf " %s" (String.concat " " words)
|
||||||
| Diff.Added words ->
|
| Diff.Added words ->
|
||||||
ANSITerminal.sprintf [ANSITerminal.green] "(+) %s"
|
Format.fprintf ppf "@{<green>(+) %s@}" (String.concat " " words)
|
||||||
(String.concat " " words)
|
|
||||||
| Diff.Deleted words ->
|
| Diff.Deleted words ->
|
||||||
ANSITerminal.sprintf [ANSITerminal.red] "(-) %s"
|
Format.fprintf ppf "@{<red>(-) %s@}" (String.concat " " words)))
|
||||||
(String.concat " " words))
|
diff
|
||||||
diff))
|
|
||||||
in
|
in
|
||||||
let* _checl =
|
let* _checl =
|
||||||
match law_article_text.current_version with
|
match law_article_text.current_version with
|
||||||
|
@ -10,7 +10,7 @@
|
|||||||
cohttp-lwt-unix
|
cohttp-lwt-unix
|
||||||
yojson
|
yojson
|
||||||
re
|
re
|
||||||
ANSITerminal))
|
ocolor))
|
||||||
|
|
||||||
(documentation
|
(documentation
|
||||||
(package catala_legifrance))
|
(package catala_legifrance))
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
(executable
|
(executable
|
||||||
(name run_tests)
|
(name run_tests)
|
||||||
(modes native)
|
(modes native)
|
||||||
(libraries catala.runtime_ocaml ANSITerminal))
|
(libraries catala.runtime_ocaml ocolor))
|
||||||
|
|
||||||
(copy_files#
|
(copy_files#
|
||||||
../../../../examples/allocations_familiales/tests/tests_allocations_familiales.ml)
|
../../../../examples/allocations_familiales/tests/tests_allocations_familiales.ml)
|
||||||
|
@ -3,14 +3,10 @@ let failure = ref false
|
|||||||
let try_test msg test =
|
let try_test msg test =
|
||||||
try
|
try
|
||||||
test ();
|
test ();
|
||||||
Format.printf "%s %s\n"
|
Format.printf "@{<green>PASS@} @{<magenta>%s@}\n" msg
|
||||||
(ANSITerminal.sprintf [ANSITerminal.green] "PASS")
|
|
||||||
(ANSITerminal.sprintf [ANSITerminal.magenta] msg)
|
|
||||||
with Runtime_ocaml.Runtime.AssertionFailed _ ->
|
with Runtime_ocaml.Runtime.AssertionFailed _ ->
|
||||||
failure := true;
|
failure := true;
|
||||||
Format.printf "%s %s\n"
|
Format.printf "@{<red>FAIL@} @{<magenta>%s@}\n" msg
|
||||||
(ANSITerminal.sprintf [ANSITerminal.red] "FAIL")
|
|
||||||
(ANSITerminal.sprintf [ANSITerminal.magenta] msg)
|
|
||||||
|
|
||||||
let _ =
|
let _ =
|
||||||
try_test "Allocations familiales #1" Tests_allocations_familiales.test1;
|
try_test "Allocations familiales #1" Tests_allocations_familiales.test1;
|
||||||
|
Loading…
Reference in New Issue
Block a user