diff options
Diffstat (limited to 'lib/ledger.ml')
-rw-r--r-- | lib/ledger.ml | 46 |
1 files changed, 38 insertions, 8 deletions
diff --git a/lib/ledger.ml b/lib/ledger.ml index fd1b2a9..1d9a63c 100644 --- a/lib/ledger.ml +++ b/lib/ledger.ml | |||
@@ -98,13 +98,43 @@ module Account_id_key = struct | |||
98 | type comparator_witness | 98 | type comparator_witness |
99 | end | 99 | end |
100 | 100 | ||
101 | type tx = { | 101 | module Tx : sig |
102 | cleared : Date.t option; | 102 | type t |
103 | commodity_id : commodity_id; | 103 | type error = Unbalanced |
104 | debit : scalar Map.M(Account_id_key).t; | 104 | |
105 | credit : scalar Map.M(Account_id_key).t; | 105 | val make : |
106 | labels : Labels.t; | 106 | cleared:Date.t option -> |
107 | } | 107 | commodity_id:commodity_id -> |
108 | debit:scalar Map.M(Account_id_key).t -> | ||
109 | credit:scalar Map.M(Account_id_key).t -> | ||
110 | labels:Labels.t -> | ||
111 | (t, error) result | ||
112 | |||
113 | val cleared : t -> Date.t option | ||
114 | val commodity_id : t -> commodity_id | ||
115 | val debit : t -> scalar Map.M(Account_id_key).t | ||
116 | val credit : t -> scalar Map.M(Account_id_key).t | ||
117 | val labels : t -> Labels.t | ||
118 | end = struct | ||
119 | (* We hide this because we only want to allow constructing balanced transactions *) | ||
120 | type t = { | ||
121 | cleared : Date.t option; | ||
122 | commodity_id : commodity_id; | ||
123 | debit : scalar Map.M(Account_id_key).t; | ||
124 | credit : scalar Map.M(Account_id_key).t; | ||
125 | labels : Labels.t; | ||
126 | } | ||
127 | [@@deriving fields] | ||
128 | |||
129 | type error = Unbalanced | ||
130 | |||
131 | (* TODO: check if debits and credits are balanced *) | ||
132 | let is_balanced _debits _credits = true | ||
133 | |||
134 | let make ~cleared ~commodity_id ~debit ~credit ~labels = | ||
135 | if not (is_balanced debit credit) then Error Unbalanced | ||
136 | else Ok { cleared; commodity_id; debit; credit; labels } | ||
137 | end | ||
108 | 138 | ||
109 | type item = Tx_item of tx | Bal_assert_item of bal_assert | 139 | type item = Tx_item of Tx.t | Bal_assert_item of bal_assert |
110 | type ledger = Ledger of item list | 140 | type ledger = Ledger of item list |