mte/lib/amount.ml

(* 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