module Signature_code = struct type t = { number: int32; name: string; comment: string; } end module Error_code = struct type t = { value: int; name: string; description: string; http_status: int; } end let parse_signature_codes records = records |> List.filter_map (fun l -> match l with | a :: b :: c :: _ -> ( let open Recfile_parser in match a.k = "Number" && b.k = "Name" && c.k = "Comment" with | false -> None | true -> Some Signature_code. { number= Int32.of_int (int_of_string a.v); name= String.lowercase_ascii b.v; comment= c.v; }) | _ -> None) |> List.filter (fun v -> v.Signature_code.number >= 1000_l) let parse_error_codes records = records |> List.filter_map (fun l -> match l with | a :: b :: c :: d :: _ -> ( let open Recfile_parser in match a.k = "Value" && b.k = "Name" && c.k = "Description" && d.k = "HttpStatus" with | false -> None | true -> Some Error_code. { value= int_of_string a.v; name= b.v; description= c.v; http_status= int_of_string d.v; }) | _ -> None) let pp_taler_signatures_ml ppf purposes = let header = {|(* This file was generated from the GANA database: https://git-www.gnunet.org/gana.git/tree/gnunet-signatures/registry.rec *)|} in let pp ppf Signature_code.{ number; name; comment } = Fmt.pf ppf "(** %s *)\nlet %s : int32 = %ld_l\n\n" comment name number in Fmt.pf ppf "%s\n\n%a@." header (Fmt.list ~sep:Fmt.nop pp) purposes; () let pp_taler_error_codes_ml ppf purposes = let header = {|(* This file was generated from the GANA database: https://git-www.gnunet.org/gana.git/tree/gnunet-error-codes/registry.rec https://git-www.gnunet.org/gana.git/tree/gnu-taler-error-codes/registry.rec *)|} in Fmt.pf ppf "\n\n\ type t ={ value: int; name: string; description: string; http_status: int \ }\n\n"; let pp ppf Error_code.{ value; name; description; http_status } = Fmt.pf ppf {|let %s = { value = %d; name = "%s"; description = "%s"; http_status = %d }\n\n|} (String.lowercase_ascii name) value name description http_status in Fmt.pf ppf "%s\n\n%a@." header (Fmt.list ~sep:Fmt.nop pp) purposes; () let download ~tmp ~url = let open Bos in let res = OS.Cmd.run Cmd.( v "curl" % "--silent" % "--show-error" % "-o" % tmp % "-X" % "GET" % url) in match res with | Error (`Msg s) -> Fmt.failwith "download failure: %s" s | Ok () -> () (* --- *) let signatures ~output = let url = "https://git-www.gnunet.org/gana.git/plain/gnunet-signatures/registry.rec" in let tmp_file = Bos.OS.File.tmp "registry.rec.%s" |> Result.get_ok in download ~tmp:(Fpath.to_string tmp_file) ~url; let content = Bos.OS.File.read tmp_file |> Result.get_ok in match Recfile_parser.parse content with | Error msg -> Fmt.failwith "Recfile_parser parse error: %s" msg | Ok records -> let purposes = parse_signature_codes records in let module_content = Fmt.str "%a" pp_taler_signatures_ml purposes in Bos.OS.File.write (Fpath.v output) module_content |> Result.get_ok let error_codes ~output = let f url = let tmp_file = Bos.OS.File.tmp "registry.rec.%s" |> Result.get_ok in download ~tmp:(Fpath.to_string tmp_file) ~url; let content = Bos.OS.File.read tmp_file |> Result.get_ok in match Recfile_parser.parse content with | Error msg -> Fmt.failwith "Recfile_parser parse error: %s" msg | Ok records -> parse_error_codes records in let url_1 = "https://git-www.gnunet.org/gana.git/plain/gnunet-error-codes/registry.rec" in let url_2 = "https://git-www.gnunet.org/gana.git/plain/gnu-taler-error-codes/registry.rec" in let error_codes = f url_1 @ f url_2 in let module_content = Fmt.str "%a" pp_taler_error_codes_ml error_codes in Bos.OS.File.write (Fpath.v output) module_content |> Result.get_ok (* --- *) open Cmdliner open Cmdliner.Term.Syntax let output = let doc = "output file" in Arg.(required & opt (some filepath) None & info [ "o"; "output" ] ~doc) let signatures_cmd = let doc = "Generate taler_signatures.ml from GANA gnunet-signatures registry" in Cmd.make (Cmd.info "signatures" ~doc) @@ let+ output = output in signatures ~output let error_codes_cmd = let doc = "Generate taler_error_codes.ml from GANA gnunet-error-codes and \ gnunet-taler-error-codes registries" in Cmd.make (Cmd.info "error_codes" ~doc) @@ let+ output = output in error_codes ~output let cli = let info = let doc = "Tool to generate OCaml module from GANA registries" in Cmd.info "gen_registry_files" ~doc in Cmd.group info [ signatures_cmd; error_codes_cmd ] let main () = Cmd.eval cli let () = if !Sys.interactive then () else exit (main ())