basic filter, sort, emit

lib/emit.ml

@@ -1 +0,0 @@
-open! Faraday

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)

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

lib/parse.mli

@@ -0,0 +1,2 @@
+val culr_parse : Types.chunk Angstrom.t
+val debug_print : Types.chunk -> unit

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) ); *)
   | _ -> ()

lib/pipes.mli

@@ -0,0 +1 @@
+val read_all : unit -> unit

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

lib/types.ml

@@ -1,4 +1,3 @@
-  
 type colour =
   | Intrinsic of int (* _0-_7 *)
   | Simple of int (* _8;5;n *)

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