From a7d61ef43d1ce3af1f6fc5595df324dd666061de Mon Sep 17 00:00:00 2001 From: swrup Date: Wed, 11 Feb 2026 00:06:28 +0100 Subject: [PATCH] ~ amount.ml --- src/amount.ml | 127 +++++++++++++++++++++++++------------------------ src/amount.mli | 13 ++--- 2 files changed, 69 insertions(+), 71 deletions(-) diff --git a/src/amount.ml b/src/amount.ml index 65fde44d..ab56d486 100644 --- a/src/amount.ml +++ b/src/amount.ml @@ -1,16 +1,9 @@ (* TODO - have safe amount arithmetic - make type private - redefine an Amount module with currency enforced to be Config.currency? *) -(* Amounts of currency, serialized as `:.` - Fixed-precision numbers with 8 decimal places. - - must be at most 11 characters long - only consist of ASCII letters (a-zA-Z). - - integer part of may be at most 2^52. - - fractional part of may contain at most 8 decimal digits. + have a currency agnostic amount_lib.ml + and specialize amount.ml to Config.currency?? - Prefixed with '+' or '-' in certain contexts. - When no sign is present, the amount is assumed to be positive. *) + no Zarith + have safe amount arithmetic *) type sign = | Sign_plus | Sign_minus @@ -22,23 +15,70 @@ type t = { fraction: Int32.t; } -let ( let* ) o f = match o with Ok v -> f v | Error _ as e -> e -let check_not msg = function false -> Ok () | true -> Error msg let value_upper_bound = Z.(pow (of_int 2) 52) |> Z.to_int64 + +(* TODO + the constraint is on the number of digits, + so this wrong if leading 0s + this depends on currency..? *) let fraction_upper_bound = Int32.of_int 100_000_000 let make ~sign ~currency ~value ~fraction = - let* () = check_not "value is negative" (value < Int64.zero) in - let* () = check_not "fraction is negative" (fraction < Int32.zero) in + let ( let* ) o f = match o with _e, false -> f () | e, true -> Error e in + let* () = ("value is negative", value < Int64.zero) in + let* () = ("fraction is negative", fraction < Int32.zero) in + let* () = ("value is greater than 2^52-1", value > value_upper_bound) in let* () = - check_not "value is greater than 2^52" (value > value_upper_bound) - in - let* () = - check_not "fraction has more than 8 decimal digits" - (fraction >= fraction_upper_bound) + ("fraction has more than 8 decimal digits", fraction >= fraction_upper_bound) in Ok { sign; currency; value; fraction } +module Parse = struct + open Angstrom + + let sign = + char '+' *> return (Some Sign_plus) + <|> char '-' *> return (Some Sign_minus) + <|> return None + + let currency = + take_while1 (function 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false) + >>= fun s -> + match String.length s < 12 with + | false -> fail "currency is more than 11 characters" + | true -> return s + + let int64 = + take_while1 (function '0' .. '9' -> true | _ -> false) + >>| Int64.of_string_opt + >>= function + | None -> fail "value is not a valid int64" + | Some n when n >= value_upper_bound -> fail "value is greater than 2^52-1" + | Some n -> return n + + let int32 = + take_while1 (function '0' .. '9' -> true | _ -> false) + >>| Int32.of_string_opt + >>= function + | None -> fail "fraction is not a valid int32" + | Some n when n >= fraction_upper_bound -> + fail "fraction is greater than 10^8-1" + | Some n -> return n + + let amount = + lift4 + (fun sign currency value fraction -> + make ~sign ~currency ~value ~fraction) + sign currency + (char ':' *> int64) + (char '.' *> int32 <|> return 0_l) + <* end_of_input + + let f s = parse_string ~consume:Consume.All amount s |> Result.join +end + +let of_string = Parse.f + let pp = let open Fmt in let pp_sign ppf = function @@ -46,53 +86,20 @@ let pp = | Sign_minus -> char ppf '-' in fun ppf { sign; currency; value; fraction } -> + (* TODO + this depends on the currency's number of fraction digits *) pf ppf "%a%s:%Ld.%02ld" (Fmt.option pp_sign) sign currency value fraction let to_string = Fmt.str "%a" pp -let of_string = - let open Angstrom in - let parse_sign = - choice - [ - char '+' *> return (Some Sign_plus); - char '-' *> return (Some Sign_minus); - return None; - ] - in - let parse_currency = - (* TODO currency string constraint/format *) - take_while1 (function - | 'a' .. 'z' | 'A' .. 'Z' -> true - | _ -> false) - in - let parse_int64 = - take_while1 (function '0' .. '9' -> true | _ -> false) - >>| Int64.of_string_opt - >>= function - | None -> fail "invalid integer" - | Some n -> return n - in - let parse_int32 = - take_while1 (function '0' .. '9' -> true | _ -> false) - >>| Int32.of_string_opt - >>= function - | None -> fail "invalid integer" - | Some n -> return n - in - let parse_t = - lift4 - (fun sign currency value fraction -> - make ~sign ~currency ~value ~fraction) - parse_sign parse_currency - (char ':' *> parse_int64) - (char '.' *> parse_int32) - in - fun s -> parse_string ~consume:Consume.All parse_t s |> Result.join +(* - *) let jsont = Jsont.of_of_string ~kind:"Amount" of_string ~enc:to_string + +(* byte length of currency string *) let currency_len = 12 +(* TODO error *) let pad_currency s = let len = String.length s in assert (len <= 11); @@ -117,5 +124,3 @@ let bin_nbo = |+ field beint32 (fun t -> t.fraction) |+ field (bytes currency_len) (fun t -> pad_currency t.currency) |> sealr - -let dummy_value = "DUMMY:0.0" |> of_string |> Result.get_ok diff --git a/src/amount.mli b/src/amount.mli index 920bed18..f055430c 100644 --- a/src/amount.mli +++ b/src/amount.mli @@ -1,6 +1,3 @@ -(* TODO - ? have a currency agnostic amount_lib.ml and specialize amount.ml to Config.currency *) - type sign = | Sign_plus | Sign_minus @@ -22,13 +19,9 @@ val make : val pp : Format.formatter -> t -> unit val to_string : t -> string val of_string : string -> (t, string) result -val currency_len : int -val jsont : t Jsont.t -(* only for encoding *) +(* - *) +val jsont : t Jsont.t val bin : t Bin.t val bin_nbo : t Bin.t - -(* TODO - dummy value to use as placeholder for WIP *) -val dummy_value : t +(* [caqti] is in pg_type.ml *)