pp_list.ml

let printf = Format.printf
let fprintf = Format.fprintf
let dprintf = Format.dprintf

let pp_list ~sep pp =
  Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf sep) pp

let pp_string ppf string = fprintf ppf "%S" string

let many = [
  "one"; "two"; "three"; "four"; "five"; "six"; "seven";
  "eight"; "nine"; "ten"; "eleven"; "twelve"; "thirteen";
  "fourteen"; (* "fifteen"; "seventeen"; "nineteen"; "twenty";*)
]

let few = [
  "one"; "two"; "three"; (*"four"; "five"; "six"; "seven";*)
]

let empty = []

let lists = [many; few; empty]

let test f =
  [many; few; empty] |> List.iter (fun list -> 
    f list;
    printf "@."
  );
  printf "@."


let () =
  Format.set_margin 60;

  printf "Hi@.";
  begin 
    let pp_sep ppf () = fprintf ppf ",@;<1 2>" in
    let pp_list pp_item ppf list = 
      fprintf ppf "@[<hv>[@;<0 2>%a@;<0 0>]@]" 
        (Format.pp_print_list ~pp_sep pp_item) list
    in
    printf "%a" (pp_list (pp_list pp_string)) lists
  end;

  printf "@.No boxes or break hints:@.";
  test begin fun list ->
    printf "[%a]" 
      (pp_list ~sep:", " pp_string) list
  end;

  printf "Horizontal-xor-vertical 'hv' box:@.";
  test begin fun list ->
    printf "@[<hv>[%a]@]" 
      (pp_list ~sep:",@;<1 1>" pp_string) list
  end;
    
  printf "Horizontal-xor-vertical 'hv' box with break hints near brackets:@.";
  test begin fun list ->
    printf "@[<hv>[@;<0 1>%a@;<0 0>]@]" 
      (pp_list ~sep:",@;<1 1>" pp_string) list
  end;

  printf "Horizontal 'h' box with break hints near brackets:@.";
  test begin fun list ->
    printf "@[<h>[@;<0 1>%a@;<0 0>]@]" 
      (pp_list ~sep:",@;<1 1>" pp_string) list
  end;

  printf "Vertical 'v' box with break hints near brackets:@.";
  test begin fun list ->
    printf "@[<v>[@;<0 1>%a@;<0 0>]@]" 
      (pp_list ~sep:",@;<1 1>" pp_string) list
  end;
    
  printf "Compacting 'b' box with break hints near brackets:@.";
  test begin fun list ->
    printf "@[<b>[@;<0 1>%a@;<0 0>]@]" 
      (pp_list ~sep:",@;<1 1>" pp_string) list
  end;

  printf "Compacting 'b' box without last break hint@.";
  test begin fun list ->
    printf "@[<b>[@;<0 1>%a]@]" 
      (pp_list ~sep:",@;<1 1>" pp_string) list
  end;
    
    
    
(*  test begin fun list ->
    printf "@[<b>[@;<0 1>%a@;<0 0>]@]" 
      (pp_list ~sep:",@;<1 1>" pp_string) list
  end*)
(*
  printf "@[<b>[@;<0 1>%a@;<0 0>]@]@." 
    (pp_list ~sep:",@;<1 1>" pp_string) many;
  printf "@[<b>[@;<0 1>%a@;<0 0>]@]@." 
    (pp_list ~sep:",@;<1 1>" pp_string) few;
  printf "@[<b>[@;<0 1>%a@;<0 0>]@]@." 
    (pp_list ~sep:",@;<1 1>" pp_string) empty
*)