+wip amount

This commit is contained in:
swrup 2026-03-02 23:44:32 +01:00
parent 7be98eb8ad
commit f35950dbf0
2 changed files with 59 additions and 42 deletions

View file

@ -3,6 +3,8 @@
and specialize amount.ml to Config.currency?? and specialize amount.ml to Config.currency??
have safe amount arithmetic *) have safe amount arithmetic *)
open Syntax
type sign = type sign =
| Sign_plus | Sign_plus
| Sign_minus | Sign_minus
@ -23,6 +25,9 @@ let fraction_max_number_of_digits = 8
let fraction_upper_bound = let fraction_upper_bound =
Int32.of_float @@ Float.pow 10. (Int.to_float fraction_max_number_of_digits) Int32.of_float @@ Float.pow 10. (Int.to_float fraction_max_number_of_digits)
let is_letter = function 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false
let is_digit = function '0' .. '9' -> true | _ -> false
let check_currency s = let check_currency s =
if not @@ String.for_all is_letter s then if not @@ String.for_all is_letter s then
Error "currency contains forbidden character" Error "currency contains forbidden character"
@ -37,20 +42,34 @@ let check_currency s =
let check_value v = let check_value v =
if Int64.unsigned_compare v value_upper_bound > 0 then if Int64.unsigned_compare v value_upper_bound > 0 then
Error "value is greater than 2^52" Error "value is greater than 2^52"
else Ok v else Ok ()
let check_fraction v = let check_fraction v =
if Int32.unsigned_compare v fraction_upper_bound > 0 then if Int32.unsigned_compare v fraction_upper_bound > 0 then
Fmt.error "fraction has more than %d digits" fraction_max_number_of_digits Fmt.error "fraction has more than %d digits" fraction_max_number_of_digits
else Ok v else Ok ()
let make ~sign ~currency ~value ~fraction = let make ~sign ~currency ~value ~fraction =
let* () = check_currency currency in
let* () = check_value value in
let* () = check_fraction fraction in
let currency = String.uppercase_ascii currency in
Ok { sign; currency; value; fraction } Ok { sign; currency; value; fraction }
(*
let config_currency =
match check_currency Config.currency with
| Error e -> Fmt.failwith "Invalid currency name configuration: %s@." e
| Ok () -> String.uppercase_ascii Config.currency
let make_config_currency ~value ~fraction =
let* () = check_value value in
let* () = check_fraction fraction in
Ok { sign= None; currency= config_currency; value; fraction }
*)
open Angstrom open Angstrom
let is_letter = function 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false
let is_digit = function '0' .. '9' -> true | _ -> false
let letters = take_while1 is_letter let letters = take_while1 is_letter
let digits = take_while1 is_digit let digits = take_while1 is_digit
@ -62,45 +81,37 @@ let sign =
return None; return None;
] ]
let currency_of_string s = let value =
if not @@ String.for_all is_letter s then digits >>= fun s ->
Error "currency contains forbidden character" match Int64.of_string_opt s with
else if String.length s > maximum_currency_length then | None -> fail "not a valid int64"
Fmt.error "currency is more than %d characters long" maximum_currency_length | Some n -> return n
else Ok (String.uppercase_ascii s)
let value_of_string s = let fraction =
if not @@ String.for_all is_digit s then digits >>= fun s ->
Error "value contains forbidden character" let len = String.length s in
else match len <= fraction_max_number_of_digits with
match Int64.of_string_opt s with | false ->
| None -> Error "value is not a valid integer" fail
| Some v -> (Fmt.str "fraction has more than %d digits"
if v > value_upper_bound then Error "value is greater than 2^52" fraction_max_number_of_digits)
else if v < Int64.zero then Error "value is negative" | true -> (
else Ok v match Int32.of_string_opt s with
| None -> fail "not a valid int32"
let fraction_of_string s = | Some n ->
if not @@ String.for_all is_digit s then let magnitude =
Error "fraction contains forbidden character" let exp = Int.to_float (fraction_max_number_of_digits - len) in
else if String.length s > fraction_max_number_of_digits then Int32.of_float @@ Float.pow 10. exp
Fmt.error "fraction has more than %d digits" fraction_max_number_of_digits in
else let n = Int32.mul n magnitude in
match Int32.of_string_opt s with return n)
| None -> Error "fraction is not a valid integer"
| Some v -> if v < Int32.zero then Error "fraction is negative" else Ok v
let amount = let amount =
lift4 lift4
(fun sign currency value fraction -> (fun sign currency value fraction -> make ~sign ~currency ~value ~fraction)
let open Syntax in
let* currency = currency_of_string currency in
let* value = value_of_string value in
let* fraction = fraction_of_string fraction in
Ok { sign; currency; value; fraction })
sign letters sign letters
(char ':' *> digits) (char ':' *> value)
(option "" (char '.' *> digits)) (option 0_l (char '.' *> fraction))
<* end_of_input <* end_of_input
let of_string s = parse_string ~consume:Consume.All amount s |> Result.join let of_string s = parse_string ~consume:Consume.All amount s |> Result.join
@ -114,7 +125,8 @@ let pp =
fun ppf { sign; currency; value; fraction } -> fun ppf { sign; currency; value; fraction } ->
(* TODO (* TODO
depends on the currency's number of fraction digits *) depends on the currency's number of fraction digits *)
pf ppf "%a%s:%Lu.%02lu" (Fmt.option pp_sign) sign currency value fraction pf ppf "%a%s:%Lu.%0*lu" (Fmt.option pp_sign) sign currency value
fraction_max_number_of_digits fraction
let to_string = Fmt.str "%a" pp let to_string = Fmt.str "%a" pp
@ -125,8 +137,8 @@ let currency_length = 12
let pad_currency_string s = let pad_currency_string s =
let len = String.length s in let len = String.length s in
assert (len < currency_len); assert (len < currency_length);
let b = Bytes.make 12 '\x00' in let b = Bytes.make currency_length '\x00' in
Bytes.blit_string s 0 b 0 len; Bytes.blit_string s 0 b 0 len;
Bytes.to_string b Bytes.to_string b
@ -141,5 +153,5 @@ let bin =
record make_exn record make_exn
|+ field beint64 (fun t -> t.value) |+ field beint64 (fun t -> t.value)
|+ field beint32 (fun t -> Int32.mul t.fraction 1_000_000_l) |+ field beint32 (fun t -> Int32.mul t.fraction 1_000_000_l)
|+ field (bytes currency_len) (fun t -> pad_currency_string t.currency) |+ field (bytes currency_length) (fun t -> pad_currency_string t.currency)
|> sealr |> sealr

View file

@ -16,6 +16,11 @@ val make :
fraction:Int32.t -> fraction:Int32.t ->
(t, string) result (t, string) result
(* dependency cycle with config.ml ...
val make_config_currency :
value:Int64.t -> fraction:Int32.t -> (t, string) result
*)
val pp : Format.formatter -> t -> unit val pp : Format.formatter -> t -> unit
val to_string : t -> string val to_string : t -> string
val of_string : string -> (t, string) result val of_string : string -> (t, string) result