From c90ff5253efd858a2bf0c20eaa2ee9763a402783 Mon Sep 17 00:00:00 2001 From: Rutger Broekhoff Date: Mon, 9 Mar 2026 22:29:18 +0100 Subject: oha! --- lib/money.ml | 79 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 79 insertions(+) create mode 100644 lib/money.ml (limited to 'lib/money.ml') diff --git a/lib/money.ml b/lib/money.ml new file mode 100644 index 0000000..a06af64 --- /dev/null +++ b/lib/money.ml @@ -0,0 +1,79 @@ +open Prelude + +type polarity = Increase_on_debit | Increase_on_credit + +module Debit_credit = struct + type t = Debit | Credit [@@deriving string, sexp_of] + + (* let opposite = function Debit -> Credit | Credit -> Debit *) +end + +module Amount : sig + type t + + val equal : t -> t -> bool + val compare : t -> t -> int + val of_bigint : Bigint.t -> t option + val to_bigint : t -> Bigint.t + val ( + ) : t -> t -> t + val ( = ) : t -> t -> bool + val sexp_of_t : t -> Sexp.t + val zero : t +end = struct + type t = Bigint.t [@@deriving sexp_of] + + let equal = Bigint.equal + let compare = Bigint.compare + let of_bigint x = if Bigint.(zero <= x) then Some x else None + let to_bigint x = x + let ( + ) x y = Bigint.(x + y) + let ( = ) = equal + let zero = Bigint.zero +end + +module Diff : sig + type t + + val equal : t -> t -> bool + val compare : t -> t -> int + val of_bigint : Bigint.t -> t + val to_bigint : t -> Bigint.t + val ( + ) : t -> t -> t + val ( +% ) : t -> Amount.t -> t + val ( - ) : t -> t -> t + val ( -% ) : t -> Amount.t -> t + val ( = ) : t -> t -> bool + val neg : t -> t + val ( ~$ ) : int -> t + val sexp_of_t : t -> Sexp.t + val of_amount : Amount.t -> Debit_credit.t -> polarity -> t +end = struct + type t = Bigint.t [@@deriving sexp_of] + + let equal = Bigint.equal + let compare = Bigint.compare + let of_bigint x = x + let to_bigint x = x + let ( + ) x y = Bigint.(x + y) + let ( +% ) x y = x + of_bigint (Amount.to_bigint y) + let ( - ) x y = Bigint.(x - y) + let ( -% ) x y = x - of_bigint (Amount.to_bigint y) + let ( = ) = equal + let neg = Bigint.neg + let ( ~$ ) = Fn.compose of_bigint Bigint.of_int + + let of_amount x (dc : Debit_credit.t) (on_debit : polarity) = + match (dc, on_debit) with + | Debit, Increase_on_debit -> of_bigint (Amount.to_bigint x) + | Credit, Increase_on_debit -> neg (of_bigint (Amount.to_bigint x)) + | Credit, Increase_on_credit -> of_bigint (Amount.to_bigint x) + | Debit, Increase_on_credit -> neg (of_bigint (Amount.to_bigint x)) +end + +module Commodity_id = struct + type t = string [@@deriving equal, compare, sexp] + + module Map = Map.Make (struct + type nonrec t = t [@@deriving equal, compare, sexp] + end) +end -- cgit v1.3