(* 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 line = | Blank | Comment of string | Section_header of string | Item of item let is_whitespace = function ' ' | '\t' -> true | _ -> false let whitespace = skip_while is_whitespace let is_eol = function '\n' | '\r' -> true | _ -> false let blank = whitespace >>= fun () -> return Blank let comment = ( whitespace *> peek_char >>= function | None -> fail "peek_char end_of_file failure" | Some c -> if c = '#' || c = '%' then take_while (fun c -> not (is_eol c)) else fail "not a comment" ) >>= fun s -> return (Comment s) let item_key = let ident_char = function | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true | _ -> false in take_while1 ident_char >>| String.lowercase_ascii let item_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) let item = lift2 (fun key value -> Item { key; value }) (item_key <* whitespace <* char '=') item_value let section_header = char '[' *> item_key <* char ']' >>= fun s -> return (Section_header s) let lines = let line = choice [ blank; comment; section_header; item ] <* end_of_line in many line <* end_of_input let parse s = match parse_string ~consume:Consume.All lines s with | Ok v -> v | Error msg -> failwith msg let pp_line ppf line = let open Fmt in match line with | Blank -> Fmt.nop ppf () | Comment s -> pf ppf "#%s" s | Section_header s -> pf ppf "[%s]" s | Item { key; value } -> pf ppf "%s = %s" key value let pp_config ppf config = let open Fmt in pf ppf "%a" (list ~sep:(any "\n") pp_line) config (* --- --- *) (* let () = let content = read_file "default.config" in (*Fmt.pr "%s" content;*) let config = parse content in Fmt.pr "%a@." pp_config config; () *) *) (* --- ff --- *) open Angstrom let read_file file = In_channel.with_open_bin file In_channel.input_all let raw_line = take_till (function '\n' | '\r' -> true | _ -> false) >>= fun s -> return s <* end_of_line let raw_line_l = many raw_line <* end_of_input let pp_raw_line ppf raw_line = let open Fmt in pf ppf "%s" raw_line let pp ppf raw_line_l = let open Fmt in pf ppf "%a" (list ~sep:(any "\n") pp_raw_line) raw_line_l (* Helper: parse whole input into list of lines *) let parse s = match parse_string ~consume:All raw_line_l s with | Ok ls -> ls | Error msg -> failwith ("lines parse error: " ^ msg) let () = let content = read_file "default.config" in (*Fmt.pr "%s" content;*) let config = parse content in Fmt.pr "%a@." pp config; ()