include/parse_config.ml

@@ -49,6 +49,11 @@ type line =
   | Header of string
   | Item of item
 
+type section = {
+  header: string;
+  items: item list;
+}
+
 open Angstrom
 
 let is_eol = function '\n' | '\r' -> true | _ -> false
@@ -96,32 +101,56 @@ let item =
 
 let config = many (choice [ blank; comment; header; item ]) <* end_of_input
 
+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 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
+  match String.contains value '"' || String.contains value ' ' with
+  | false -> pf ppf "%s = %s" key value
+  | true -> pf ppf "%s = \"%s\"" key value
+
 let pp_line ppf line =
   let open Fmt in
   match line with
   | Blank -> Fmt.nop ppf ()
   | Comment s -> pf ppf "#%s" s
   | Header s -> pf ppf "[%s]" s
-  | Item { key; value } -> (
+  | Item item -> pf ppf "%a" pp_item item
-      match String.contains value '"' || String.contains value ' ' with
-      | false -> pf ppf "%s = %s" key value
-      | true -> pf ppf "%s = \"%s\"" key value)
 
-let pp ppf raw_line_l =
+let _pp_lines ppf raw_line_l =
   let open Fmt in
   pf ppf "%a" (list ~sep:(any "\n") pp_line) raw_line_l
 
-let parse s =
+let pp_section ppf { header; items } =
-  match parse_string ~consume:All config s with
+  let open Fmt in
-  | Error msg -> Fmt.failwith "config parse error: %s" msg
+  pf ppf "[%s]@\n%a" header (list ~sep:(any "\n") pp_item) items
-  | Ok v -> v
+
+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 content in
-
+  (*Fmt.pr "%a@." pp_lines config;*)
-  Fmt.pr "%a@." pp config;
+  Fmt.pr "%a@." pp_config config;
 
   ()