This commit is contained in:
swrup 2025-10-13 09:28:01 +02:00
parent 8669fa2153
commit df1170a8a5

View file

@ -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;
()