diff --git a/lib/emit.ml b/lib/emit.ml deleted file mode 100644 index 29c89a2..0000000 --- a/lib/emit.ml +++ /dev/null @@ -1 +0,0 @@ -open! Faraday diff --git a/lib/emitter.ml b/lib/emitter.ml new file mode 100644 index 0000000..cd7369c --- /dev/null +++ b/lib/emitter.ml @@ -0,0 +1,59 @@ +open Types + +type serialiser = { buf : string ref; sz : int; pos : int ref } + +let write_ansi a = + let rec intersperse sep ls = + match ls with + | [] | [ _ ] -> ls + | hd :: tl -> hd :: sep :: intersperse sep tl + and string_of_colour ?(bg = false) c = + let prefix = if bg then "4" else "3" and si = string_of_int in + c |> function + | Intrinsic i -> prefix ^ si i + | Simple i -> prefix ^ "8;5;" ^ si i + | RGB (r, g, b) -> prefix ^ "8;2;" ^ si r ^ ";" ^ si g ^ ";" ^ si b + in + let ansi = + a + |> List.map (fun a -> + match a with + | Fg c -> string_of_colour c + | Bg c -> string_of_colour ~bg:true c + | Reset -> "0" + | Other i -> string_of_int i) + |> intersperse ";" + |> List.fold_left (fun acc el -> acc ^ el) "" + in + "\x1b[" ^ ansi ^ "m" + +let flush t = + if t.pos.contents > 0 then ( + print_string (String.sub t.buf.contents 0 t.pos.contents); + t.pos.contents <- 0) + +let serialise t chunk = + let input = + match chunk with + | Text s -> s + | Separator s -> s + | Delimiter s -> s + | Ansi a -> write_ansi a + in + let input_sz = String.length input in + if t.pos.contents + input_sz > t.sz then flush t; + if input_sz > t.sz then print_string input + else + t.buf.contents <- + (if t.pos.contents > 0 then String.sub t.buf.contents 0 t.pos.contents + else "") + ^ input; + t.pos.contents <- t.pos.contents + input_sz + +let create = { buf = ref String.empty; sz = 4096; pos = ref 0 } + +let print_debug t = + print_endline + ("pos is " + ^ string_of_int t.pos.contents + ^ "\nsz is " ^ string_of_int t.sz ^ "\ncontents are: " ^ t.buf.contents) diff --git a/lib/emitter.mli b/lib/emitter.mli new file mode 100644 index 0000000..b11770d --- /dev/null +++ b/lib/emitter.mli @@ -0,0 +1,5 @@ +type serialiser = { buf : string ref; sz : int; pos : int ref; } +val flush : serialiser -> unit +val serialise : serialiser -> Types.chunk -> unit +val create : serialiser +val print_debug : serialiser -> unit diff --git a/lib/parse.mli b/lib/parse.mli new file mode 100644 index 0000000..9500a71 --- /dev/null +++ b/lib/parse.mli @@ -0,0 +1,2 @@ +val culr_parse : Types.chunk Angstrom.t +val debug_print : Types.chunk -> unit diff --git a/lib/pipes.ml b/lib/pipes.ml index 22bcfbe..ca3c378 100644 --- a/lib/pipes.ml +++ b/lib/pipes.ml @@ -1,89 +1,15 @@ -open Angstrom.Buffered -open Parse - -let print_buf buf = print_endline ("buffer has " ^ Bigstringaf.to_string buf) - -(* let read_all () = - let parser = Angstrom.Unbuffered.parse culr_parse - and buf = Bigstringaf.create 4096 in - In_channel.set_binary_mode stdin true; - print_endline "doing it"; - let rec loop parser = - parser |> function - (* START CONDITION *) - | Partial { committed = 0; continue } -> ( - match In_channel.input_bigarray stdin buf 0 4096 with - | 0 -> - print_endline "got 0 end"; - raise End_of_file - | _ -> - print_buf buf; - print_endline "got partial 0"; - loop (continue buf ~off:0 ~len:4096 Incomplete) (* CONTINUE *)) - | Partial { continue; _ } -> ( - match In_channel.input_bigarray stdin buf 0 4096 with - | 0 -> - print_endline "got + end"; - raise End_of_file - | _ -> - print_buf buf; - print_endline "got partial +"; - loop (continue buf ~off:0 ~len:4096 Incomplete)) - | Done (_, _) -> - print_endline "got done"; - raise End_of_file - | Fail (_, _, _) -> print_endline "got fail" - in - try loop parser - with End_of_file -> ( - print_endline "eof"; - parser |> state_to_option |> function - | Some chunks -> - print_endline "chunks:"; - List.iter (fun x -> debug_print x) chunks - | None -> - print_endline "no chunks"; - ()) *) - -(* let read_all_3 () = - let parser = parse ~initial_buffer_size:4096 culr_parse - and buf = Bigstringaf.create 4096 in - In_channel.set_binary_mode stdin true; - print_endline "doing it"; - let rec loop parser = - Bigarray.Array1.fill buf '\x00'; - match In_channel.input_bigarray stdin buf 0 4096 with - | 0 -> ( - print_endline "got eof"; - parser - |> (function Partial cont -> cont `Eof | _ -> parser) - |> state_to_option - |> function - | Some chunks -> List.iter debug_print chunks - | None -> print_endline "nothing") - | _ -> ( - print_endline "got buf:"; - print_buf buf; - parser |> function - | Partial cont -> loop (cont (`Bigstring buf)) - | Done (_, chunks) -> - print_endline "got done"; - List.iter debug_print chunks - | Fail (_, _, _) -> print_endline "got fail") - in - loop parser *) - -(* let rec loop state = - state |> function - | Partial {committed; continue} -> continue - | Done(_,_) -> () - | Fail (_,_,_) -> () *) - let read_all () = In_channel.set_binary_mode stdin true; - Angstrom_unix.parse_many ~buf_size:4096 culr_parse (fun c -> debug_print c) In_channel.stdin + let t = Emitter.create + and culr = Processing.Culriser.create [ Simple 4; Simple 1 ] in + Angstrom_unix.parse_many ~buf_size:4096 Parse.culr_parse + (fun c -> + c |> Processing.ansi_filter + |> Processing.Culriser.add_colour culr + |> List.iter (Emitter.serialise t)) + stdin |> function - | unparsed, Ok _ -> - print_endline ("didn't parse this much: " ^ string_of_int unparsed.len ^ "\nunparsed:\n" ^ (Bigstringaf.substring unparsed.buf ~off:unparsed.off ~len:unparsed.len) ); - () + | _, Ok _ -> + Emitter.flush t + (* print_endline ("didn't parse this much: " ^ string_of_int unparsed.len ^ "\nunparsed:\n" ^ (Bigstringaf.substring unparsed.buf ~off:unparsed.off ~len:unparsed.len) ); *) | _ -> () diff --git a/lib/pipes.mli b/lib/pipes.mli new file mode 100644 index 0000000..3a0b8ba --- /dev/null +++ b/lib/pipes.mli @@ -0,0 +1 @@ +val read_all : unit -> unit diff --git a/lib/processing.ml b/lib/processing.ml new file mode 100644 index 0000000..a7622b2 --- /dev/null +++ b/lib/processing.ml @@ -0,0 +1,59 @@ +open Types + +let ansi_filter s = + s |> function + | Ansi a -> + Types.Ansi + (List.filter + (function Types.Fg _ | Types.Bg _ -> false | _ -> true) + a) + | n -> n + +let permute order a = Array.mapi (fun i _ -> a.(order.(i))) a + +(* TODO: implement this so cli can use a dsl to specify colourising patterns *) +type culr = { + colours : colour array; + sz : int; + mutable current : int; + mutable first : bool; +} + +module Culriser = struct + type filter = (colour -> bool) list + type sort = int array + + let run_filters f el = + List.fold_left (fun res filt -> if not (filt el) then false else res) true f + + let create ?(s = [| 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15 |]) + ?(f = []) c = + let colours = + c + |> List.fold_left + (fun acc el -> if run_filters f el then acc @ [ el ] else acc) + [] + |> Array.of_list |> permute s + in + { colours; sz = Array.length colours; current = 0; first = true } + + let next t = + let nv = t.current + 1 in + if nv >= t.sz then t.current <- 0 else t.current <- nv; + t.colours.(t.current) + + let reset t = t.current <- 0 + + let add_colour t chunk = + if t.first then ( + t.first <- false; + Ansi [ Fg (next t) ] :: [ chunk ]) + else + match chunk with + | Separator _ -> chunk :: [ Ansi [ Fg (next t) ] ] + | Delimiter _ -> + reset t; + chunk :: [ Ansi [ Fg (next t) ] ] + | Ansi _ -> [ chunk ] + | Text _ -> [ chunk ] +end diff --git a/lib/types.ml b/lib/types.ml index cec2fdd..e35cf40 100644 --- a/lib/types.ml +++ b/lib/types.ml @@ -1,4 +1,3 @@ - type colour = | Intrinsic of int (* _0-_7 *) | Simple of int (* _8;5;n *) diff --git a/lib/types.mli b/lib/types.mli new file mode 100644 index 0000000..e35cf40 --- /dev/null +++ b/lib/types.mli @@ -0,0 +1,12 @@ +type colour = + | Intrinsic of int (* _0-_7 *) + | Simple of int (* _8;5;n *) + | RGB of int * int * int (* _8;2;r;g;b *) + +type ansi_gfx = Bg of colour | Fg of colour | Reset | Other of int + +type chunk = + | Text of string + | Separator of string + | Delimiter of string + | Ansi of ansi_gfx list