+ config parser

default.config

@@ -6,4 +6,7 @@ fractional_input_digits = 2
 fractional_normal_digits =2
 fractional_trailing_zero_digits= 2
 alt_unit_names = "{"0":"€","3":"k€"}"
- # comment
+# comment 1
+  # comment 2
+  % comment 3
+% comment 4

include/parse_config.ml

@@ -39,7 +39,17 @@ let read_file file = In_channel.with_open_bin file In_channel.input_all
 
 open Angstrom
 
-(* --- Utilities --- *)
+type item = {
+  key: string;
+  value: string;
+}
+
+type section = {
+  name: string;
+  items: item list;
+}
+
+type config = section list
 
 let is_whitespace = function ' ' | '\t' -> true | _ -> false
 let whitespace = skip_while is_whitespace
@@ -53,18 +63,20 @@ let comment =
 
 let skip_ignored = skip_many (choice [ comment; blank_line ])
 
-(* --- Identifiers --- *)
+let identifier =
-
+  let ident_char = function
-let ident_char = function
     | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true
     | _ -> false
-
+  in
-let identifier = take_while1 ident_char >>| String.lowercase_ascii
+  take_while1 ident_char >>| String.lowercase_ascii
 
 (* --- Values --- *)
 
-(*
+let value =
-let quoted_value =
+  let unquoted_value =
+    take_while1 (fun c -> not (is_whitespace c || is_eol c))
+  in
+  let quoted_value =
     char '"' *> take_till is_eol >>= fun line_rest ->
     match String.rindex_opt line_rest '"' with
     | None -> fail "unterminated quoted value"
@@ -74,79 +86,52 @@ let quoted_value =
         let len = String.length line_rest in
         let remaining_len = len - i - 1 in
         advance (len - remaining_len) *> return value
-      *)
+  in
+  whitespace *> (quoted_value <|> unquoted_value) <* skip_ignored
 
-let unquoted_value = take_while1 (fun c -> not (is_whitespace c || is_eol c))
+let item =
-
-let value =
-  whitespace
-  *>
-  (*quoted_value <|> *)
-  unquoted_value
-  <* skip_ignored
-
-(* --- Option line --- *)
-
-type option_entry = {
-  key: string;
-  value: string;
-}
-
-let option_line =
   lift2
     (fun key value -> { key; value })
     (identifier <* whitespace <* char '=')
     value
 
-(* --- Section --- *)
-
-type section = {
-  name: string;
-  options: option_entry list;
-}
-
 let section_header = char '[' *> identifier <* char ']'
 
-let section_parser =
+let section =
   lift2
-    (fun name options -> { name; options })
+    (fun name items -> { name; items })
     (section_header <* skip_ignored)
-    (many (option_line <* skip_ignored))
+    (many (item <* skip_ignored))
 
-(* --- Whole config file --- *)
+let config : config Angstrom.t =
-
+  skip_ignored *> many section <* skip_ignored <* end_of_input
-type config = section list
-
-let config_parser : config Angstrom.t =
-  skip_ignored *> many section_parser <* skip_ignored <* end_of_input
 
 let parse_config s =
-  match parse_string ~consume:Consume.All config_parser s with
+  match parse_string ~consume:Consume.All config s with
   | Ok v -> v
   | Error msg -> failwith msg
 
-(* --- Pretty printer --- *)
+(* --- pp --- *)
 
-(* Pretty-printer for an option: key = value *)
+let pp_item ppf { key; value } =
-let pp_option ppf (opt : option_entry) =
   let open Fmt in
-  pf ppf "%s = %s" opt.key opt.value
+  pf ppf "%s = %s" key value
 
-(* Pretty-printer for a section *)
 let pp_section ppf (sec : section) =
   let open Fmt in
-  pf ppf "[%s]@\n%a@." sec.name (list ~sep:(any "@\n") pp_option) sec.options
+  pf ppf "[%s]@\n%a@." sec.name (list ~sep:(any "@\n") pp_item) sec.items
 
-(* Pretty-printer for the entire config *)
 let pp_config ppf (cfg : config) =
   let open Fmt in
   pf ppf "%a@." (list ~sep:(any "@\n") pp_section) cfg
 
+(* --- --- *)
+
 let () =
   let content = read_file "default.config" in
-  (*Fmt.pr "%s@." content;*)
 
   let config = parse_config content in
 
   Fmt.pr "%a" pp_config config;
+
   ()