diff --git a/default.config b/default.config index b3a0ce3b..4cc19e36 100644 --- a/default.config +++ b/default.config @@ -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 diff --git a/include/parse_config.ml b/include/parse_config.ml index 01c1ed64..ea4c9362 100644 --- a/include/parse_config.ml +++ b/include/parse_config.ml @@ -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,100 +63,75 @@ let comment = let skip_ignored = skip_many (choice [ comment; blank_line ]) -(* --- Identifiers --- *) - -let ident_char = function - | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true - | _ -> false - -let identifier = take_while1 ident_char >>| String.lowercase_ascii +let identifier = + let ident_char = function + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true + | _ -> false + in + take_while1 ident_char >>| String.lowercase_ascii (* --- Values --- *) -(* -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 - *) - -let unquoted_value = take_while1 (fun c -> not (is_whitespace c || is_eol c)) - let value = - whitespace - *> - (*quoted_value <|> *) - unquoted_value - <* skip_ignored + 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 + in + 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; + ()