This commit is contained in:
parent
5c39b5335b
commit
78011882a2
4 changed files with 34 additions and 43 deletions
|
|
@ -255,7 +255,7 @@ end
|
||||||
|
|
||||||
let currency_specification =
|
let currency_specification =
|
||||||
let open Config.Currency in
|
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
|
| Error e -> Fmt.failwith "json encoding error on alt_unit_names: %s." e
|
||||||
| Ok alt_unit_names ->
|
| Ok alt_unit_names ->
|
||||||
CurrencySpecification.
|
CurrencySpecification.
|
||||||
|
|
|
||||||
|
|
@ -87,6 +87,35 @@ module Exchangedb_postgres = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
module Currency = struct
|
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 = {
|
type t = {
|
||||||
enabled: [ `YES | `NO ];
|
enabled: [ `YES | `NO ];
|
||||||
code: string;
|
code: string;
|
||||||
|
|
@ -94,7 +123,7 @@ module Currency = struct
|
||||||
fractional_input_digits: int;
|
fractional_input_digits: int;
|
||||||
fractional_normal_digits: int;
|
fractional_normal_digits: int;
|
||||||
fractional_trailing_zero_digits: int;
|
fractional_trailing_zero_digits: int;
|
||||||
alt_unit_names: (int * string) list;
|
alt_unit_names: Alt_unit_names.t;
|
||||||
}
|
}
|
||||||
|
|
||||||
let currency_sections =
|
let currency_sections =
|
||||||
|
|
@ -113,12 +142,13 @@ module Currency = struct
|
||||||
fractional_trailing_zero_digits=
|
fractional_trailing_zero_digits=
|
||||||
get "fractional_trailing_zero_digits" |> int;
|
get "fractional_trailing_zero_digits" |> int;
|
||||||
alt_unit_names=
|
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
|
let all_currencies = List.map parse_currency currency_sections
|
||||||
|
|
||||||
(* I think the exchange only handle one currency *)
|
|
||||||
let v =
|
let v =
|
||||||
match
|
match
|
||||||
List.find_opt (fun v -> v.code = Exchange.currency) all_currencies
|
List.find_opt (fun v -> v.code = Exchange.currency) all_currencies
|
||||||
|
|
|
||||||
|
|
@ -212,34 +212,3 @@ let etag s =
|
||||||
match Headers_lib.Etag.parse (Fmt.str "\"%s\"" s) with
|
match Headers_lib.Etag.parse (Fmt.str "\"%s\"" s) with
|
||||||
| Ok etag -> etag
|
| Ok etag -> etag
|
||||||
| Error _ -> fail "could not parse etag `%s`: %s" s e)
|
| 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
|
|
||||||
|
|
|
||||||
|
|
@ -55,11 +55,3 @@ let list_fold_left f acc l =
|
||||||
let* acc = acc in
|
let* acc = acc in
|
||||||
f acc v)
|
f acc v)
|
||||||
(Ok acc) l
|
(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 ()
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue