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