This commit is contained in:
swrup 2025-10-13 06:36:58 +02:00
parent 7e3ec17d21
commit ba62486122
2 changed files with 50 additions and 62 deletions

View file

@ -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

View file

@ -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,17 +63,19 @@ let comment =
let skip_ignored = skip_many (choice [ comment; blank_line ])
(* --- Identifiers --- *)
let identifier =
let ident_char = function
| 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true
| _ -> false
let identifier = take_while1 ident_char >>| String.lowercase_ascii
in
take_while1 ident_char >>| String.lowercase_ascii
(* --- Values --- *)
(*
let 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
@ -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 value =
whitespace
*>
(*quoted_value <|> *)
unquoted_value
<* skip_ignored
(* --- Option line --- *)
type option_entry = {
key: string;
value: string;
}
let option_line =
let item =
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 --- *)
type config = section list
let config_parser : config Angstrom.t =
skip_ignored *> many section_parser <* skip_ignored <* end_of_input
let config : config Angstrom.t =
skip_ignored *> many section <* 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_option ppf (opt : option_entry) =
let pp_item ppf { key; value } =
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;
()