Source file ansi_output.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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
open! Core
open! Import

(* From https://en.wikipedia.org/wiki/ANSI_escape_code last accessed 2016-05-26 *)

module RGB6 = struct
  include Format.Color.RGB6

  let escape_code { r; g; b } = 16 + (36 * r) + (6 * g) + b
end

module Gray24 = struct
  include Format.Color.Gray24

  let escape_code { level } = 232 + level
end

let codes_of_foreground_color : Format.Color.t -> string = function
  | Black -> "30"
  | Red -> "31"
  | Green -> "32"
  | Yellow -> "33"
  | Blue -> "34"
  | Magenta -> "35"
  | Cyan -> "36"
  | White -> "37"
  | Default -> "39"
  | Gray | Bright_black -> "90"
  | Bright_red -> "91"
  | Bright_green -> "92"
  | Bright_yellow -> "93"
  | Bright_blue -> "94"
  | Bright_magenta -> "95"
  | Bright_cyan -> "96"
  | Bright_white -> "97"
  | RGB6 x -> sprintf "38;5;%d" (RGB6.escape_code x)
  | Gray24 x -> sprintf "38;5;%d" (Gray24.escape_code x)
;;

let codes_of_background_color : Format.Color.t -> string = function
  | Black -> "40"
  | Red -> "41"
  | Green -> "42"
  | Yellow -> "43"
  | Blue -> "44"
  | Magenta -> "45"
  | Cyan -> "46"
  | White -> "47"
  | Default -> "49"
  | Gray | Bright_black -> "100"
  | Bright_red -> "101"
  | Bright_green -> "102"
  | Bright_yellow -> "103"
  | Bright_blue -> "104"
  | Bright_magenta -> "105"
  | Bright_cyan -> "106"
  | Bright_white -> "107"
  | RGB6 x -> sprintf "48;5;%d" (RGB6.escape_code x)
  | Gray24 x -> sprintf "48;5;%d" (Gray24.escape_code x)
;;

let codes_of_style : Format.Style.t -> string = function
  | Reset -> "0"
  | Bold -> "1"
  | Dim -> "2"
  | Underline | Emph -> "4"
  | Blink -> "5"
  | Inverse -> "7"
  | Hide -> "8"
  | Fg c | Foreground c -> codes_of_foreground_color c
  | Bg c | Background c -> codes_of_background_color c
;;

let apply_styles ?(drop_leading_resets = false) (styles : Format.Style.t list) str =
  let styles =
    if drop_leading_resets
    then
      List.drop_while styles ~f:(function
        | Reset -> true
        | _ -> false)
    else (
      match styles with
      | [] -> []
      | Reset :: _ -> styles
      | _ :: _ -> Reset :: styles)
  in
  match styles with
  | [] -> str
  | _ ->
    sprintf
      "\027[%sm%s\027[0m"
      (List.map styles ~f:codes_of_style |> String.concat ~sep:";")
      str
;;

module Rule = struct
  let apply text ~(rule : Format.Rule.t) ~refined =
    let only_whitespace =
      (not (String.is_empty text)) && String.for_all text ~f:Char.is_whitespace
    in
    let text_style : Format.Style.t list =
      if List.is_empty rule.styles
      then []
      else (
        match refined, only_whitespace with
        | true, _ -> [ Reset ]
        | false, true -> Inverse :: rule.styles
        | false, false -> rule.styles)
    in
    sprintf
      "%s%s%s"
      (apply_styles rule.pre.styles rule.pre.text)
      (apply_styles text_style text)
      (apply_styles rule.suf.styles rule.suf.text)
  ;;
end

let print_header ~(rules : Format.Rules.t) ~file_names:(prev_file, next_file) ~print =
  let print_line (file : File_name.t) rule =
    print (Rule.apply (File_name.display_name file) ~rule ~refined:false)
  in
  print_line prev_file rules.header_prev;
  print_line next_file rules.header_next
;;

let print
      ~print_global_header
      ~file_names:((prev_file, _) as file_names)
      ~(rules : Format.Rules.t)
      ~print
      ~location_style
      hunks
  =
  let f_hunk_break hunk =
    Format.Location_style.sprint
      location_style
      hunk
      ~prev_filename:(File_name.display_name prev_file)
      ~rule:(Rule.apply ~rule:rules.hunk ~refined:false)
    |> print
  in
  if print_global_header then print_header ~rules ~file_names ~print;
  Hunks.iter' ~f_hunk_break ~f_line:print hunks
;;