remake config parser

default.config

@@ -1,10 +1,17 @@
+# comment 1
+#   foo
+#   barr
 [currency-EUR]
 enabled = NO
+  # comment 2
 code= "EUR"
 name =euro
 fractional_input_digits = 2
 fractional_normal_digits =2
 fractional_trailing_zero_digits= 2
+  % comment 3
 alt_unit_names = "{"0":"€","3":"k€"}"
-# comment 1
-# comment 2
+% comment 4
+
+[dummy-section]
+dummy =   "blah"

include/parse_config.ml

@@ -38,101 +38,119 @@ let duration_value =
 
 let read_file file = In_channel.with_open_bin file In_channel.input_all
 
-open Angstrom
-
 type item = {
   key: string;
   value: string;
 }
 
+type line =
+  | Blank
+  | Comment of string
+  | Header of string
+  | Item of item
+
 type section = {
-  name: string;
+  header: string;
   items: item list;
 }
 
-type config = section list
+open Angstrom
 
+let is_eol = function '\n' | '\r' -> true | _ -> false
 let is_whitespace = function ' ' | '\t' -> true | _ -> false
 let whitespace = skip_while is_whitespace
-let blank_line = whitespace *> end_of_line
-let is_eol = function '\n' | '\r' -> true | _ -> false
 
-let comment =
-  whitespace *> peek_char >>= function
-  | None -> fail "peek_char end_of_file failure"
-  | Some c ->
-      if c = '#' || c = '%' then
-        skip_while (fun c -> not (is_eol c)) *> end_of_line
-      else fail "not a comment"
-
-let skip_ignored = skip_many (choice [ comment; blank_line ])
-
-let identifier =
+let id =
   let ident_char = function
     | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true
     | _ -> false
   in
   take_while1 ident_char >>| String.lowercase_ascii
 
-let value =
+let take_till_end_of_line =
+  take_till is_eol >>= fun s -> return s <* end_of_line
+
+let blank = whitespace <* end_of_line >>| fun () -> Blank
+
+let comment =
+  whitespace *> (char '#' <|> char '%') *> take_till_end_of_line >>| fun s ->
+  Comment s
+
+let header = char '[' *> id <* char ']' <* end_of_line >>| fun s -> Header s
+
+let item_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"
-    | Some i ->
-        let value = String.sub line_rest 0 i in
-        (* consume up to and including the closing quote *)
-        let len = String.length line_rest in
-        let remaining_len = len - i - 1 in
-        advance (len - remaining_len) *> return value
+    char '"' *> take_till is_eol >>= fun s ->
+    match String.ends_with ~suffix:"\"" s with
+    | false -> fail "invalid quoted value"
+    | true ->
+        let value = String.sub s 0 (String.length s - 1) in
+        return value
   in
-  whitespace *> (quoted_value <|> unquoted_value) <* skip_ignored
+  quoted_value <|> unquoted_value
 
 let item =
   lift2
-    (fun key value -> { key; value })
-    (identifier <* whitespace <* char '=')
-    value
+    (fun key value -> Item { key; value })
+    id
+    (whitespace *> char '=' *> whitespace *> item_value)
+  <* end_of_line
 
-let section_header = char '[' *> identifier <* char ']'
+let config = many (choice [ blank; comment; header; item ]) <* end_of_input
 
-let section =
-  lift2
-    (fun name items -> { name; items })
-    (skip_ignored *> section_header)
-    (many (skip_ignored *> item))
+let fold_sections l =
+  let rec loop section_l item_l l =
+    match l with
+    | [] ->
+        if List.is_empty item_l then section_l
+        else Fmt.failwith "invalid config structure"
+    | Blank :: tl | Comment _ :: tl -> loop section_l item_l tl
+    | Item item :: tl -> loop section_l (item :: item_l) tl
+    | Header header :: tl ->
+        let section = { header; items= item_l } in
+        loop (section :: section_l) [] tl
+  in
+  loop [] [] (List.rev l)
 
-let config : config Angstrom.t =
-  many_till (section <* skip_ignored) end_of_input
-
-let parse_config s =
-  match parse_string ~consume:Consume.All config s with
-  | Ok v -> v
-  | Error msg -> failwith msg
+let parse s =
+  match parse_string ~consume:All config s with
+  | Error msg -> Fmt.failwith "config parse error: %s" msg
+  | Ok v -> fold_sections v
 
 let pp_item ppf { key; value } =
   let open Fmt in
-  pf ppf "%s = %s" key value
+  match String.contains value '"' || String.contains value ' ' with
+  | false -> pf ppf "%s = %s" key value
+  | true -> pf ppf "%s = \"%s\"" key value
 
-let pp_section ppf (sec : section) =
+let pp_line ppf line =
   let open Fmt in
-  pf ppf "[%s]@\n%a@." sec.name (list ~sep:(any "@\n") pp_item) sec.items
+  match line with
+  | Blank -> Fmt.nop ppf ()
+  | Comment s -> pf ppf "#%s" s
+  | Header s -> pf ppf "[%s]" s
+  | Item item -> pf ppf "%a" pp_item item
 
-let pp_config ppf (cfg : config) =
+let _pp_lines ppf raw_line_l =
   let open Fmt in
-  pf ppf "%a@." (list ~sep:(any "@\n") pp_section) cfg
+  pf ppf "%a" (list ~sep:(any "\n") pp_line) raw_line_l
 
-(* --- --- *)
+let pp_section ppf { header; items } =
+  let open Fmt in
+  pf ppf "[%s]@\n%a" header (list ~sep:(any "\n") pp_item) items
+
+let pp_config ppf l =
+  let open Fmt in
+  pf ppf "%a" (list ~sep:(any "\n") pp_section) l
 
 let () =
   let content = read_file "default.config" in
   (*Fmt.pr "%s" content;*)
-
-  let config = parse_config content in
-
-  Fmt.pr "%a" pp_config config;
+  let config = parse content in
+  (*Fmt.pr "%a@." pp_lines config;*)
+  Fmt.pr "%a@." pp_config config;
 
   ()