138 lines
3.4 KiB
OCaml
138 lines
3.4 KiB
OCaml
(* parse config file
|
|
https://docs.taler.net/manpages/taler-exchange.conf.5.html
|
|
|
|
do not support "$"-path expansion*)
|
|
|
|
(* TODO
|
|
- integer
|
|
- duration
|
|
- YES|NO
|
|
- alt_unit_names json pair
|
|
|
|
type duration_element = {
|
|
number: int;
|
|
unit_: [ `Year | `Week | `Day | `Hour | `Minute | `Second ];
|
|
}
|
|
|
|
let integer =
|
|
take_while1 (function '0' .. '9' -> true | _ -> false) >>= fun s ->
|
|
match int_of_string_opt s with
|
|
| None -> fail "not an integer"
|
|
| Some i -> return i
|
|
|
|
let duration_value =
|
|
let number = whitespace *> integer in
|
|
let unit =
|
|
whitespace *> take_while1 (fun c -> not (is_whitespace c || is_eol c))
|
|
>>= function
|
|
| "year" | "years" -> return `Year
|
|
| "week" | "weeks" -> return `Week
|
|
| "day" | "days" -> return `Day
|
|
| "hour" | "hours" -> return `Hour
|
|
| "minute" | "minutes" -> return `Minute
|
|
| "s" -> return `Second
|
|
| _ -> fail "not a valid duration unit"
|
|
in
|
|
many1 (lift2 (fun number unit_ -> { number; unit_ }) number unit)
|
|
*)
|
|
|
|
let read_file file = In_channel.with_open_bin file In_channel.input_all
|
|
|
|
open Angstrom
|
|
|
|
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
|
|
let blank_line = whitespace *> end_of_line
|
|
let is_eol = function '\n' | '\r' -> true | _ -> false
|
|
|
|
let comment =
|
|
whitespace *> peek_char >>= function
|
|
| None -> fail "peek_char end_of_file failure"
|
|
| Some c ->
|
|
if c = '#' || c = '%' then
|
|
skip_while (fun c -> not (is_eol c)) *> end_of_line
|
|
else fail "not a comment"
|
|
|
|
let skip_ignored = skip_many (choice [ comment; blank_line ])
|
|
|
|
let identifier =
|
|
let ident_char = function
|
|
| 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true
|
|
| _ -> false
|
|
in
|
|
take_while1 ident_char >>| String.lowercase_ascii
|
|
|
|
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
|
|
| 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
|
|
|
|
let item =
|
|
lift2
|
|
(fun key value -> { key; value })
|
|
(identifier <* whitespace <* char '=')
|
|
value
|
|
|
|
let section_header = char '[' *> identifier <* char ']'
|
|
|
|
let section =
|
|
lift2
|
|
(fun name items -> { name; items })
|
|
(skip_ignored *> section_header)
|
|
(many (skip_ignored *> item))
|
|
|
|
let config : config Angstrom.t =
|
|
many_till (section <* skip_ignored) end_of_input
|
|
|
|
let parse_config s =
|
|
match parse_string ~consume:Consume.All config s with
|
|
| Ok v -> v
|
|
| Error msg -> failwith msg
|
|
|
|
let pp_item ppf { key; value } =
|
|
let open Fmt in
|
|
pf ppf "%s = %s" key value
|
|
|
|
let pp_section ppf (sec : section) =
|
|
let open Fmt in
|
|
pf ppf "[%s]@\n%a@." sec.name (list ~sep:(any "@\n") pp_item) sec.items
|
|
|
|
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;
|
|
|
|
()
|