blob: a06af64784ef564955bbc3b460eb6e20ce016540 (
about) (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
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
|
