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))

tools/gen_taler_signatures.ml

@@ -1,55 +1,8 @@
-module Recfile = struct
+type purpose = {
-  (* rudimentary recfile parser
+  number: int32;
-     https://www.gnu.org/software/recutils/manual/recutils.html#The-Rec-Format *)
+  name: string;
-  open Angstrom
+  comment: string;
-
+}
-  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
 
 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
+  match Recfile_parser.parse content with
-  | Error msg -> Fmt.failwith "Recfile parse error: %s" msg
+  | Error msg -> Fmt.failwith "Recfile_parser parse error: %s" msg
   | Ok records -> print_module (parse_purposes records)
 
 let () = main ()

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