implement CULRS and CULR_ORDER env vars

bin/main.ml

@@ -1,5 +1,17 @@
-open! Culr
+open Culr
 
+let to_sixteen = Seq.ints 0 |> Seq.take 16 |> Array.of_seq
 
+let colours =
+  let init_default =
+    to_sixteen |> Array.map (fun x -> Types.Simple x)
+  in
+  Sys.getenv_opt "CULRS"
+  |> Option.fold ~none:init_default ~some:Parse.parse_env_colours
 
-let () = Culr.Pipes.read_all ()
+let order =
+  let init_default = to_sixteen in
+  Sys.getenv_opt "CULR_ORDER"
+  |> Option.fold ~none:init_default ~some:Parse.parse_env_order
+
+let () = Pipes.read_all colours order

lib/parse.ml

@@ -1,6 +1,6 @@
-(* open Ansi *)
 open Types
 open Angstrom
+open Parsers
 
 let is_sep = function '\x20' | '\x09' -> true | _ -> false
 let is_delim = function '\x0a' | '\x0d' -> true | _ -> false
@@ -17,6 +17,25 @@ let culr_parse =
   | n when n = '\x1b' -> ansi
   | _n -> text
 
+let conv_rgb = function [ r; g; b ] -> Types.RGB (r, g, b) | _ -> assert false
+let hex_digit = take 2 >>| fun s -> int_of_string ("0x" ^ s)
+
+let rgb_triple =
+  let digit_comma = digit <* char ',' in
+  char '(' *> list [ digit_comma; digit_comma; digit ] <* char ')' >>| conv_rgb
+
+let hex_colour = char '#' *> count 3 hex_digit >>| conv_rgb
+let simple_colour = digit >>| fun s -> Types.Simple s
+let env_colours = sep_by1 skip_semi (rgb_triple <|> hex_colour <|> simple_colour)
+let unpack = function Ok payload -> payload | _ -> []
+
+let parse_env_colours s =
+  parse_string ~consume:Consume.All env_colours s |> unpack |> Array.of_list
+
+let parse_env_order s =
+  parse_string ~consume:Consume.All Parsers.semi_digits s
+  |> unpack |> Array.of_list
+
 let debug_print =
   let print_colour =
     List.fold_left
@@ -51,22 +70,22 @@ let debug_print =
   | Ansi a -> print_colour a
 
 let%test "sep_parse" =
-  Angstrom.parse_string ~consume:Consume.All sep "        " |> function
+  parse_string ~consume:Consume.All sep "        " |> function
   | Ok (Separator "        ") -> true
   | _ -> false
 
 let%test "delim_parse" =
-  Angstrom.parse_string ~consume:Consume.All delim "\n\n\n" |> function
+  parse_string ~consume:Consume.All delim "\n\n\n" |> function
   | Ok (Delimiter "\n\n\n") -> true
   | _ -> false
 
 let%test "text_parse" =
-  Angstrom.parse_string ~consume:Consume.All text "okokyeahok" |> function
+  parse_string ~consume:Consume.All text "okokyeahok" |> function
   | Ok (Text "okokyeahok") -> true
   | _ -> false
 
 let%test "culr_parse" =
-  Angstrom.parse_string ~consume:Consume.Prefix (many1 culr_parse)
+  parse_string ~consume:Consume.All (many1 culr_parse)
     "sometext   \n\n\n    \x1b[38;2;2m"
   |> function
   | Ok
@@ -82,3 +101,13 @@ let%test "culr_parse" =
       n |> List.fold_left (fun _acc el -> el |> debug_print) ();
       false
   | _ -> false
+
+let%test "rgb" =
+  parse_string ~consume:Consume.All rgb_triple "(255,0,127)" |> function
+  | Ok s -> s = Types.RGB (255, 0, 127)
+  | _ -> false
+
+let%test "hex" =
+  parse_string ~consume:Consume.All hex_colour "#FF007F" |> function
+  | Ok s -> s = Types.RGB (255, 0, 127)
+  | _ -> false

lib/pipes.ml

@@ -1,21 +1,13 @@
-let read_all () =
+open Processing
+
+let read_all colours order =
   In_channel.set_binary_mode stdin true;
   let open Types in
-  let t = Emitter.create 
-  and culr =
-    Processing.Culriser.create ~s:[| 0; 2; 1; 3; 4 |]
-      ~f:[ (function RGB (r, g, _) -> (g > 0 || r = 255) | _ -> true) ]
-      [| Simple 0; Simple 1; Simple 2; RGB (255, 0, 127); RGB (0, 200, 0) |]
-  in
-  Emitter.serialise t (Ansi [ Fg (Processing.Culriser.next culr) ]);
+  let t = Emitter.create and culr = Culriser.create order [] colours in
+  Emitter.serialise t (Ansi [ Fg (Culriser.next culr) ]);
   Angstrom_unix.parse_many ~buf_size:4096 Parse.culr_parse
-    (fun c ->
-      c |> Processing.ansi_filter
-      |> Processing.Culriser.add_colour culr t
-      |> Emitter.serialise t)
+    (fun c -> c |> ansi_filter |> Culriser.serialise_with_colour culr t)
     stdin
   |> function
-  | _, 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) ); *)
+  | _, Ok _ -> Emitter.flush t
   | _ -> ()