121 lines
3.5 KiB
OCaml
121 lines
3.5 KiB
OCaml
(* TODO
|
|
have safe amount arithmetic
|
|
make type private
|
|
redefine an Amount module with currency enforced to be Config.currency? *)
|
|
(* Amounts of currency, serialized as `<Currency>:<IntegerPart>.<FractionalPart>`
|
|
Fixed-precision numbers with 8 decimal places.
|
|
- <Currency> must be at most 11 characters long
|
|
only consist of ASCII letters (a-zA-Z).
|
|
- integer part of <DecimalAmount> may be at most 2^52.
|
|
- fractional part of <DecimalAmount> may contain at most 8 decimal digits.
|
|
|
|
Prefixed with '+' or '-' in certain contexts.
|
|
When no sign is present, the amount is assumed to be positive. *)
|
|
type sign =
|
|
| Sign_plus
|
|
| Sign_minus
|
|
|
|
type t = {
|
|
sign: sign option;
|
|
currency: string;
|
|
value: Int64.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
|
|
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* () =
|
|
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)
|
|
in
|
|
Ok { sign; currency; value; fraction }
|
|
|
|
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 } ->
|
|
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
|
|
let currency_len = 12
|
|
|
|
let pad_currency s =
|
|
let len = String.length s in
|
|
assert (len <= 11);
|
|
let b = Bytes.make 12 '\x00' in
|
|
Bytes.blit_string s 0 b 0 len;
|
|
Bytes.to_string b
|
|
|
|
let bin =
|
|
let open Bin in
|
|
record (fun _value _fraction _currency ->
|
|
(* no need to decode amount? *)
|
|
assert false)
|
|
|+ field neint64 (fun t -> t.value)
|
|
|+ field neint32 (fun t -> t.fraction)
|
|
|+ field (bytes currency_len) (fun t -> pad_currency t.currency)
|
|
|> sealr
|
|
|
|
let bin_nbo =
|
|
let open Bin in
|
|
record (fun _value _fraction _currency -> assert false)
|
|
|+ field beint64 (fun t -> t.value)
|
|
|+ 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
|