parser, nix, project setup

lib/ansi.ml

@@ -0,0 +1,120 @@
+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 ]

lib/cli.ml

@@ -0,0 +1 @@
+

lib/dune

@@ -0,0 +1,5 @@
+(library
+ (name culr)
+ (libraries angstrom angstrom-unix faraday )
+ (inline_tests)
+ (preprocess (pps ppx_inline_test)))

lib/emit.ml

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

lib/parse.ml

@@ -0,0 +1,84 @@
+(* open Ansi *)
+open Types
+open Angstrom
+
+let is_sep = function '\x20' | '\x09' -> true | _ -> false
+let is_delim = function '\x0a' | '\x0d' -> true | _ -> false
+let is_text c = not (is_sep c || is_delim c || c = '\x1b')
+let sep = take_while is_sep >>| fun s -> Separator s
+let delim = take_while is_delim >>| fun s -> Delimiter s
+let text = take_while is_text >>| fun s -> Text s
+let ansi = Ansi.ansi_parse >>| Ansi.parse_ansi_intermediate
+
+let culr_parse =
+  peek_char_fail >>= function
+  | n when is_sep n -> sep
+  | n when is_delim n -> delim
+  | n when n = '\x1b' -> ansi
+  | _n -> text
+
+let debug_print =
+  let print_colour =
+    List.fold_left
+      (fun _acc el ->
+        match el with
+        | Fg c -> (
+            match c with
+            | Simple n | Intrinsic n ->
+                print_endline ("fg simple/intrinsic " ^ string_of_int n)
+            | RGB (r, g, b) ->
+                print_endline
+                  ("fg rgb: "
+                  ^ List.fold_left
+                      (fun acc el -> acc ^ ", " ^ string_of_int el)
+                      "" [ r; g; b ]))
+        | Bg c -> (
+            match c with
+            | Simple n | Intrinsic n ->
+                print_endline ("bg simple/intrinsic " ^ string_of_int n)
+            | RGB (r, g, b) ->
+                print_endline
+                  ("bg rgb: "
+                  ^ List.fold_left
+                      (fun acc el -> acc ^ ", " ^ string_of_int el)
+                      "" [ r; g; b ]))
+        | Reset -> print_endline "ansi reset"
+        | Other n -> print_endline ("other ansi: " ^ string_of_int n))
+      ()
+  in
+  function
+  | Text s | Separator s | Delimiter s -> print_endline ("parsed '" ^ s ^ "'")
+  | Ansi a -> print_colour a
+
+let%test "sep_parse" =
+  Angstrom.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
+  | Ok (Delimiter "\n\n\n") -> true
+  | _ -> false
+
+let%test "text_parse" =
+  Angstrom.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)
+    "sometext   \n\n\n    \x1b[38;2;2m"
+  |> function
+  | Ok
+      [
+        Text "sometext";
+        Separator "   ";
+        Delimiter "\n\n\n";
+        Separator "    ";
+        Ansi [ Fg (Simple 2) ];
+      ] ->
+      true
+  | Ok n ->
+      n |> List.fold_left (fun _acc el -> el |> debug_print) ();
+      false
+  | _ -> false

lib/pipes.ml

@@ -0,0 +1,89 @@
+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
+  |> 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) );
+      ()
+  | _ -> ()

lib/types.ml

@@ -0,0 +1,13 @@
+  
+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