diff --git a/src/api.ml b/src/api.ml index dcbf036d..34acfc04 100644 --- a/src/api.ml +++ b/src/api.ml @@ -255,7 +255,7 @@ end let currency_specification = let open Config.Currency in - match Parse_config.Alt_unit_names.encode v.alt_unit_names with + match encode Alt_unit_names.jsont v.alt_unit_names with | Error e -> Fmt.failwith "json encoding error on alt_unit_names: %s." e | Ok alt_unit_names -> CurrencySpecification. diff --git a/src/config.ml b/src/config.ml index 6db64eed..a62866e9 100644 --- a/src/config.ml +++ b/src/config.ml @@ -87,6 +87,35 @@ module Exchangedb_postgres = struct end module Currency = struct + module Alt_unit_names = struct + open Syntax + module Int_map = Map.Make (Int) + module String_map = Map.Make (String) + + type t = string Int_map.t + + let jsont = + let of_string_map str_map = + str_map + |> String_map.to_list + |> list_map (fun (k, v) -> + match int_of_string_opt k with + | None -> Error "not an integer" + | Some k -> Ok (k, v)) + |> function + | Error e -> Jsont.Error.msg Jsont.Meta.none e + | Ok l -> Int_map.of_list l + in + let to_string_map int_map = + int_map + |> Int_map.to_list + |> List.map (fun (k, v) -> (string_of_int k, v)) + |> String_map.of_list + in + let string_map_jsont = Jsont.Object.as_string_map Jsont.string in + Jsont.map ~dec:of_string_map ~enc:to_string_map string_map_jsont + end + type t = { enabled: [ `YES | `NO ]; code: string; @@ -94,7 +123,7 @@ module Currency = struct fractional_input_digits: int; fractional_normal_digits: int; fractional_trailing_zero_digits: int; - alt_unit_names: (int * string) list; + alt_unit_names: Alt_unit_names.t; } let currency_sections = @@ -113,12 +142,13 @@ 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; + get "alt_unit_names" + |> Jsont_bytesrw.decode_string Alt_unit_names.jsont + |> Parse_config.unwrap; } let all_currencies = List.map parse_currency currency_sections - (* I think the exchange only handle one currency *) let v = match List.find_opt (fun v -> v.code = Exchange.currency) all_currencies diff --git a/src/parse_config.ml b/src/parse_config.ml index 044873fb..83563448 100644 --- a/src/parse_config.ml +++ b/src/parse_config.ml @@ -212,34 +212,3 @@ let etag s = match Headers_lib.Etag.parse (Fmt.str "\"%s\"" s) with | Ok etag -> etag | Error _ -> fail "could not parse etag `%s`: %s" s e) - -(* TODO - move to another module - can we type the json as a Int_map directly? *) -module Alt_unit_names = struct - open Syntax - module String_map = Map.Make (String) - - let string_map_jsont = Jsont.Object.as_string_map Jsont.string - - let decode s = - let* string_map = Jsont_bytesrw.decode_string string_map_jsont s in - let l = String_map.to_list string_map in - let* l = - list_map - (fun (k, v) -> - match int_of_string_opt k with - | None -> Error "alt_unit_names has a non-integer key" - | Some k -> Ok (k, v)) - l - in - match List.find_opt (fun (i, _) -> i = 0) l with - | None -> Error "alt_unit_names with no entry for base value \"0\"" - | Some _ -> Ok l - - let encode l = - let l = List.map (fun (k, v) -> (string_of_int k, v)) l in - let string_map = String_map.of_list l in - let+ s = Jsont_bytesrw.encode_string string_map_jsont string_map in - s -end diff --git a/src/syntax.ml b/src/syntax.ml index 9282b2dd..7db544ca 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -55,11 +55,3 @@ let list_fold_left f acc l = let* acc = acc in f acc v) (Ok acc) l - -let list_option l = - match (List.for_all Option.is_none l, List.for_all Option.is_some l) with - | _, true -> - let l = List.map Option.get l in - Ok (Some l) - | true, _ -> Ok None - | _, _ -> Error ()