tools/gen_signatures_registry.ml

@@ -1,55 +1,55 @@
-(* rudimentary recfile parser
-   https://www.gnu.org/software/recutils/manual/recutils.html#The-Rec-Format *)
-open Angstrom
+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 field = {
+    k: string;
+    v: string;
+  }
 
-type record = field list
+  type record = field list
 
-let newline = char '\n'
-let is_newline = function '\n' -> true | _ -> false
+  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)
+  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
+  (* 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 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 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 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 recfile : record list t =
+    skip_many (comment <|> blank) *> records <* skip_many (comment <|> blank)
 
-let parse s = parse_string ~consume:All recfile s
-
-(* -- *)
+  let parse s = parse_string ~consume:All recfile s
+end
 
 let url =
   "https://git-www.gnunet.org/gana.git/plain/gnunet-signatures/registry.rec"
@@ -78,6 +78,7 @@ let parse_purposes records =
   |> List.filter_map (fun l ->
       match l with
       | a :: b :: c :: _ -> (
+          let open Recfile in
           match a.k = "Number" && b.k = "Name" && c.k = "Comment" with
           | false -> None
           | true ->
@@ -93,7 +94,7 @@ let parse_purposes records =
 let () =
   download ();
   let content = read_file registry_file in
-  match parse content with
+  match Recfile.parse content with
   | Error msg -> Fmt.failwith "Recfile parse error: %s" msg
   | Ok records ->
       let purposes = parse_purposes records in