mte/tools/gen_signatures_registry.ml
2026-02-08 06:10:11 +01:00

96 lines
2.4 KiB
OCaml

open Angstrom
(* rudimentary recfile parser
https://www.gnu.org/software/recutils/manual/recutils.html#The-Rec-Format
field
record
comments
record descriptors
*)
type field = {
k: string;
v: string;
}
type record = field list
let newline = char '\n'
let is_newline = function '\n' -> true | _ -> false
let blank = satisfy (function ' ' | '\t' -> true | _ -> false)
let blanks = skip_many1 blank
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 =
lift3 (fun k () v -> { k; v }) field_name (char ':' *> blanks) field_value
let comments = many (char '#' *> take_till is_newline <* newline)
let line_sep = comments <* newline
let record = sep_by1 line_sep field
let recfile : record list t = many line_sep *> many record <* many line_sep
let parse s = parse_string ~consume:All recfile s
let () =
let example = {|
foo: bar
bar: foo
%foo: oof
|} in
match parse_string ~consume:All recfile example with
| Error msg -> prerr_endline ("Parse error: " ^ msg)
| Ok records ->
List.iter
(fun record ->
List.iter (fun { k; v } -> Printf.printf "%s := %s\n" k v) record)
records
type purpose = {
number: int;
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= int_of_string a.v; name= b.v; comment= c.v })
| _ -> None)
|>
(*GNU Taler, >= 1000*)
List.filter (fun v -> v.number >= 1000)
let read_file file = In_channel.with_open_bin file In_channel.input_all
let () =
let content = read_file "registry.rec" in
Fmt.pr "%s@." content;
match parse content with
| Error msg -> Fmt.failwith "Parse error: %s" msg
| Ok l ->
let l = f l in
let pp_purpose ppf { number; name; comment } =
Fmt.pf ppf "(** %s *)\nlet %s : int32 = %d@." comment name number
in
Fmt.pr "%a@." (Fmt.list ~sep:Fmt.nop pp_purpose) l;
()