oha!

1 files changed, 79 insertions, 0 deletions

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