wip parse from gana

tools/gen_signatures_registry.ml

@@ -0,0 +1,94 @@
+(* rudimentary recfile parser
+   https://www.gnu.org/software/recutils/manual/recutils.html#The-Rec-Format *)
+open Angstrom
+
+type field = {
+  k: string;
+  v: string;
+}
+
+type record = field list
+
+let newline = char '\n'
+let is_newline = function '\n' -> true | _ -> false
+
+let field_name =
+  let first_char =
+    satisfy (function 'a' .. 'z' | 'A' .. 'Z' | '%' -> true | _ -> false)
+  in
+  let subsequent_char =
+    satisfy (function
+      | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> true
+      | _ -> false)
+  in
+  lift2
+    (fun hd tl -> String.of_seq (List.to_seq (hd :: tl)))
+    first_char (many subsequent_char)
+
+(* todo handle '\' escape and '+' on next line *)
+let field_value = take_till is_newline <* newline
+
+let field =
+  let blank = satisfy (function ' ' | '\t' -> true | _ -> false) in
+  let blanks = skip_many1 blank in
+  lift3 (fun k () v -> { k; v }) field_name (char ':' *> blanks) field_value
+
+let blank = newline *> return ()
+let comment = (char '#' *> take_till is_newline <* newline) *> return ()
+let record = many1 field
+
+let records =
+  let sep =
+    (* at least one blank line *)
+    skip_many comment *> blank *> skip_many (comment <|> blank)
+  in
+  sep_by1 sep record
+
+let recfile : record list t =
+  skip_many (comment <|> blank) *> records <* skip_many (comment <|> blank)
+
+let parse s = parse_string ~consume:All recfile s
+
+(* -- *)
+
+type purpose = {
+  number: int32;
+  name: string;
+  comment: string;
+}
+
+let f records =
+  records
+  |> List.filter_map (fun l ->
+      match l with
+      | a :: b :: c :: _ -> (
+          match a.k = "Number" && b.k = "Name" && c.k = "Comment" with
+          | false -> None
+          | true ->
+              Some
+                {
+                  number= Int32.of_int (int_of_string a.v);
+                  name= b.v;
+                  comment= c.v;
+                })
+      | _ -> None)
+  |>
+  (*GNU Taler, >= 1000*)
+  List.filter (fun v -> v.number >= 1000_l)
+
+let read_file file = In_channel.with_open_bin file In_channel.input_all
+let file_header = {|...|}
+
+let () =
+  let content = read_file "registry.rec" in
+  match parse content with
+  | Error msg -> Fmt.failwith "Parse error: %s" msg
+  | Ok records ->
+      let purposes = f records in
+
+      let pp_purpose ppf { number; name; comment } =
+        Fmt.pf ppf "(** %s *)\nlet %s : int32 = %ld\n\n" comment name number
+      in
+
+      Fmt.pr "%a@." (Fmt.list ~sep:Fmt.nop pp_purpose) purposes;
+      ()