use jsont for alt_unit_names
This commit is contained in:
parent
99d2ee6194
commit
7b8edd05e9
3 changed files with 29 additions and 42 deletions
|
|
@ -104,7 +104,8 @@ module Currency = struct
|
||||||
fractional_normal_digits= get "fractional_normal_digits" |> int;
|
fractional_normal_digits= get "fractional_normal_digits" |> int;
|
||||||
fractional_trailing_zero_digits=
|
fractional_trailing_zero_digits=
|
||||||
get "fractional_trailing_zero_digits" |> int;
|
get "fractional_trailing_zero_digits" |> int;
|
||||||
alt_unit_names= get "alt_unit_names" |> Alt_unit_names.parse;
|
alt_unit_names=
|
||||||
|
get "alt_unit_names" |> Alt_unit_names.decode |> Parse_config.unwrap_res;
|
||||||
}
|
}
|
||||||
|
|
||||||
let all_currencies = List.map parse_currency currency_sections
|
let all_currencies = List.map parse_currency currency_sections
|
||||||
|
|
|
||||||
|
|
@ -14,7 +14,7 @@ let mk_keys ~db_conn ~sm ~last_issue_date =
|
||||||
let currency_specification =
|
let currency_specification =
|
||||||
let v = Config.Currency.v in
|
let v = Config.Currency.v in
|
||||||
let alt_unit_names =
|
let alt_unit_names =
|
||||||
Parse_config.Alt_unit_names.to_json_string v.alt_unit_names
|
Parse_config.Alt_unit_names.encode_exn v.alt_unit_names
|
||||||
in
|
in
|
||||||
CurrencySpecification.
|
CurrencySpecification.
|
||||||
{
|
{
|
||||||
|
|
|
||||||
|
|
@ -228,49 +228,35 @@ let ed25519 s =
|
||||||
|> Result.map_error (fun e -> Fmt.str "%a" Mirage_crypto_ec.pp_error e)
|
|> Result.map_error (fun e -> Fmt.str "%a" Mirage_crypto_ec.pp_error e)
|
||||||
|> unwrap_res
|
|> unwrap_res
|
||||||
|
|
||||||
(* TODO alt_unit_names jsont *)
|
(* TODO
|
||||||
|
move to another module
|
||||||
|
can we type the json as a Int_map directly? *)
|
||||||
module Alt_unit_names = struct
|
module Alt_unit_names = struct
|
||||||
let rm_brackets s =
|
open Syntax
|
||||||
let s = String.trim s in
|
module String_map = Map.Make (String)
|
||||||
match
|
|
||||||
String.starts_with ~prefix:"{" s && String.ends_with ~suffix:"}" s
|
|
||||||
with
|
|
||||||
| false -> fail "expected json, got `%s`" s
|
|
||||||
| true ->
|
|
||||||
let s = String.sub s 1 (String.length s - 2) in
|
|
||||||
s
|
|
||||||
|
|
||||||
let rm_quotes s =
|
let string_map_jsont = Jsont.Object.as_string_map Jsont.string
|
||||||
let s = String.trim s in
|
|
||||||
match
|
|
||||||
String.starts_with ~prefix:"\"" s && String.ends_with ~suffix:"\"" s
|
|
||||||
with
|
|
||||||
| false -> fail "expected quoted string, got `%s`" s
|
|
||||||
| true ->
|
|
||||||
let s = String.sub s 1 (String.length s - 2) in
|
|
||||||
s
|
|
||||||
|
|
||||||
let parse s =
|
let decode s =
|
||||||
let s = rm_brackets s in
|
let* string_map = Jsont_bytesrw.decode_string string_map_jsont s in
|
||||||
String.split_on_char ',' s
|
let l = String_map.to_list string_map in
|
||||||
|> List.map (String.split_on_char ':')
|
let* l =
|
||||||
|> List.map (function
|
list_map
|
||||||
| [ k; v ] -> (k, v)
|
(fun (k, v) ->
|
||||||
| _ -> fail "invalid json key-value map")
|
|
||||||
|> List.map (fun (k, v) ->
|
|
||||||
let k = rm_quotes k in
|
|
||||||
let v = rm_quotes v in
|
|
||||||
let k =
|
|
||||||
match int_of_string_opt k with
|
match int_of_string_opt k with
|
||||||
| None ->
|
| None -> Error "alt_unit_names has a non-integer key"
|
||||||
fail "invalid json key-value map, expected integer key, got `%s`"
|
| Some k -> Ok (k, v))
|
||||||
k
|
l
|
||||||
| Some k -> k
|
|
||||||
in
|
in
|
||||||
(k, v))
|
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 to_json_string l =
|
let encode l =
|
||||||
let l = List.map (fun (i, s) -> Fmt.str {|"%d": "%s"|} i s) l in
|
let l = List.map (fun (k, v) -> (string_of_int k, v)) l in
|
||||||
let s = String.concat "," l in
|
let string_map = String_map.of_list l in
|
||||||
"{" ^ s ^ "}"
|
let+ s = Jsont_bytesrw.encode_string string_map_jsont string_map in
|
||||||
|
s
|
||||||
|
|
||||||
|
let encode_exn l = encode l |> Result.get_ok
|
||||||
end
|
end
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue