From b2138dbcb92f3df3b640149e172ec67032b3c698 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 26 Mar 2021 20:13:20 -0700 Subject: [PATCH 1/6] Ansi_color.to_dyn Signed-off-by: Rudi Grinberg --- otherlibs/stdune-unstable/ansi_color.ml | 2 ++ otherlibs/stdune-unstable/ansi_color.mli | 2 ++ 2 files changed, 4 insertions(+) diff --git a/otherlibs/stdune-unstable/ansi_color.ml b/otherlibs/stdune-unstable/ansi_color.ml index ac2a073514a..6d451553231 100644 --- a/otherlibs/stdune-unstable/ansi_color.ml +++ b/otherlibs/stdune-unstable/ansi_color.ml @@ -1,6 +1,8 @@ module Style = struct type t = string + let to_dyn s = Dyn.Encoder.string s + let fg_black = "30" let fg_red = "31" diff --git a/otherlibs/stdune-unstable/ansi_color.mli b/otherlibs/stdune-unstable/ansi_color.mli index 2ebca9488cd..5fffb498734 100644 --- a/otherlibs/stdune-unstable/ansi_color.mli +++ b/otherlibs/stdune-unstable/ansi_color.mli @@ -1,6 +1,8 @@ module Style : sig type t + val to_dyn : t -> Dyn.t + val fg_default : t val fg_black : t From bcc095fcf88bbbb58618f16d7a07afba7781cd36 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 26 Mar 2021 20:13:37 -0700 Subject: [PATCH 2/6] Add test for 2664 Demonstrates incorrect parsing of escape sequences Signed-off-by: Rudi Grinberg --- test/expect-tests/stdune/ansi_color_tests.ml | 486 +++++++++++++++++++ 1 file changed, 486 insertions(+) create mode 100644 test/expect-tests/stdune/ansi_color_tests.ml diff --git a/test/expect-tests/stdune/ansi_color_tests.ml b/test/expect-tests/stdune/ansi_color_tests.ml new file mode 100644 index 00000000000..62dd06a97dd --- /dev/null +++ b/test/expect-tests/stdune/ansi_color_tests.ml @@ -0,0 +1,486 @@ +open Stdune + +let dyn_of_pp tag pp = + let open Dyn.Encoder in + let rec conv = function + | Pp.Ast.Nop -> constr "Nop" [] + | Seq (x, y) -> constr "Seq" [ conv x; conv y ] + | Concat (x, y) -> constr "Concat" [ conv x; list conv y ] + | Box (i, x) -> constr "Box" [ int i; conv x ] + | Vbox (i, x) -> constr "Vbox" [ int i; conv x ] + | Hbox x -> constr "Hbox" [ conv x ] + | Hvbox (i, x) -> constr "Hvbox" [ int i; conv x ] + | Hovbox (i, x) -> constr "Hovbox" [ int i; conv x ] + | Verbatim s -> constr "Verbatim" [ string s ] + | Char c -> constr "Char" [ char c ] + | Break (x, y) -> + let f = triple string int string in + constr "Break" [ f x; f y ] + | Newline -> constr "Newline" [] + | Tag (ta, t) -> constr "Tag" [ tag ta; conv t ] + | Text s -> constr "Text" [ string s ] + in + conv + (match Pp.to_ast pp with + | Ok s -> s + | Error () -> assert false) + +let%expect_test "reproduce #2664" = + (* https://github.com/ocaml/dune/issues/2664 *) + let b = Buffer.create 100 in + let f s = Buffer.add_string b ("\027[34m" ^ s ^ "\027[39m") in + for i = 1 to 20 do + f (string_of_int i) + done; + let pp = + Buffer.contents b |> Ansi_color.parse + |> dyn_of_pp (Dyn.Encoder.list Ansi_color.Style.to_dyn) + |> Dyn.pp + in + Format.printf "%a@.%!" Pp.to_fmt pp; + [%expect + {| + Vbox + 0,Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq + Seq Nop,Tag [ "34" ],Verbatim "1", + Tag + [ "34"; "39"; "34" ],Verbatim "2", + Tag + [ "34"; "39"; "34"; "39"; "34" ], + Verbatim + "3",Tag + [ "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ],Verbatim "4",Tag + [ "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ], + Verbatim + "5", + Tag + [ "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ],Verbatim "6",Tag + [ "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ],Verbatim "7",Tag + [ "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ],Verbatim + "8", + Tag + [ "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ],Verbatim "9",Tag + [ "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ],Verbatim "10",Tag + [ "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ],Verbatim + "11", + Tag + [ "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ],Verbatim "12",Tag + [ "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ],Verbatim "13",Tag + [ "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ],Verbatim "14", + Tag + [ "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ],Verbatim "15",Tag + [ "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ],Verbatim "16",Tag + [ "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ],Verbatim "17", + Tag + [ "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ],Verbatim "18",Tag + [ "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ],Verbatim "19",Tag + [ "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ; "39" + ; "34" + ],Verbatim "20" |}] From 978eeb60860258f18d9231f44ba8f10db8b1f21d Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 29 Mar 2021 14:38:27 -0700 Subject: [PATCH 3/6] Handle 39 correctly Signed-off-by: Rudi Grinberg --- CHANGES.md | 3 + otherlibs/stdune-unstable/ansi_color.ml | 21 + test/expect-tests/stdune/ansi_color_tests.ml | 446 ++----------------- 3 files changed, 53 insertions(+), 417 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 48ef39a84b4..68925190517 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,9 @@ Unreleased ---------- +- Improve interpretation of ansi escape sequence when spawning processes (#4408, + fixes #2665, @rgrinberg) + - Allow `(package pkg)` in dependencies even if `pkg` is an installed package (#4170, @bobot) diff --git a/otherlibs/stdune-unstable/ansi_color.ml b/otherlibs/stdune-unstable/ansi_color.ml index 6d451553231..8bbcddbbef0 100644 --- a/otherlibs/stdune-unstable/ansi_color.ml +++ b/otherlibs/stdune-unstable/ansi_color.ml @@ -37,6 +37,24 @@ module Style = struct let fg_bright_white = "97" + let fg_all = + [ fg_black + ; fg_green + ; fg_yellow + ; fg_blue + ; fg_magenta + ; fg_cyan + ; fg_white + ; fg_bright_black + ; fg_bright_red + ; fg_bright_green + ; fg_bright_yellow + ; fg_bright_blue + ; fg_bright_magenta + ; fg_bright_cyan + ; fg_bright_white + ] + let bg_black = "40" let bg_red = "41" @@ -181,6 +199,9 @@ let parse_line str styles = |> String.split ~on:';' |> List.fold_left ~init:(List.rev styles) ~f:(fun styles s -> match s with + | "39" -> + List.filter styles ~f:(fun s -> + not (List.mem Style.fg_all s ~equal:String.equal)) | "0" -> [] | _ -> s :: styles) |> List.rev diff --git a/test/expect-tests/stdune/ansi_color_tests.ml b/test/expect-tests/stdune/ansi_color_tests.ml index 62dd06a97dd..031b8c655d6 100644 --- a/test/expect-tests/stdune/ansi_color_tests.ml +++ b/test/expect-tests/stdune/ansi_color_tests.ml @@ -62,425 +62,37 @@ let%expect_test "reproduce #2664" = Seq Seq Nop,Tag [ "34" ],Verbatim "1", Tag - [ "34"; "39"; "34" ],Verbatim "2", - Tag - [ "34"; "39"; "34"; "39"; "34" ], - Verbatim - "3",Tag - [ "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ],Verbatim "4",Tag - [ "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ], - Verbatim - "5", + [ "34" ],Verbatim "2",Tag + [ "34" ], + Verbatim + "3", + Tag + [ "34" ],Verbatim "4",Tag + [ "34" ], + Verbatim + "5", Tag - [ "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ],Verbatim "6",Tag - [ "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ],Verbatim "7",Tag - [ "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ],Verbatim + [ "34" ],Verbatim "6",Tag + [ "34" ], + Verbatim + "7",Tag + [ "34" ], + Verbatim "8", Tag - [ "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ],Verbatim "9",Tag - [ "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ],Verbatim "10",Tag - [ "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ],Verbatim - "11", - Tag - [ "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ],Verbatim "12",Tag - [ "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ],Verbatim "13",Tag - [ "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ],Verbatim "14", + [ "34" ],Verbatim "9",Tag + [ "34" ],Verbatim "10", + Tag + [ "34" ],Verbatim "11",Tag [ "34" ],Verbatim "12", + Tag + [ "34" ],Verbatim "13",Tag [ "34" ],Verbatim "14", Tag - [ "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ],Verbatim "15",Tag - [ "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ],Verbatim "16",Tag - [ "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ],Verbatim "17", + [ "34" ],Verbatim "15",Tag [ "34" ],Verbatim "16",Tag + [ "34" ], + Verbatim + "17", Tag - [ "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ],Verbatim "18",Tag - [ "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ],Verbatim "19",Tag - [ "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ; "39" - ; "34" - ],Verbatim "20" |}] + [ "34" ],Verbatim "18",Tag [ "34" ],Verbatim "19",Tag + [ "34" ], + Verbatim + "20" |}] From 6340d18d346b573bda32e75fee5d2d92100edb1f Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 29 Mar 2021 15:06:27 -0700 Subject: [PATCH 4/6] Improve ansi colors tests show how our pp'd value is outputted Signed-off-by: Rudi Grinberg --- otherlibs/stdune-unstable/ansi_color.mli | 3 +++ test/expect-tests/stdune/ansi_color_tests.ml | 18 ++++++++++++++---- 2 files changed, 17 insertions(+), 4 deletions(-) diff --git a/otherlibs/stdune-unstable/ansi_color.mli b/otherlibs/stdune-unstable/ansi_color.mli index 5fffb498734..2c13649eed8 100644 --- a/otherlibs/stdune-unstable/ansi_color.mli +++ b/otherlibs/stdune-unstable/ansi_color.mli @@ -81,6 +81,9 @@ module Style : sig val escape_sequence : t list -> string end +val make_printer : + bool Lazy.t -> Format.formatter -> (Style.t list Pp.t -> unit) Staged.t + (** Print to [Format.std_formatter] *) val print : Style.t list Pp.t -> unit diff --git a/test/expect-tests/stdune/ansi_color_tests.ml b/test/expect-tests/stdune/ansi_color_tests.ml index 031b8c655d6..5c4ac1ae562 100644 --- a/test/expect-tests/stdune/ansi_color_tests.ml +++ b/test/expect-tests/stdune/ansi_color_tests.ml @@ -32,11 +32,21 @@ let%expect_test "reproduce #2664" = for i = 1 to 20 do f (string_of_int i) done; - let pp = - Buffer.contents b |> Ansi_color.parse - |> dyn_of_pp (Dyn.Encoder.list Ansi_color.Style.to_dyn) - |> Dyn.pp + let string_with_ansi_colors = Buffer.contents b in + let pp = Ansi_color.parse string_with_ansi_colors in + let ansi_colors_from_pp = + let b = Buffer.create 16 in + let ppf = Format.formatter_of_buffer b in + Staged.unstage (Ansi_color.make_printer (lazy true) ppf) pp; + Buffer.contents b in + printfn "Original : %S" string_with_ansi_colors; + printfn "From PP : %S" ansi_colors_from_pp; + [%expect + {| + Original : "\027[34m1\027[39m\027[34m2\027[39m\027[34m3\027[39m\027[34m4\027[39m\027[34m5\027[39m\027[34m6\027[39m\027[34m7\027[39m\027[34m8\027[39m\027[34m9\027[39m\027[34m10\027[39m\027[34m11\027[39m\027[34m12\027[39m\027[34m13\027[39m\027[34m14\027[39m\027[34m15\027[39m\027[34m16\027[39m\027[34m17\027[39m\027[34m18\027[39m\027[34m19\027[39m\027[34m20\027[39m" + From PP : "\027[34m1\027[0m\027[34m2\027[0m\027[34m3\027[0m\027[34m4\027[0m\027[34m5\027[0m\027[34m6\027[0m\027[34m7\027[0m\027[34m8\027[0m\027[34m9\027[0m\027[34m10\027[0m\027[34m11\027[0m\027[34m12\027[0m\027[34m13\027[0m\027[34m14\027[0m\027[34m15\027[0m\027[34m16\027[0m\027[34m17\027[0m\027[34m18\027[0m\027[34m19\027[0m\027[34m20\027[0m" |}]; + let pp = dyn_of_pp (Dyn.Encoder.list Ansi_color.Style.to_dyn) pp |> Dyn.pp in Format.printf "%a@.%!" Pp.to_fmt pp; [%expect {| From 94265386d3715df52555301c6913ab29b764dc48 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 30 Mar 2021 09:30:43 -0700 Subject: [PATCH 5/6] support reset bg color escape Signed-off-by: Rudi Grinberg --- otherlibs/stdune-unstable/ansi_color.ml | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/otherlibs/stdune-unstable/ansi_color.ml b/otherlibs/stdune-unstable/ansi_color.ml index 8bbcddbbef0..91ecf9716fd 100644 --- a/otherlibs/stdune-unstable/ansi_color.ml +++ b/otherlibs/stdune-unstable/ansi_color.ml @@ -89,6 +89,26 @@ module Style = struct let bg_bright_white = "107" + let bg_all = + [ bg_black + ; bg_red + ; bg_green + ; bg_yellow + ; bg_blue + ; bg_magenta + ; bg_cyan + ; bg_white + ; bg_default + ; bg_bright_black + ; bg_bright_red + ; bg_bright_green + ; bg_bright_yellow + ; bg_bright_blue + ; bg_bright_magenta + ; bg_bright_cyan + ; bg_bright_white + ] + let bold = "1" let dim = "2" @@ -202,6 +222,9 @@ let parse_line str styles = | "39" -> List.filter styles ~f:(fun s -> not (List.mem Style.fg_all s ~equal:String.equal)) + | "49" -> + List.filter styles ~f:(fun s -> + not (List.mem Style.bg_all s ~equal:String.equal)) | "0" -> [] | _ -> s :: styles) |> List.rev From 23b7178ed030394c94747340fb5ce1d5e977e6f0 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 30 Mar 2021 09:32:37 -0700 Subject: [PATCH 6/6] Rewrite match with if/else Signed-off-by: Rudi Grinberg --- otherlibs/stdune-unstable/ansi_color.ml | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/otherlibs/stdune-unstable/ansi_color.ml b/otherlibs/stdune-unstable/ansi_color.ml index 91ecf9716fd..3430ad72f48 100644 --- a/otherlibs/stdune-unstable/ansi_color.ml +++ b/otherlibs/stdune-unstable/ansi_color.ml @@ -218,15 +218,16 @@ let parse_line str styles = String.sub str ~pos:seq_start ~len:(seq_end - seq_start) |> String.split ~on:';' |> List.fold_left ~init:(List.rev styles) ~f:(fun styles s -> - match s with - | "39" -> + if s = Style.fg_default then List.filter styles ~f:(fun s -> not (List.mem Style.fg_all s ~equal:String.equal)) - | "49" -> + else if s = Style.bg_default then List.filter styles ~f:(fun s -> not (List.mem Style.bg_all s ~equal:String.equal)) - | "0" -> [] - | _ -> s :: styles) + else if s = "0" then + [] + else + s :: styles) |> List.rev in loop styles (seq_end + 1) acc)