diff --git a/tools/dune b/tools/dune index 80d17dd6..7e06a8ea 100644 --- a/tools/dune +++ b/tools/dune @@ -8,4 +8,9 @@ (public_name gen_taler_signatures) (name gen_taler_signatures) (modules gen_taler_signatures) + (libraries recfile_parser bos fmt)) + +(library + (name recfile_parser) + (modules recfile_parser) (libraries angstrom bos fmt)) diff --git a/tools/gen_taler_signatures.ml b/tools/gen_taler_signatures.ml index 38bc7e80..1b98526a 100644 --- a/tools/gen_taler_signatures.ml +++ b/tools/gen_taler_signatures.ml @@ -1,55 +1,8 @@ -module Recfile = struct - (* 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 -end +type purpose = { + number: int32; + name: string; + comment: string; +} let download ~output ~url = let open Bos in @@ -69,18 +22,12 @@ let download ~output ~url = | Error (`Msg s) -> Fmt.failwith "download failure: %s" s | Ok () -> () -type purpose = { - number: int32; - name: string; - comment: string; -} - let parse_purposes records = records |> List.filter_map (fun l -> match l with | a :: b :: c :: _ -> ( - let open Recfile in + let open Recfile_parser in match a.k = "Number" && b.k = "Name" && c.k = "Comment" with | false -> None | true -> @@ -113,8 +60,8 @@ let main () = let tmp_file = Bos.OS.File.tmp "registry.rec.%s" |> Result.get_ok in download ~output:(Fpath.to_string tmp_file) ~url; let content = Bos.OS.File.read tmp_file |> Result.get_ok in - match Recfile.parse content with - | Error msg -> Fmt.failwith "Recfile parse error: %s" msg + match Recfile_parser.parse content with + | Error msg -> Fmt.failwith "Recfile_parser parse error: %s" msg | Ok records -> print_module (parse_purposes records) let () = main () diff --git a/tools/recfile_parser.ml b/tools/recfile_parser.ml new file mode 100644 index 00000000..44828eae --- /dev/null +++ b/tools/recfile_parser.ml @@ -0,0 +1,51 @@ +(* 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