mte/src/amount.ml

(* TODO
     have safe amount arithmetic
     make type private
     use config currency option *)
(* 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 t = {
  sign: [ `Plus | `Minus ] option;
  currency: [ `Eur ];
  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 to_string =
  let pp =
    let open Fmt in
    let pp_sign ppf = function
      | `Plus -> char ppf '+'
      | `Minus -> char ppf '-'
    in
    let pp_currency ppf = function `Eur -> string ppf "EUR" in
    fun ppf { sign; currency; value; fraction } ->
      pf ppf "%a%a:%Ld.%02ld" (Fmt.option pp_sign) sign pp_currency currency
        value fraction
  in
  Fmt.str "%a" pp

let of_string =
  let open Angstrom in
  let parse_sign =
    choice
      [
        char '+' *> return (Some `Plus); char '-' *> return (Some `Minus);
        return None;
      ]
  in
  let parse_currency = string "EUR" *> return `Eur 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