From df1170a8a55e0c09a5d9a1af1ff11b9658584808 Mon Sep 17 00:00:00 2001 From: swrup Date: Mon, 13 Oct 2025 09:28:01 +0200 Subject: [PATCH] --- include/parse_config.ml | 53 +++++++++++++++++++++++++++++++---------- 1 file changed, 41 insertions(+), 12 deletions(-) diff --git a/include/parse_config.ml b/include/parse_config.ml index 6f9330dc..0669f39e 100644 --- a/include/parse_config.ml +++ b/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 } -> ( - match String.contains value '"' || String.contains value ' ' with - | false -> pf ppf "%s = %s" key value - | true -> pf ppf "%s = \"%s\"" key value) + | Item item -> pf ppf "%a" pp_item item -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 = - match parse_string ~consume:All config s with - | Error msg -> Fmt.failwith "config parse error: %s" msg - | Ok v -> v +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 content in - - Fmt.pr "%a@." pp config; + (*Fmt.pr "%a@." pp_lines config;*) + Fmt.pr "%a@." pp_config config; ()