This commit is contained in:
swrup 2026-02-10 04:24:05 +01:00
parent b234654de8
commit 5d25b78f1d
2 changed files with 24 additions and 55 deletions

View file

@ -5,7 +5,7 @@ let config_data =
match Assets_crunch.read path with match Assets_crunch.read path with
| None -> fail "static file not found: `%s`" path | None -> fail "static file not found: `%s`" path
| Some data -> | Some data ->
let v = Parse_data.parse data in let v = Config_section.parse data in
v v
module Exchange = struct module Exchange = struct
@ -109,7 +109,7 @@ 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_res; get "alt_unit_names" |> Alt_unit_names.decode |> Parse_config.unwrap;
} }
let all_currencies = List.map parse_currency currency_sections let all_currencies = List.map parse_currency currency_sections

View file

@ -23,7 +23,7 @@ let is_eol = function '\n' | '\r' -> true | _ -> false
let is_whitespace = function ' ' | '\t' -> true | _ -> false let is_whitespace = function ' ' | '\t' -> true | _ -> false
let blanks = skip_while is_whitespace let blanks = skip_while is_whitespace
module Parse_data = struct module Config_section = struct
type t = type t =
| Blank | Blank
| Comment of string | Comment of string
@ -38,13 +38,18 @@ module Parse_data = struct
take_while1 ident_char >>| String.lowercase_ascii take_while1 ident_char >>| String.lowercase_ascii
let line = take_till is_eol <* end_of_line 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 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 item_value =
let unquoted_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 in
let quoted_value = let quoted_value =
char '"' *> take_till is_eol <* end_of_line >>= fun s -> char '"' *> take_till is_eol <* end_of_line >>= fun s ->
@ -62,7 +67,8 @@ module Parse_data = struct
id id
(blanks *> char '=' *> blanks *> item_value) (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 fold_sections l =
let rec loop section_l item_l l = let rec loop section_l item_l l =
@ -84,36 +90,7 @@ module Parse_data = struct
| Ok v -> fold_sections v | Ok v -> fold_sections v
end end
module Pp_debug = struct module Config_duration = 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
type duration_element = { type duration_element = {
number: int; number: int;
dunit: [ `Year | `Week | `Day | `Hour | `Minute | `Second ]; dunit: [ `Year | `Week | `Day | `Hour | `Minute | `Second ];
@ -154,20 +131,12 @@ module Parse_duration = struct
in in
f u 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 to_time_span t =
let acc = List.fold_left
List.fold_left (fun acc { number; dunit } -> acc + (number * dunit_to_seconds dunit))
(fun acc { number; dunit } -> acc + (number * dunit_to_seconds dunit)) 0 t
0 t |> Int64.of_int
in |> Time.Relative.of_s
let acc = Int64.of_int acc in
Time.Relative.of_s acc
let parse s : duration_element list = let parse s : duration_element list =
match parse_string ~consume:All duration s with match parse_string ~consume:All duration s with
@ -175,7 +144,7 @@ module Parse_duration = struct
| Ok v -> v | Ok v -> v
end 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 = let get_opt t ~section ~field =
match List.find_opt (fun v -> v.header = section) t with match List.find_opt (fun v -> v.header = section) t with
@ -209,16 +178,16 @@ let yes_no = function
| s -> fail "expected `YES`/`NO` value, got `%s`" s | s -> fail "expected `YES`/`NO` value, got `%s`" s
let uri s = Uri.of_string s let uri s = Uri.of_string s
let amount s = s |> Amount.of_string |> unwrap_res let amount s = s |> Amount.of_string |> unwrap
let duration s = Parse_duration.(s |> parse |> to_time_span) let duration s = Config_duration.(s |> parse |> to_time_span)
let ed25519 s = let ed25519 s =
s s
|> B32.decode |> B32.decode
|> unwrap_res |> unwrap
|> Mirage_crypto_ec.Ed25519.pub_of_octets |> Mirage_crypto_ec.Ed25519.pub_of_octets
|> 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
(* TODO (* TODO
move to another module move to another module