Source file styled_printer.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
type t = {
  printer : Printer.t;
  theme : Colors.theme;
  mutable style_override : Colors.style option;
  trivia : Trivia.t;
  seen : (Ast.location, unit) Hashtbl.t;
  collect : (Ast.location, unit) Hashtbl.t option;
}

let create ~printer ~theme ?collect ~trivia () =
  {
    printer;
    theme;
    style_override = None;
    trivia;
    seen = Hashtbl.create 16;
    collect;
  }

let print_styled t style ?(len = None) text =
  let style = Option.value ~default:style t.style_override in
  let seq = Colors.escape_sequence t.theme style in
  if seq <> "" then Printer.string_as t.printer 0 seq;
  (match len with
  | None -> Printer.string t.printer text
  | Some len -> Printer.string_as t.printer len text);
  if seq <> "" then Printer.string_as t.printer 0 t.theme.reset

let comment t s = print_styled t Comment s

(* Emit a list of trivia entries (comments, blank lines), styling comment text
   with the theme and laying out spacing with the printer. *)
let print_trivia t lst =
  let open Trivia in
  List.iter
    (fun e ->
      match (e.trivia, e.position) with
      | Item { kind = Block_comment; content; _ }, _ ->
          Printer.space t.printer ();
          comment t content;
          Printer.space t.printer ()
      | Item { kind = Line_comment; content; _ }, Inline ->
          (* Trailing comment: defer it past a following separator (e.g. a list
             comma) so the separator stays on this line, ahead of the comment. *)
          Printer.defer_eol t.printer (fun () ->
              Printer.string t.printer " ";
              comment t (String.trim content))
      | Item { kind = Line_comment; content; _ }, Line_start ->
          Printer.newline t.printer ();
          comment t (String.trim content);
          Printer.newline t.printer ()
      | Item { kind = Annotation; _ }, _ -> ()
      | Blank_line, _ -> Printer.blank_line t.printer ())
    lst

let get_trivia t loc = Trivia.get ?collect:t.collect t.trivia ~seen:t.seen loc

let atomic_node t loc f =
  let assoc = get_trivia t loc in
  print_trivia t assoc.before;
  f ();
  print_trivia t assoc.within;
  print_trivia t assoc.after

let with_style t style f =
  match t.style_override with
  | Some _ -> f ()
  | None ->
      t.style_override <- Some style;
      f ();
      t.style_override <- None