(* TODO have a currency agnostic amount_lib.ml and specialize amount.ml to Config.currency?? have safe amount arithmetic *) type sign = | Sign_plus | Sign_minus type t = { sign: sign option; currency: string; value: Int64.t; fraction: Int32.t; } let value_upper_bound = Int64.of_float @@ Float.pow 2. 52. (* 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 = if value < Int64.zero then Error "value is negative" else if fraction < Int32.zero then Error "fraction is negative" else if value > value_upper_bound then Error "value is greater than 2^52-1" else if fraction >= fraction_upper_bound then Error "fraction has more than 8 decimal digits" else 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 | Sign_plus -> char ppf '+' | Sign_minus -> char ppf '-' in fun ppf { sign; currency; value; fraction } -> (* TODO depends on the currency's number of fraction digits *) pf ppf "%a%s:%Lu.%02lu" (Fmt.option pp_sign) sign currency value fraction let to_string = Fmt.str "%a" pp (* - *) let jsont = Jsont.of_of_string ~kind:"Amount" of_string ~enc:to_string (* byte length of currency string *) let currency_len = 12 let pad_currency_string s = let len = String.length s in assert (len < currency_len); let b = Bytes.make 12 '\x00' in Bytes.blit_string s 0 b 0 len; Bytes.to_string b (* binary decoding unused? *) let make_exn value fraction currency = match make ~sign:None ~currency ~value ~fraction with | Error _ -> Fmt.failwith "Amount of binary data failure" | Ok v -> v let bin = let open Bin in record make_exn |+ field neint64 (fun t -> t.value) |+ field neint32 (fun t -> t.fraction) |+ field (bytes currency_len) (fun t -> pad_currency_string t.currency) |> sealr let bin_nbo = let open Bin in record make_exn |+ field beint64 (fun t -> t.value) |+ field beint32 (fun t -> t.fraction) |+ field (bytes currency_len) (fun t -> pad_currency_string t.currency) |> sealr