(* parse config file
   https://docs.taler.net/manpages/taler-exchange.conf.5.html

   do not support "$"-path expansion*)

[@@@ocaml.warning "-27-69-32"]

(*
(* --- Duration values --- *)

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

(* --- Utilities --- *)

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_fail >>= fun 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 ])

(* --- Identifiers --- *)

let ident_char = function
  | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> true
  | _ -> false

let identifier = 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

(* --- Option line --- *)

type option_entry = {
  key: string;
  value: string;
}

let option_line =
  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 =
  lift2
    (fun name options -> { name; options })
    (section_header <* skip_ignored)
    (many (option_line <* 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 parse_config s =
  match parse_string ~consume:Consume.All config_parser s with
  | Ok v -> v
  | Error msg -> failwith msg

(* --- Pretty printer --- *)

(* Pretty-printer for an option: key = value *)
let pp_option ppf (opt : option_entry) =
  let open Fmt in
  pf ppf "%s = %s" opt.key opt.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

(* 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.config" in
  (*Fmt.pr "%s@." content;*)

  let config = parse_config content in

  Fmt.pr "%a" pp_config config;
  ()