Source file PPUtils.ml

let pp_list ?(sep = format_of_string ",@ ") ?(terminal = format_of_string "") ppf fmt l =
  let rec list_ppf_aux ppf fmt l =
    match l with
    | [] -> ()
    | [ a ] -> Format.fprintf fmt ("%a" ^^ terminal) ppf a 
    | a :: tl ->
        let () = Format.fprintf fmt ("%a" ^^ sep) ppf a in
        list_ppf_aux ppf fmt tl
  in
  Format.fprintf fmt "%a" (list_ppf_aux ppf) l

let pp_list_i ?(sep = format_of_string ",@ ") ?(terminal = format_of_string "") ppf fmt l =
  let rec list_ppf_aux i ppf fmt l =
    match l with
    | [] -> ()
    | [ a ] -> Format.fprintf fmt ("%a" ^^ terminal) ppf (i, a)
    | a :: tl ->
        let () = Format.fprintf fmt ("%a" ^^ sep) ppf (i, a) in
        list_ppf_aux (i+1) ppf fmt tl
  in
  Format.fprintf fmt "%a" (list_ppf_aux 1 ppf) l



let pp_text fmt text =
  let words = String.split_on_char ' ' text in
    pp_list ~sep:"@ " Format.pp_print_string fmt words


let resize_formatter ?width ?(formatter=Format.std_formatter) () =
  let terminal_width = 
    match width with 
    | Some w -> w
    | None ->
       begin
         match ANSITerminal.size () with
         | w, _h when Out_channel.isatty stdout -> w
         | exception (Failure f)
              when (Str.(string_match (regexp "ANSITerminal.size") f 0)) -> Format.pp_infinity - 1
         | _ -> Format.pp_infinity -1
       end in
  Format.pp_set_margin formatter terminal_width

let no_pp ?(formatter=Format.std_formatter) () =
  Format.(pp_set_margin formatter (pp_infinity - 1))

let fformat formatter format = Format.fprintf formatter format
let format format = fformat Format.std_formatter format [@@warning "-unused-value-declaration"]

let format_of_list fmter sep to_string = function
  | [] -> ()
  | [ a ] -> fformat fmter "@[%s@]" (to_string a)
  | a :: tl ->
      let () = fformat fmter "@[%s@]" (to_string a) in
      List.iter (fun s -> fformat fmter "%s@,@[%s@]" sep (to_string s)) tl

let app_pp = Tags.app_pp
let err_pp = Tags.err_pp
let warn_pp = Tags.warn_pp
let info_pp = Tags.info_pp
let debug_pp = Tags.debug_pp

let fun_pp = Tags.fun_pp
let sig_pp = Tags.sig_pp
let lex_pp = Tags.lex_pp
let term_pp = Tags.term_pp
let arg_pp = Tags.arg_pp
let binary_pp = Tags.binary_pp