better amount.ml
This commit is contained in:
parent
bc1cc013ee
commit
98ba917cfb
4 changed files with 82 additions and 85 deletions
152
src/amount.ml
152
src/amount.ml
|
|
@ -1,16 +1,8 @@
|
|||
(* 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.
|
||||
have a currency agnostic amount_lib.ml
|
||||
and specialize amount.ml to Config.currency??
|
||||
|
||||
Prefixed with '+' or '-' in certain contexts.
|
||||
When no sign is present, the amount is assumed to be positive. *)
|
||||
have safe amount arithmetic *)
|
||||
type sign =
|
||||
| Sign_plus
|
||||
| Sign_minus
|
||||
|
|
@ -22,22 +14,67 @@ type 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 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 =
|
||||
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 }
|
||||
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
|
||||
|
|
@ -46,76 +83,45 @@ let pp =
|
|||
| Sign_minus -> char ppf '-'
|
||||
in
|
||||
fun ppf { sign; currency; value; fraction } ->
|
||||
(* TODO
|
||||
depends on the currency's number of fraction digits
|
||||
assumes value and fraction are in bounds *)
|
||||
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
|
||||
|
||||
(* byte length of currency string *)
|
||||
let currency_len = 12
|
||||
|
||||
let pad_currency s =
|
||||
let pad_currency_string s =
|
||||
let len = String.length s in
|
||||
assert (len <= 11);
|
||||
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 (fun _value _fraction _currency ->
|
||||
(* no need to decode amount? *)
|
||||
assert false)
|
||||
record make_exn
|
||||
|+ field neint64 (fun t -> t.value)
|
||||
|+ field neint32 (fun t -> t.fraction)
|
||||
|+ field (bytes currency_len) (fun t -> pad_currency t.currency)
|
||||
|+ field (bytes currency_len) (fun t -> pad_currency_string t.currency)
|
||||
|> sealr
|
||||
|
||||
let bin_nbo =
|
||||
let open Bin in
|
||||
record (fun _value _fraction _currency -> assert false)
|
||||
record make_exn
|
||||
|+ field beint64 (fun t -> t.value)
|
||||
|+ field beint32 (fun t -> t.fraction)
|
||||
|+ field (bytes currency_len) (fun t -> pad_currency t.currency)
|
||||
|+ field (bytes currency_len) (fun t -> pad_currency_string t.currency)
|
||||
|> sealr
|
||||
|
||||
let dummy_value = "DUMMY:0.0" |> of_string |> Result.get_ok
|
||||
|
|
|
|||
|
|
@ -1,6 +1,3 @@
|
|||
(* TODO
|
||||
? have a currency agnostic amount_lib.ml and specialize amount.ml to Config.currency *)
|
||||
|
||||
type sign =
|
||||
| Sign_plus
|
||||
| Sign_minus
|
||||
|
|
@ -22,13 +19,9 @@ val make :
|
|||
val pp : Format.formatter -> t -> unit
|
||||
val to_string : t -> string
|
||||
val of_string : string -> (t, string) result
|
||||
val currency_len : int
|
||||
val jsont : t Jsont.t
|
||||
|
||||
(* only for encoding *)
|
||||
(* - *)
|
||||
val jsont : t Jsont.t
|
||||
val bin : t Bin.t
|
||||
val bin_nbo : t Bin.t
|
||||
|
||||
(* TODO
|
||||
dummy value to use as placeholder for WIP *)
|
||||
val dummy_value : t
|
||||
(* [caqti] is in pg_type.ml *)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue