terminal user interface to jujutsu. Focused on speed and clarity
refactor messy ansi-reverse
+138
-182
+136
-181
jj_tui/lib/ansiReverse.ml
+136
-181
jj_tui/lib/ansiReverse.ml
···
1
1
open Notty
2
-
open Angstrom
3
2
4
-
type op = Buffer.t -> unit
3
+
module Internal = struct
4
+
type op = Buffer.t -> unit
5
5
6
-
(* let ( & ) op1 op2 buf =
7
-
op1 buf;
8
-
op2 buf
6
+
let invalid_arg fmt = Format.kasprintf invalid_arg fmt
9
7
10
-
let ( <| ), ( <. ), ( <! ) = Buffer.(add_string, add_char, add_decimal) *)
11
-
let invalid_arg fmt = Format.kasprintf invalid_arg fmt
12
-
let sts = [ ";1"; ";3"; ";4"; ";5"; ";7" ]
8
+
let attr_of_ints fg bg st =
9
+
A.fg @@ A.unsafe_color_of_int fg
10
+
|> A.( ++ ) (A.bg @@ A.unsafe_color_of_int bg)
11
+
|> A.( ++ ) (A.st @@ A.unsafe_style_of_int st)
12
+
;;
13
13
14
-
let attr_of_ints fg bg st =
15
-
A.fg @@ A.unsafe_color_of_int fg
16
-
|> A.( ++ ) (A.bg @@ A.unsafe_color_of_int bg)
17
-
|> A.( ++ ) (A.st @@ A.unsafe_style_of_int st)
18
-
;;
14
+
let fg_int i = A.fg @@ A.unsafe_color_of_int i
15
+
let bg_int i = A.bg @@ A.unsafe_color_of_int i
19
16
20
-
let fg_int i = A.fg @@ A.unsafe_color_of_int i
21
-
let bg_int i = A.bg @@ A.unsafe_color_of_int i
17
+
let print_image_escaped img =
18
+
print_endline "image:";
19
+
img |> Notty.Render.pp_image @@ Format.str_formatter;
20
+
print_endline (Format.flush_str_formatter () |> String.escaped)
21
+
;;
22
22
23
-
let print_image_escaped img =
24
-
print_endline "image:";
25
-
img |> Notty.Render.pp_image @@ Format.str_formatter;
26
-
print_endline (Format.flush_str_formatter () |> String.escaped)
27
-
;;
23
+
let print_image img =
24
+
print_endline "image:";
25
+
img |> Notty.Render.pp_image @@ Format.str_formatter;
26
+
print_endline (Format.flush_str_formatter ())
27
+
;;
28
28
29
-
let print_image img =
30
-
print_endline "image:";
31
-
img |> Notty.Render.pp_image @@ Format.str_formatter;
32
-
print_endline (Format.flush_str_formatter ())
33
-
;;
29
+
let print_attr img =
30
+
print_endline "attr:";
31
+
img |> Notty.Render.pp_attr @@ Format.str_formatter;
32
+
print_endline (Format.flush_str_formatter ())
33
+
;;
34
34
35
-
let print_attr img =
36
-
print_endline "attr:";
37
-
img |> Notty.Render.pp_attr @@ Format.str_formatter;
38
-
print_endline (Format.flush_str_formatter ())
39
-
;;
35
+
(** Like fold left except we run the first element through init to get the state*)
36
+
let fold_left_pre (f : 'acc -> 'a -> 'acc) (init : 'a -> 'acc) (input : 'a list) =
37
+
match input with
38
+
| [] ->
39
+
invalid_arg "empty list"
40
+
| x :: xs ->
41
+
let state = init x in
42
+
xs |> List.fold_left f state
43
+
;;
44
+
end
40
45
41
-
let parse_escape_seq =
42
-
let open A in
43
-
(* let digit = satisfy (function '0' .. '9' -> true | _ -> false) in *)
44
-
let digits = take_while1 (function '0' .. '9' -> true | _ -> false) in
45
-
(* let color_code = digits >>| int_of_string in *)
46
-
let param = digits <* option ' ' (char ';') in
47
-
let params = many (param >>| int_of_string) in
48
-
let escape_sequence = char '\027' *> char '[' *> params <* char 'm' in
49
-
let attr_of_params = function
50
-
| [] ->
51
-
empty
52
-
| 0 :: _ ->
53
-
empty
54
-
| 1 :: _ ->
55
-
st bold
56
-
| 2 :: _ ->
57
-
st italic
58
-
| 4 :: _ ->
59
-
st underline
60
-
| 5 :: _ ->
61
-
st blink
62
-
| 7 :: _ ->
63
-
st reverse
64
-
| 30 :: _ ->
65
-
fg black
66
-
| 31 :: _ ->
67
-
fg red
68
-
| 32 :: _ ->
69
-
fg green
70
-
| 33 :: _ ->
71
-
fg yellow
72
-
| 34 :: _ ->
73
-
fg blue
74
-
| 35 :: _ ->
75
-
fg magenta
76
-
| 36 :: _ ->
77
-
fg cyan
78
-
| 37 :: _ ->
79
-
fg white
80
-
| 38 :: 5 :: color :: _ ->
81
-
fg (unsafe_color_of_int (0x01000000 lor color))
82
-
| 40 :: _ ->
83
-
bg black
84
-
| 41 :: _ ->
85
-
bg red
86
-
| 42 :: _ ->
87
-
bg green
88
-
| 43 :: _ ->
89
-
bg yellow
90
-
| 44 :: _ ->
91
-
bg blue
92
-
| 45 :: _ ->
93
-
bg magenta
94
-
| 46 :: _ ->
95
-
bg cyan
96
-
| 47 :: _ ->
97
-
bg white
98
-
| 48 :: 5 :: color :: _ ->
99
-
bg (unsafe_color_of_int (0x01000000 lor color))
100
-
| _ ->
101
-
empty
102
-
in
103
-
escape_sequence >>| attr_of_params
104
-
;;
46
+
module Parser = struct
47
+
open Internal
48
+
49
+
let parse_escape_seq =
50
+
let open A in
51
+
let open Angstrom in
52
+
(* let digit = satisfy (function '0' .. '9' -> true | _ -> false) in *)
53
+
let digits = take_while1 (function '0' .. '9' -> true | _ -> false) in
54
+
(* let color_code = digits >>| int_of_string in *)
55
+
let param = digits <* option ' ' (char ';') in
56
+
let params = many (param >>| int_of_string) in
57
+
let escape_sequence = char '\027' *> char '[' *> params <* char 'm' in
58
+
let attr_of_params = function
59
+
| [] ->
60
+
empty
61
+
| 0 :: _ ->
62
+
empty
63
+
| 1 :: _ ->
64
+
st bold
65
+
| 2 :: _ ->
66
+
st italic
67
+
| 4 :: _ ->
68
+
st underline
69
+
| 5 :: _ ->
70
+
st blink
71
+
| 7 :: _ ->
72
+
st reverse
73
+
| 30 :: _ ->
74
+
fg black
75
+
| 31 :: _ ->
76
+
fg red
77
+
| 32 :: _ ->
78
+
fg green
79
+
| 33 :: _ ->
80
+
fg yellow
81
+
| 34 :: _ ->
82
+
fg blue
83
+
| 35 :: _ ->
84
+
fg magenta
85
+
| 36 :: _ ->
86
+
fg cyan
87
+
| 37 :: _ ->
88
+
fg white
89
+
| 38 :: 5 :: color :: _ ->
90
+
fg (unsafe_color_of_int (0x01000000 lor color))
91
+
| 40 :: _ ->
92
+
bg black
93
+
| 41 :: _ ->
94
+
bg red
95
+
| 42 :: _ ->
96
+
bg green
97
+
| 43 :: _ ->
98
+
bg yellow
99
+
| 44 :: _ ->
100
+
bg blue
101
+
| 45 :: _ ->
102
+
bg magenta
103
+
| 46 :: _ ->
104
+
bg cyan
105
+
| 47 :: _ ->
106
+
bg white
107
+
| 48 :: 5 :: color :: _ ->
108
+
bg (unsafe_color_of_int (0x01000000 lor color))
109
+
| _ ->
110
+
empty
111
+
in
112
+
escape_sequence >>| attr_of_params
113
+
;;
105
114
106
-
let%expect_test "escape_parser" =
107
-
let test_str = "\027[32m" in
108
-
let res = parse_string ~consume:All parse_escape_seq test_str |> Result.get_ok in
109
-
print_attr res;
110
-
[%expect {|
115
+
let%expect_test "escape_parser" =
116
+
let test_str = "\027[32m" in
117
+
let res =
118
+
Angstrom.parse_string ~consume:All parse_escape_seq test_str |> Result.get_ok
119
+
in
120
+
print_attr res;
121
+
[%expect {|
111
122
attr:
112
123
[0m<[0;32mATTR[0m[K[0m>[0m |}]
113
-
;;
124
+
;;
114
125
115
-
let parse_ansi_escape_codes (input : string) =
116
-
let attr = parse_escape_seq in
117
-
let substring = take_while (fun c -> c <> '\027') in
118
-
let pair =
119
-
attr >>= fun a ->
120
-
substring >>= fun s -> return (a, s)
121
-
in
122
-
(* if we don't start on an escape we can match one here*)
123
-
let prefix = option "" substring >>| fun s -> A.empty, s in
124
-
let pairs =
125
-
prefix >>= fun prefix ->
126
-
many pair >>= fun pairs ->
127
-
if prefix |> snd == "" then return pairs else prefix :: pairs |> return
128
-
in
129
-
parse_string ~consume:Prefix pairs input
130
-
;;
131
-
132
-
(** Like fold left except we run the first element through init to get the state*)
133
-
let fold_left_pre (f : 'acc -> 'a -> 'acc) (init : 'a -> 'acc) (input : 'a list) =
134
-
match input with
135
-
| [] ->
136
-
invalid_arg "empty list"
137
-
| x :: xs ->
138
-
let state = init x in
139
-
xs |> List.fold_left f state
140
-
;;
126
+
let parse_ansi_escape_codes (input : string) =
127
+
let open Angstrom in
128
+
let attr = parse_escape_seq in
129
+
let substring = take_while (fun c -> c <> '\027') in
130
+
let pair =
131
+
attr >>= fun a ->
132
+
substring >>= fun s -> return (a, s)
133
+
in
134
+
(* if we don't start on an escape we can match one here*)
135
+
let prefix = option "" substring >>| fun s -> A.empty, s in
136
+
let pairs =
137
+
prefix >>= fun prefix ->
138
+
many pair >>= fun pairs ->
139
+
if prefix |> snd == "" then return pairs else prefix :: pairs |> return
140
+
in
141
+
parse_string ~consume:Prefix pairs input
142
+
;;
143
+
end
141
144
142
-
let string_to_image ?(extra_attr = A.empty) str =
145
+
(** Converts a string with ansi escape codes to a notty image.
146
+
It parses the escape codes and then creates notty images from that by applying the styles*)
147
+
let ansi_string_to_image ?(extra_attr = A.empty) str =
143
148
let str =
144
149
(* replace any carrriage returns becasue notty doesn't know what to do with them*)
145
150
Base.String.Search_pattern.replace_all
···
150
155
(Base.String.Search_pattern.create "\r")
151
156
~with_:"\n"
152
157
in
153
-
match parse_ansi_escape_codes str with
158
+
match Parser.parse_ansi_escape_codes str with
154
159
| Error a ->
155
160
Printf.printf "restut: %s" a;
156
161
Error a
157
162
| Ok coded_strs ->
158
-
(* print_endline "parsed"; *)
159
163
let locate_newlines codes =
160
164
codes
161
165
|> List.concat_map (fun (attr, str) ->
162
-
(* print_attr attr; *)
163
-
(* print_endline str; *)
164
166
str
165
167
|> String.split_on_char '\n'
166
168
|> List.map (fun x -> `Image (I.string A.(attr ++ extra_attr) x))
167
169
|> Base.List.intersperse ~sep:`Newline)
168
170
in
169
171
let newline_seperated = locate_newlines coded_strs in
170
-
(* Printf.printf "len:%d" (List.length newline_seperated); *)
171
172
let lines =
172
173
let open I in
173
-
(* newline_seperated
174
-
|> List.iter (fun x -> match x with `Imarge i -> print_image i | _ -> ()); *)
175
174
newline_seperated
176
175
|> Base.List.fold ~init:([], I.empty) ~f:(fun (images, image) x ->
177
176
match x with
···
180
179
| `Image nextImage ->
181
180
images, image <|> nextImage)
182
181
|> fst
183
-
(* |> List.map (fun x ->
184
-
x |> print_image;
185
-
x) *)
186
182
|> Base.List.reduce ~f:(fun bottom top -> top <-> bottom)
187
183
|> Option.value ~default:I.empty
188
184
in
189
-
let image =
190
-
lines
191
-
(* |> fold_left_pre
192
-
(fun image (attr, str) ->
193
-
let parts = str |> String.split_on_char '\n' in
194
-
let nextImage =
195
-
parts
196
-
|> fold_left_pre
197
-
(fun image str -> I.( <-> ) image (I.string attr str))
198
-
(I.string attr)
199
-
in
200
-
I.( <|> ) image nextImage)
201
-
(fun (attr, str) -> I.string attr str) *)
202
-
in
203
-
Ok image
185
+
Ok lines
204
186
;;
205
187
206
-
let escaped_string ?(attr = A.empty) str =
207
-
let control_character_index str i =
208
-
let len = String.length str in
209
-
let i = ref i in
210
-
while
211
-
let i = !i in
212
-
i < len && str.[i] >= ' '
213
-
do
214
-
incr i
215
-
done;
216
-
if !i = len then raise Not_found;
217
-
!i
218
-
in
219
-
let rec split str i =
220
-
match control_character_index str i with
221
-
| j ->
222
-
let img = I.string attr (String.sub str i (j - i)) in
223
-
img :: split str (j + 1)
224
-
| exception Not_found ->
225
-
[ I.string attr (if i = 0 then str else String.sub str i (String.length str - i)) ]
226
-
in
227
-
I.vcat (split str 0)
228
-
;;
229
-
230
-
(* let colored_string s =
231
-
s |> parse_ansi_escape_codes
232
-
|> List.map (fun (x, str) -> escaped_string ~attr:x str)
233
-
|> I.vcat *)
234
-
let colored_string ?extra_attr s = s |> string_to_image ?extra_attr |> Result.get_ok
188
+
(** Same as ansi_string_to_image, but can throw if a parsing error occurs. I have not seen it fail, should be safe. *)
189
+
let colored_string ?extra_attr s = s |> ansi_string_to_image ?extra_attr |> Result.get_ok
+2
-1
jj_tui/lib/util.ml
+2
-1
jj_tui/lib/util.ml
···
28
28
state_to_verbose_result final_parser_state
29
29
;;
30
30
31
+
Base.List.intersperse
31
32
let ( <-$ ) f v = Lwd.map ~f (Lwd.get v)
32
33
let ( $-> ) v f = Lwd.map ~f (Lwd.get v)
33
34
let ( let$$ ) v f = Lwd.map ~f (Lwd.get v)
34
35
let ( |>$ ) v f = Lwd.map ~f v
35
-
let ( |>$$ ) v2 v f = Lwd.map2 ~f v v2
36
36
let ( >> ) f g x = g (f x)
37
37
let ( << ) f g x = f (g x)
38
+
let ( |>$$ ) v2 v f = Lwd.map2 ~f v v2