feat(CCFormat): expose ANSI_codes module

src/core/CCFormat.ml

@@ -242,7 +242,8 @@ let to_file filename format =
     (fun fmt -> Format.pp_print_flush fmt (); close_out_noerr oc)
     fmt format
 
-type color =
+module ANSI_codes = struct
+  type color =
     [ `Black
     | `Red
     | `Yellow
@@ -253,7 +254,7 @@ type color =
     | `White
     ]
 
-let int_of_color_ = function
+  let int_of_color_ = function
     | `Black -> 0
     | `Red -> 1
     | `Green -> 2
@@ -263,25 +264,39 @@ let int_of_color_ = function
     | `Cyan -> 6
     | `White -> 7
 
-type style =
+  type style =
     [ `FG of color (* foreground *)
     | `BG of color (* background *)
     | `Bold
     | `Reset
     ]
 
-let code_of_style : style -> int = function
+  let code_of_style : style -> int = function
     | `FG c -> 30 + int_of_color_ c
     | `BG c -> 40 + int_of_color_ c
     | `Bold -> 1
     | `Reset -> 0
 
-let ansi_l_to_str_ = function
-  | [] -> "\x1b[0m"
-  | [a] -> Printf.sprintf "\x1b[%dm" (code_of_style a)
+  let string_of_style a =
+    Printf.sprintf "\x1b[%dm" (code_of_style a)
+
+  let clear_line = "\x1b[2K\r"
+
+  let reset = string_of_style `Reset
+
+  (*$=
+    ANSI_codes.reset "\x1b[0m"
+  *)
+
+  let string_of_style_list = function
+    | [] -> reset
+    | [a] -> string_of_style a
     | [a;b] -> Printf.sprintf "\x1b[%d;%dm" (code_of_style a) (code_of_style b)
+    | [a;b;c] ->
+      Printf.sprintf "\x1b[%d;%d;%dm"
+        (code_of_style a) (code_of_style b) (code_of_style c)
     | l ->
-    let buf = Buffer.create 16 in
+      let buf = Buffer.create 32 in
       let pp_num c = Buffer.add_string buf (string_of_int (code_of_style c)) in
       Buffer.add_string buf "\x1b[";
       List.iteri
@@ -292,10 +307,11 @@ let ansi_l_to_str_ = function
       Buffer.add_string buf "m";
       Buffer.contents buf
 
-exception No_such_style
+  exception No_such_style
 
-(* parse a tag *)
-let style_of_tag_ s = match String.trim s with
+  (* parse a string tag.
+     TODO: use [stag], for OCaml >= 4.08… *)
+  let style_of_tag_ s = match String.trim s with
     | "reset" -> [`Reset]
     | "black" -> [`FG `Black]
     | "red" -> [`FG `Red]
@@ -315,18 +331,21 @@ let style_of_tag_ s = match String.trim s with
     | "Cyan" -> [`FG `Cyan; `Bold]
     | "White" -> [`FG `White; `Bold]
     | _ -> raise No_such_style
+end
 
 let color_enabled = ref false
 
 (* either prints the tag of [s] or delegate to [or_else] *)
 let mark_open_tag st ~or_else s =
+  let open ANSI_codes in
   try
     let style = style_of_tag_ s in
     Stack.push style st;
-    if !color_enabled then ansi_l_to_str_ style else ""
+    if !color_enabled then string_of_style_list style else ""
   with No_such_style -> or_else s
 
 let mark_close_tag st ~or_else s =
+  let open ANSI_codes in
   (* check if it's indeed about color *)
   match style_of_tag_ s with
     | _ ->
@@ -337,7 +356,7 @@ let mark_close_tag st ~or_else s =
         with Stack.Empty ->
           [`Reset]
       in
-      if !color_enabled then ansi_l_to_str_ style else ""
+      if !color_enabled then string_of_style_list style else ""
     | exception No_such_style -> or_else s
 
 (* add color handling to formatter [ppf] *)

src/core/CCFormat.mli

@@ -263,6 +263,57 @@ val with_color_ksf : f:(string -> 'b) -> string -> ('a, t, unit, 'b) format4 ->
     ]}
     @since 1.2 *)
 
+
+(** ANSI escape codes. This contains lower level functions for them.
+    @since NEXT_RELEASE *)
+module ANSI_codes : sig
+  type color =
+    [ `Black
+    | `Red
+    | `Yellow
+    | `Green
+    | `Blue
+    | `Magenta
+    | `Cyan
+    | `White
+    ]
+  (** An ANSI color *)
+
+  type style =
+    [ `FG of color (** foreground *)
+    | `BG of color (** background *)
+    | `Bold
+    | `Reset
+    ]
+  (** A style. Styles can be composed in a list. *)
+
+  val clear_line : string
+  (** [clear_line] is an escape code to clear the current line. It
+      is very useful for progress bars; for example:
+
+      {[
+        let pp_progress i =
+          Printf.printf "%sprogress at %d%!" ANSI_codes.clear_line i
+      ]}
+      if called repeatedly this will print successive progress messages
+      on a single line.
+  *)
+
+  val reset : string
+  (** The escape code to reset style (colors, bold, etc.) *)
+
+  val string_of_style : style -> string
+  (** [string_of_style st] is an escape code to set the current style
+      to [st]. It can be printed as is on any output that is a
+      compatible terminal. *)
+
+  val string_of_style_list : style list -> string
+  (** [string_of_style_list styles] is an escape code
+      for multiple styles at once.
+      For example [string_of_style_list ANSI_codes.([`FG `Red; `BG `Green; `Bold])]
+      is a very shiny style. *)
+end
+
 (** {2 IO} *)
 
 val output : t -> 'a printer -> 'a -> unit