open Angstrom open Types open Parsers 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 ]