126 lines
3.4 KiB
OCaml
126 lines
3.4 KiB
OCaml
(* 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
|
|
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 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
|