Some examples of using OCaml's Format

examples.ml

(** Examples of OCaml Format pretty-printing. 

    Add a dune file:
    (executable (name example))
    
    Compile and run: dune exec ./example.exe

*)

(* First an easy one.
   We want to print an integer on its own line like this: <<i>>
   This function takes a formatter, and an int. *)
let pp_int_on_own_line (fmt : Format.formatter) (i : int) : unit =
  Format.pp_open_hbox fmt ();       (* Open a horizontal format box. *)
  Format.pp_print_string fmt "<<";  (* Print some prefix stuff *)
  Format.pp_print_int fmt i;        (* Print the integer *)
  Format.pp_print_string fmt ">>";  (* Print some suffix stuff *)
  Format.pp_close_box fmt ();       (* Close the format box *)
  Format.pp_print_newline fmt ()    (* Flush the pretty printer buffer. *)

(* Define some custom semantic tags. *)
type Format.stag +=
  | Red
  | Yellow

(* Lookup the terminal escape code for the above semantic tags. *)
let code_of_color (color : Format.stag) : string option =
  match color with
  | Red -> Some "0;31"
  | Yellow -> Some "0;33";
  | _ -> None

(* We have to define a record of open/close mark_stag functions,
   and also open/close print_stag functions. The open_mark_stag and
   open_print_stag functions are called when a semantic tag is opened,
   and the close_* variants are called when its closed. *)
let tag_functions : Format.formatter_stag_functions = {
    mark_open_stag = (fun stag -> (* Print escape code when stag is opened. *)
      match code_of_color stag with
      | None -> ""
      | Some code -> Format.sprintf "\027[%sm" code);
    mark_close_stag = (fun _ -> "\027[0m"); (* Print reset code at close. *)
    print_open_stag = (fun _ -> ());  (* We don't need to do anything *)
    print_close_stag = (fun _ -> ()); (* for print_stag open/close.   *)
  }

(* Finally, we can set up a pretty-printer function that takes a formatter,
   a semantic tag, and a string, and it prints the string with the
   appropriate formatting. *)
let pp_colorize (fmt : Format.formatter) (stag : Format.stag) (s : string)
    : unit =
  (* Register our tag functions with the pretty-printer. *)
  Format.pp_set_formatter_stag_functions fmt tag_functions;

  (* Are we currently marking open/close tags? *)
  let original_tag_marking_state = Format.get_mark_tags () in

  Format.pp_set_mark_tags fmt true; (* Turn on tag marking. *)
  Format.pp_open_stag fmt stag;     (* Open the semantic tag. *)
  Format.pp_print_string fmt s;     (* Print our string. *)
  Format.pp_close_stag fmt ();      (* Close the semantic tag. *)

  (* Tell the pretty-printer to go back to what it was doing before. *)
  Format.pp_set_mark_tags fmt original_tag_marking_state

(* Print some red text in an hbox. *)
let pp_red (fmt : Format.formatter) (s : string) : unit =
  Format.pp_open_hbox fmt ();
  pp_colorize fmt Red s;
  Format.pp_close_box fmt ()

(* Print some yellow text in an hbox. *)
let pp_yellow (fmt : Format.formatter) (s : string) : unit =
  Format.pp_open_hbox fmt ();
  pp_colorize fmt Yellow s;
  Format.pp_close_box fmt ()

let () =

  (* Demo the simple pretty printer. *)
  Format.printf "An int on its own line: %a" pp_int_on_own_line 7;
  Format.printf "An int on its own line: %a" pp_int_on_own_line 11;
  print_endline "";

  (* Demo the colored pretty printer. *)
  Format.printf "Some red text: %a\n" pp_red "Lorem ipsum";
  Format.printf "Some yellow text: %a\n" pp_yellow "Dolor sit amet"