121 lines
3.3 KiB
OCaml
121 lines
3.3 KiB
OCaml
open Angstrom
|
|
open Types
|
|
|
|
let is_digit = function '0' .. '9' -> true | _ -> false
|
|
let digit = take_while is_digit >>| int_of_string
|
|
let is_semi c = c == ';'
|
|
let skip_semi = skip is_semi
|
|
let ansi_escape = string "\x1b["
|
|
let ansi_values = sep_by skip_semi digit
|
|
|
|
let ansi_sgr =
|
|
let valid =
|
|
[
|
|
'm';
|
|
'A';
|
|
'B';
|
|
'C';
|
|
'D';
|
|
'E';
|
|
'F';
|
|
'G';
|
|
'H';
|
|
'J';
|
|
'K';
|
|
'S';
|
|
'T';
|
|
'F';
|
|
'i';
|
|
'n';
|
|
's';
|
|
'u';
|
|
'h';
|
|
'l';
|
|
]
|
|
in
|
|
peek_char >>= function
|
|
| Some c ->
|
|
if List.mem c valid then advance 1 *> return (Some c) else return None
|
|
| None -> return None
|
|
|
|
let capture_ansi = both ansi_values ansi_sgr
|
|
|
|
let ansi_parse =
|
|
ansi_escape *> capture_ansi
|
|
|
|
let%test "ansi_parse" =
|
|
parse_string ~consume:Angstrom.Consume.Prefix ansi_parse "\x1b[35;23;12m"
|
|
|> function
|
|
| Ok (d, t) -> d = [ 35; 23; 12 ] && t = Some 'm'
|
|
| _ -> false
|
|
|
|
type parser_state_colour = ParsingFg | ParsingBg
|
|
|
|
type parser_state =
|
|
| ParsingRgb of int list * parser_state_colour
|
|
| ParsingSimple of parser_state_colour
|
|
| ParsingColour of parser_state_colour
|
|
| Done
|
|
|
|
let parse_ansi_codes =
|
|
let regular code parsed =
|
|
match code with
|
|
| 0 -> (Done, parsed @ [ Reset ])
|
|
| n when n >= 30 && n <= 37 ->
|
|
(Done, parsed @ [ Fg (Intrinsic (code - 30)) ])
|
|
| 38 -> (ParsingColour ParsingFg, parsed)
|
|
| n when n >= 40 && n <= 47 ->
|
|
(Done, parsed @ [ Bg (Intrinsic (code - 40)) ])
|
|
| 48 -> (ParsingColour ParsingBg, parsed)
|
|
| _ -> (Done, parsed @ [ Other code ])
|
|
in
|
|
let waste_state p =
|
|
Other (match p with ParsingFg -> 38 | ParsingBg -> 48)
|
|
in
|
|
let colour code parsed t =
|
|
match code with
|
|
| 5 -> (ParsingRgb ([], t), parsed)
|
|
| 2 -> (ParsingSimple t, parsed)
|
|
| n -> (Done, parsed @ [ waste_state t; Other n ])
|
|
(* malformed, just reproduce it *)
|
|
in
|
|
let wrap a t = match t with ParsingBg -> Bg a | ParsingFg -> Fg a in
|
|
let rgb code parsed (triple : int list) t : parser_state * ansi_gfx list =
|
|
match List.length triple with
|
|
| 2 ->
|
|
let r, g = match triple with [ r; g ] -> (r, g) | _ -> (0, 0) in
|
|
(Done, parsed @ [ wrap (RGB (r, g, code)) t ])
|
|
| _ -> (ParsingRgb (triple @ [ code ], t), parsed)
|
|
in
|
|
fun ((parsing : parser_state), (parsed : ansi_gfx list)) (code : int) :
|
|
(parser_state * ansi_gfx list) ->
|
|
match parsing with
|
|
| Done -> regular code parsed
|
|
| ParsingColour t -> colour code parsed t
|
|
| ParsingRgb (triple, t) -> rgb code parsed triple t
|
|
| ParsingSimple t -> (Done, parsed @ [ wrap (Simple code) t ])
|
|
|
|
let parse_ansi_intermediate (codes, terminator) : chunk =
|
|
let (_state, final) : parser_state * ansi_gfx list =
|
|
match terminator with
|
|
| Some 'm' -> List.fold_left parse_ansi_codes (Done, []) codes
|
|
| _ -> (Done, List.map (fun i -> Other i) codes)
|
|
in
|
|
Ansi final
|
|
|
|
let%test "ansi_intermediate_parse" =
|
|
let result =
|
|
parse_ansi_intermediate ([ 38; 5; 25; 24; 23; 1; 0 ], Some 'm')
|
|
in
|
|
result = Ansi [ Fg (RGB (25, 24, 23)); Other 1; Reset ]
|
|
|
|
let%test "ansi_full" =
|
|
let final =
|
|
parse_string ~consume:Angstrom.Consume.Prefix ansi_parse
|
|
"\x1b[38;5;25;24;23;1;0m"
|
|
|> function
|
|
| Ok (raw, term) -> parse_ansi_intermediate (raw, term)
|
|
| Error e -> failwith ("parsing failed: " ^ e)
|
|
in
|
|
final = Ansi [ Fg (RGB (25, 24, 23)); Other 1; Reset ]
|