diff --git a/src/config.ml b/src/config.ml index 9be285c0..775e25c5 100644 --- a/src/config.ml +++ b/src/config.ml @@ -5,7 +5,7 @@ let config_data = match Assets_crunch.read path with | None -> fail "static file not found: `%s`" path | Some data -> - let v = Parse_data.parse data in + let v = Config_section.parse data in v module Exchange = struct @@ -109,7 +109,7 @@ module Currency = struct fractional_trailing_zero_digits= get "fractional_trailing_zero_digits" |> int; alt_unit_names= - get "alt_unit_names" |> Alt_unit_names.decode |> Parse_config.unwrap_res; + get "alt_unit_names" |> Alt_unit_names.decode |> Parse_config.unwrap; } let all_currencies = List.map parse_currency currency_sections diff --git a/src/parse_config.ml b/src/parse_config.ml index 1cd487b8..d6131524 100644 --- a/src/parse_config.ml +++ b/src/parse_config.ml @@ -23,7 +23,7 @@ let is_eol = function '\n' | '\r' -> true | _ -> false let is_whitespace = function ' ' | '\t' -> true | _ -> false let blanks = skip_while is_whitespace -module Parse_data = struct +module Config_section = struct type t = | Blank | Comment of string @@ -38,21 +38,31 @@ module Parse_data = struct take_while1 ident_char >>| String.lowercase_ascii let line = take_till is_eol <* end_of_line - let blank = blanks <* end_of_line >>| fun () -> Blank + let blank_line = blanks <* end_of_line >>| fun () -> Blank let comment = blanks *> (char '#' <|> char '%') *> line >>| fun s -> Comment s - let header = char '[' *> id <* char ']' <* end_of_line >>| fun s -> Header s + + let header = + blanks *> char '[' *> id <* char ']' <* blanks <* end_of_line >>| fun s -> + Header s let item_value = let unquoted_value = - take_while1 (fun c -> not (is_whitespace c || is_eol c)) <* end_of_line + take_while1 (fun c -> not (is_whitespace c || is_eol c)) + <* blanks + <* end_of_line in let quoted_value = - char '"' *> take_till is_eol <* end_of_line >>= fun s -> - match String.ends_with ~suffix:"\"" s with + take_till is_eol <* end_of_line >>= fun s -> + let s = String.trim s in + match + String.starts_with ~prefix:"\"" s + && String.ends_with ~suffix:"\"" s + && s <> "\"" + with | false -> fail "invalid quoted value" | true -> - let value = String.sub s 0 (String.length s - 1) in - return value + let s = String.sub s 1 (String.length s - 2) in + return s in quoted_value <|> unquoted_value @@ -62,7 +72,8 @@ module Parse_data = struct id (blanks *> char '=' *> blanks *> item_value) - let config = many (choice [ blank; comment; header; item ]) <* end_of_input + let config = + many (choice [ blank_line; comment; header; item ]) <* end_of_input let fold_sections l = let rec loop section_l item_l l = @@ -84,36 +95,7 @@ module Parse_data = struct | Ok v -> fold_sections v end -module Pp_debug = struct - let pp_item ppf { key; value } = - let open Fmt in - match String.contains value '"' || String.contains value ' ' with - | false -> pf ppf "%s = %s" key value - | true -> pf ppf "%s = \"%s\"" key value - - let pp_line ppf v = - let open Fmt in - let open Parse_data in - match v with - | Blank -> Fmt.nop ppf () - | Comment s -> pf ppf "#%s" s - | Header s -> pf ppf "[%s]" s - | Item item -> pf ppf "%a" pp_item item - - let _pp_lines ppf raw_line_l = - let open Fmt in - pf ppf "%a" (list ~sep:(any "\n") pp_line) raw_line_l - - let pp_section ppf { header; items } = - let open Fmt in - pf ppf "[%s]@\n%a" header (list ~sep:(any "\n") pp_item) items - - let pp_config ppf l = - let open Fmt in - pf ppf "%a" (list ~sep:(any "\n") pp_section) l -end - -module Parse_duration = struct +module Config_duration = struct type duration_element = { number: int; dunit: [ `Year | `Week | `Day | `Hour | `Minute | `Second ]; @@ -154,20 +136,12 @@ module Parse_duration = struct in f u - let ptime_span_of_int64 i = - match Ptime.Span.of_float_s (Int64.to_float i) with - | None -> - fail "ptime_span_of_int64 error: `%Ld` is not a valid ptime span" i - | Some ts -> ts - let to_time_span t = - let acc = - List.fold_left - (fun acc { number; dunit } -> acc + (number * dunit_to_seconds dunit)) - 0 t - in - let acc = Int64.of_int acc in - Time.Relative.of_s acc + List.fold_left + (fun acc { number; dunit } -> acc + (number * dunit_to_seconds dunit)) + 0 t + |> Int64.of_int + |> Time.Relative.of_s let parse s : duration_element list = match parse_string ~consume:All duration s with @@ -175,7 +149,7 @@ module Parse_duration = struct | Ok v -> v end -let unwrap_res = function Error e -> fail "`%s`." e | Ok v -> v +let unwrap = function Error e -> fail "`%s`." e | Ok v -> v let get_opt t ~section ~field = match List.find_opt (fun v -> v.header = section) t with @@ -209,16 +183,16 @@ let yes_no = function | s -> fail "expected `YES`/`NO` value, got `%s`" s let uri s = Uri.of_string s -let amount s = s |> Amount.of_string |> unwrap_res -let duration s = Parse_duration.(s |> parse |> to_time_span) +let amount s = s |> Amount.of_string |> unwrap +let duration s = Config_duration.(s |> parse |> to_time_span) let ed25519 s = s |> B32.decode - |> unwrap_res + |> unwrap |> Mirage_crypto_ec.Ed25519.pub_of_octets |> Result.map_error (fun e -> Fmt.str "%a" Mirage_crypto_ec.pp_error e) - |> unwrap_res + |> unwrap (* TODO move to another module