This commit is contained in:
parent
7e3ec17d21
commit
7a09cb41eb
2 changed files with 50 additions and 62 deletions
|
|
@ -6,4 +6,7 @@ fractional_input_digits = 2
|
||||||
fractional_normal_digits =2
|
fractional_normal_digits =2
|
||||||
fractional_trailing_zero_digits= 2
|
fractional_trailing_zero_digits= 2
|
||||||
alt_unit_names = "{"0":"€","3":"k€"}"
|
alt_unit_names = "{"0":"€","3":"k€"}"
|
||||||
# comment
|
# comment 1
|
||||||
|
# comment 2
|
||||||
|
% comment 3
|
||||||
|
% comment 4
|
||||||
|
|
|
||||||
|
|
@ -39,7 +39,17 @@ let read_file file = In_channel.with_open_bin file In_channel.input_all
|
||||||
|
|
||||||
open Angstrom
|
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 is_whitespace = function ' ' | '\t' -> true | _ -> false
|
||||||
let whitespace = skip_while is_whitespace
|
let whitespace = skip_while is_whitespace
|
||||||
|
|
@ -53,17 +63,19 @@ let comment =
|
||||||
|
|
||||||
let skip_ignored = skip_many (choice [ comment; blank_line ])
|
let skip_ignored = skip_many (choice [ comment; blank_line ])
|
||||||
|
|
||||||
(* --- Identifiers --- *)
|
let identifier =
|
||||||
|
|
||||||
let ident_char = function
|
let ident_char = function
|
||||||
| 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true
|
| 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true
|
||||||
| _ -> false
|
| _ -> false
|
||||||
|
in
|
||||||
let identifier = take_while1 ident_char >>| String.lowercase_ascii
|
take_while1 ident_char >>| String.lowercase_ascii
|
||||||
|
|
||||||
(* --- Values --- *)
|
(* --- Values --- *)
|
||||||
|
|
||||||
(*
|
let value =
|
||||||
|
let unquoted_value =
|
||||||
|
take_while1 (fun c -> not (is_whitespace c || is_eol c))
|
||||||
|
in
|
||||||
let quoted_value =
|
let quoted_value =
|
||||||
char '"' *> take_till is_eol >>= fun line_rest ->
|
char '"' *> take_till is_eol >>= fun line_rest ->
|
||||||
match String.rindex_opt line_rest '"' with
|
match String.rindex_opt line_rest '"' with
|
||||||
|
|
@ -74,79 +86,52 @@ let quoted_value =
|
||||||
let len = String.length line_rest in
|
let len = String.length line_rest in
|
||||||
let remaining_len = len - i - 1 in
|
let remaining_len = len - i - 1 in
|
||||||
advance (len - remaining_len) *> return value
|
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 item =
|
||||||
|
|
||||||
let value =
|
|
||||||
whitespace
|
|
||||||
*>
|
|
||||||
(*quoted_value <|> *)
|
|
||||||
unquoted_value
|
|
||||||
<* skip_ignored
|
|
||||||
|
|
||||||
(* --- Option line --- *)
|
|
||||||
|
|
||||||
type option_entry = {
|
|
||||||
key: string;
|
|
||||||
value: string;
|
|
||||||
}
|
|
||||||
|
|
||||||
let option_line =
|
|
||||||
lift2
|
lift2
|
||||||
(fun key value -> { key; value })
|
(fun key value -> { key; value })
|
||||||
(identifier <* whitespace <* char '=')
|
(identifier <* whitespace <* char '=')
|
||||||
value
|
value
|
||||||
|
|
||||||
(* --- Section --- *)
|
|
||||||
|
|
||||||
type section = {
|
|
||||||
name: string;
|
|
||||||
options: option_entry list;
|
|
||||||
}
|
|
||||||
|
|
||||||
let section_header = char '[' *> identifier <* char ']'
|
let section_header = char '[' *> identifier <* char ']'
|
||||||
|
|
||||||
let section_parser =
|
let section =
|
||||||
lift2
|
lift2
|
||||||
(fun name options -> { name; options })
|
(fun name items -> { name; items })
|
||||||
(section_header <* skip_ignored)
|
(section_header <* skip_ignored)
|
||||||
(many (option_line <* skip_ignored))
|
(many (item <* skip_ignored))
|
||||||
|
|
||||||
(* --- Whole config file --- *)
|
let config : config Angstrom.t =
|
||||||
|
skip_ignored *> many section <* skip_ignored <* end_of_input
|
||||||
type config = section list
|
|
||||||
|
|
||||||
let config_parser : config Angstrom.t =
|
|
||||||
skip_ignored *> many section_parser <* skip_ignored <* end_of_input
|
|
||||||
|
|
||||||
let parse_config s =
|
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
|
| Ok v -> v
|
||||||
| Error msg -> failwith msg
|
| Error msg -> failwith msg
|
||||||
|
|
||||||
(* --- Pretty printer --- *)
|
(* --- pp --- *)
|
||||||
|
|
||||||
(* Pretty-printer for an option: key = value *)
|
let pp_item ppf { key; value } =
|
||||||
let pp_option ppf (opt : option_entry) =
|
|
||||||
let open Fmt in
|
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 pp_section ppf (sec : section) =
|
||||||
let open Fmt in
|
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 pp_config ppf (cfg : config) =
|
||||||
let open Fmt in
|
let open Fmt in
|
||||||
pf ppf "%a@." (list ~sep:(any "@\n") pp_section) cfg
|
pf ppf "%a@." (list ~sep:(any "@\n") pp_section) cfg
|
||||||
|
|
||||||
|
(* --- --- *)
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
let content = read_file "default.config" in
|
let content = read_file "default.config" in
|
||||||
(*Fmt.pr "%s@." content;*)
|
|
||||||
|
|
||||||
let config = parse_config content in
|
let config = parse_config content in
|
||||||
|
|
||||||
Fmt.pr "%a" pp_config config;
|
Fmt.pr "%a" pp_config config;
|
||||||
|
|
||||||
()
|
()
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue