swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Browse source
This commit is contained in:
swrup 2026-03-03 00:53:35 +01:00
parent f35950dbf0
commit 38cf8ae569
2 changed files with 86 additions and 89 deletions
Download patch file Download diff file Expand all files Collapse all files

170
src/amount.ml
View file

@ -16,14 +16,12 @@ type t = {
fraction: Int32.t; fraction: Int32.t;
} }
let maximum_currency_length = 11 let currency_length_limit = 12
let value_upper_bound = Int64.of_float @@ Float.pow 2. 52. let value_limit = Int64.add 1_L (Int64.of_float (Float.pow 2. 52.))
let fraction_max_number_of_digits = 8 let fraction_nb_digits = 8
(* TODO choose to either include or exclude upper limit for all bounds let fraction_limit =
need a -1 here *) Int32.of_float (Float.pow 10. (Int.to_float fraction_nb_digits))
let fraction_upper_bound =
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_letter = function 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false
let is_digit = function '0' .. '9' -> true | _ -> false let is_digit = function '0' .. '9' -> true | _ -> false
@ -34,20 +32,17 @@ let check_currency s =
else else
let len = String.length s in let len = String.length s in
if len = 0 then Error "currency is empty string" if len = 0 then Error "currency is empty string"
else if len > maximum_currency_length then else if len < currency_length_limit then Ok ()
Fmt.error "currency is more than %d characters long" else
maximum_currency_length Fmt.error "currency is more than %d characters long" currency_length_limit
else Ok ()
let check_value v = let check_value v =
if Int64.unsigned_compare v value_upper_bound > 0 then if Int64.unsigned_compare v value_limit < 0 then Ok ()
Error "value is greater than 2^52" else Error "value is greater than 2^52"
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_limit < 0 then Ok ()
Fmt.error "fraction has more than %d digits" fraction_max_number_of_digits else Fmt.error "fraction has more than %d digits" fraction_nb_digits
else Ok ()
let make ~sign ~currency ~value ~fraction = let make ~sign ~currency ~value ~fraction =
let* () = check_currency currency in let* () = check_currency currency in
@ -56,93 +51,99 @@ let make ~sign ~currency ~value ~fraction =
let currency = String.uppercase_ascii currency in let currency = String.uppercase_ascii currency in
Ok { sign; currency; value; fraction } Ok { sign; currency; value; fraction }
(* module Parser = struct
let config_currency = open Angstrom
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 letters = take_while1 is_letter
let* () = check_value value in let digits = take_while1 is_digit
let* () = check_fraction fraction in
Ok { sign= None; currency= config_currency; value; fraction }
*)
open Angstrom let sign =
choice
[
char '+' *> return (Some Sign_plus);
char '-' *> return (Some Sign_minus);
return None;
]
let letters = take_while1 is_letter let value =
let digits = take_while1 is_digit digits >>= fun s ->
match Int64.of_string_opt s with
| None -> fail "not a valid int64"
| Some n -> return n
let sign = let fraction =
choice digits >>= fun s ->
[ let len = String.length s in
char '+' *> return (Some Sign_plus); match len <= fraction_nb_digits with
char '-' *> return (Some Sign_minus); | false ->
return None; fail (Fmt.str "fraction has more than %d digits" fraction_nb_digits)
] | true -> (
match Int32.of_string_opt s with
| None -> fail "not a valid int32"
| Some n ->
let magnitude =
let exp = Int.to_float (fraction_nb_digits - len) in
Int32.of_float @@ Float.pow 10. exp
in
let n = Int32.mul n magnitude in
return n)
let value = let amount =
digits >>= fun s -> lift4
match Int64.of_string_opt s with (fun sign currency value fraction ->
| None -> fail "not a valid int64" make ~sign ~currency ~value ~fraction)
| Some n -> return n sign letters
(char ':' *> value)
(option 0_l (char '.' *> fraction))
<* end_of_input
let fraction = let parse s =
digits >>= fun s -> Angstrom.parse_string ~consume:Consume.All amount s |> Result.join
let len = String.length s in end
match len <= fraction_max_number_of_digits with
| false ->
fail
(Fmt.str "fraction has more than %d digits"
fraction_max_number_of_digits)
| true -> (
match Int32.of_string_opt s with
| None -> fail "not a valid int32"
| Some n ->
let magnitude =
let exp = Int.to_float (fraction_max_number_of_digits - len) in
Int32.of_float @@ Float.pow 10. exp
in
let n = Int32.mul n magnitude in
return n)
let amount = let of_string = Parser.parse
lift4
(fun sign currency value fraction -> make ~sign ~currency ~value ~fraction)
sign letters
(char ':' *> value)
(option 0_l (char '.' *> fraction))
<* end_of_input
let of_string s = parse_string ~consume:Consume.All amount s |> Result.join
(* TODO have pretty print without trailing zeros *)
let pp = let pp =
let open Fmt in let open Fmt in
let pp_sign ppf = function let pp_sign =
| Sign_plus -> char ppf '+' let pp ppf = function
| Sign_minus -> char ppf '-' | Sign_plus -> char ppf '+'
| Sign_minus -> char ppf '-'
in
Fmt.option pp
in
let rec rm_trailing_zero count x =
if x <> 0_l && Int32.rem x 10_l = 0_l then
rm_trailing_zero (succ count) (Int32.div x 10_l)
else (count, x)
in
let pp_fraction ppf fraction =
match fraction = 0_l with
| true -> Fmt.nop ppf ()
| false ->
let count, x = rm_trailing_zero 0 fraction in
pf ppf ".%0*lu" (fraction_nb_digits - count) x
in in
fun ppf { sign; currency; value; fraction } -> fun ppf { sign; currency; value; fraction } ->
(* TODO pf ppf "%a%s:%Lu%a" pp_sign sign currency value pp_fraction fraction
depends on the currency's number of fraction digits *)
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
(* - *) (* - *)
let jsont = Jsont.of_of_string ~kind:"Amount" of_string ~enc:to_string let jsont = Jsont.of_of_string ~kind:"Amount" of_string ~enc:to_string
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_length); match len < currency_length_limit with
let b = Bytes.make currency_length '\x00' in | false -> Fmt.failwith "amount with invalid currency"
Bytes.blit_string s 0 b 0 len; | true ->
Bytes.to_string b let b = Bytes.make currency_length_limit '\x00' in
Bytes.blit_string s 0 b 0 len;
Bytes.unsafe_to_string b
(* binary decoding unused? *) (* binary decoding never unused *)
let make_exn value fraction currency = let make_exn value fraction currency =
match make ~sign:None ~currency ~value ~fraction with match make ~sign:None ~currency ~value ~fraction with
| Error _ -> Fmt.failwith "Amount of binary data failure" | Error _ -> Fmt.failwith "Amount of binary data failure"
@ -152,6 +153,7 @@ let bin =
let open Bin in let open Bin in
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 -> t.fraction)
|+ field (bytes currency_length) (fun t -> pad_currency_string t.currency) |+ field (bytes currency_length_limit) (fun t ->
pad_currency_string t.currency)
|> sealr |> sealr

5
src/amount.mli
View file

@ -16,11 +16,6 @@ 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