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