diff options
Diffstat (limited to 'lib/ledger.ml')
-rw-r--r-- | lib/ledger.ml | 110 |
1 files changed, 110 insertions, 0 deletions
diff --git a/lib/ledger.ml b/lib/ledger.ml new file mode 100644 index 0000000..fd1b2a9 --- /dev/null +++ b/lib/ledger.ml | |||
@@ -0,0 +1,110 @@ | |||
1 | open Core | ||
2 | |||
3 | type account_type = Asset | Equity | Liability | Expense | Income | ||
4 | |||
5 | type tx_type = | ||
6 | | Interest_tx | ||
7 | | Online_banking_tx | ||
8 | | Recurrent_direct_tx | ||
9 | | Payment_terminal_tx | ||
10 | | Cash_payment_tx | ||
11 | | Atm_tx | ||
12 | | Auto_save_rounding_tx | ||
13 | | Batch_tx | ||
14 | | Direct_debit_tx | ||
15 | | Periodic_tx | ||
16 | |||
17 | type iban_tag = Account_tag | Counterparty_iban_tag [@@deriving compare] | ||
18 | |||
19 | type unit_tag = Filed_tag | GooglePay_tag | AutoRoundSavings_tag | ||
20 | [@@deriving compare] | ||
21 | |||
22 | type string_tag = | ||
23 | | Desc_tag | ||
24 | | User_tag | ||
25 | | Counterparty_name_tag | ||
26 | | Reference_tag | ||
27 | | Mandate_id_tag | ||
28 | | Creditor_id_tag | ||
29 | | Other_party_tag | ||
30 | | Transaction_tag | ||
31 | | Terminal_tag | ||
32 | | Card_seq_no_tag | ||
33 | | Savings_account_tag | ||
34 | [@@deriving compare] | ||
35 | |||
36 | module Label = struct | ||
37 | type 'a t = | ||
38 | | Iban_label : iban_tag -> Iban.t t | ||
39 | | String_label : string_tag -> string t | ||
40 | | Timestamp_label : Time_ns.t t | ||
41 | | Unit_label : unit_tag -> unit t | ||
42 | |||
43 | let int_to_cmp x : ('a, 'a) Dmap.cmp = | ||
44 | if x < 0 then Lt else if x > 0 then Gt else Eq | ||
45 | |||
46 | let compare (type a1 a2) (v1 : a1 t) (v2 : a2 t) : (a1, a2) Dmap.cmp = | ||
47 | match (v1, v2) with | ||
48 | | Iban_label t1, Iban_label t2 -> int_to_cmp @@ [%compare: iban_tag] t1 t2 | ||
49 | | String_label t1, String_label t2 -> | ||
50 | int_to_cmp @@ [%compare: string_tag] t1 t2 | ||
51 | | Timestamp_label, Timestamp_label -> Eq | ||
52 | | Unit_label t1, Unit_label t2 -> int_to_cmp @@ [%compare: unit_tag] t1 t2 | ||
53 | | Iban_label _, _ -> Lt | ||
54 | | String_label _, Iban_label _ -> Gt | ||
55 | | String_label _, _ -> Lt | ||
56 | | Timestamp_label, Unit_label _ -> Lt | ||
57 | | Timestamp_label, _ -> Gt | ||
58 | | Unit_label _, _ -> Gt | ||
59 | end | ||
60 | |||
61 | module Labels = Dmap.Make (Label) | ||
62 | |||
63 | module Money : sig | ||
64 | type t | ||
65 | |||
66 | val equal : t -> t -> bool | ||
67 | val compare : t -> t -> int | ||
68 | val of_z : Z.t -> t | ||
69 | val to_z : t -> Z.t | ||
70 | val ( + ) : t -> t -> t | ||
71 | val ( - ) : t -> t -> t | ||
72 | end = struct | ||
73 | type t = Z.t | ||
74 | |||
75 | let equal = Z.equal | ||
76 | let compare = Z.compare | ||
77 | let of_z = Fn.id | ||
78 | let to_z = Fn.id | ||
79 | let ( + ) x y = Z.(x + y) | ||
80 | let ( - ) x y = Z.(x - y) | ||
81 | end | ||
82 | |||
83 | type scalar = Amount of Money.t | Rate of Z.t [@@deriving equal, compare] | ||
84 | type account_id = string list | ||
85 | type commodity_id = string (* TODO: consider making this UUID *) | ||
86 | |||
87 | type account = { | ||
88 | id : account_id; | ||
89 | description : string list; | ||
90 | commodity_id : commodity_id; | ||
91 | balance : Money.t; | ||
92 | } | ||
93 | |||
94 | type bal_assert = { account : account_id; amount : Money.t; labels : Labels.t } | ||
95 | |||
96 | module Account_id_key = struct | ||
97 | type t = account_id | ||
98 | type comparator_witness | ||
99 | end | ||
100 | |||
101 | type tx = { | ||
102 | cleared : Date.t option; | ||
103 | commodity_id : commodity_id; | ||
104 | debit : scalar Map.M(Account_id_key).t; | ||
105 | credit : scalar Map.M(Account_id_key).t; | ||
106 | labels : Labels.t; | ||
107 | } | ||
108 | |||
109 | type item = Tx_item of tx | Bal_assert_item of bal_assert | ||
110 | type ledger = Ledger of item list | ||