summaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/dune5
-rw-r--r--lib/iban.ml87
-rw-r--r--lib/iban.mli8
-rw-r--r--lib/ingcsv.ml487
-rw-r--r--lib/ledger.ml110
5 files changed, 697 insertions, 0 deletions
diff --git a/lib/dune b/lib/dune
new file mode 100644
index 0000000..ff9a2ee
--- /dev/null
+++ b/lib/dune
@@ -0,0 +1,5 @@
1(library
2 (name rdcapsis)
3 (preprocess
4 (pps ppx_jane))
5 (libraries core zarith dmap delimited_parsing re core_unix.date_unix))
diff --git a/lib/iban.ml b/lib/iban.ml
new file mode 100644
index 0000000..6e47e9d
--- /dev/null
+++ b/lib/iban.ml
@@ -0,0 +1,87 @@
1open Core
2open Option.Let_syntax
3
4type t = string
5
6(* Modulo-97 arithmetic. Prevents us from having to use Zarith here. *)
7module M97 : sig
8 type t
9
10 val of_int : int -> t
11 val lt : t -> t -> bool
12 val equal : t -> t -> bool
13 val ( * ) : t -> t -> t
14 val ( + ) : t -> t -> t
15 val ( ~$ ) : int -> t
16end = struct
17 type t = int
18
19 let of_int x = x % 97
20 let equal = Int.( = )
21 let lt = Int.( < )
22 let ( * ) x y = x * y % 97
23 let ( + ) x y = (x + y) % 97
24 let ( ~$ ) = of_int
25end
26
27let m97_of_alnum c =
28 let v = Char.to_int c in
29 if Char.is_digit c then Some (M97.of_int (v - Char.to_int '0'))
30 else if Char.is_alpha c then
31 if Char.is_lowercase c then Some (M97.of_int (v - Char.to_int 'a' + 10))
32 else Some (M97.of_int (v - Char.to_int 'A' + 10))
33 else None
34
35let m97_of_digit c =
36 match m97_of_alnum c with Some v when M97.(lt v ~$10) -> Some v | _ -> None
37
38let m97_of_alpha c =
39 match m97_of_alnum c with
40 | Some v when not M97.(lt v ~$10) -> Some v
41 | _ -> None
42
43let string_fold_option ~(init : 'a) ~(f : 'a -> char -> 'a option) s =
44 let rec go i (acc : 'a) : 'a option =
45 if i >= String.length s then Some acc
46 else Option.(f acc (String.unsafe_get s i) >>= go (i + 1))
47 in
48 go 0 init
49
50let m97_of_iban s =
51 string_fold_option s ~init:`In_country1 ~f:(fun st c ->
52 match st with
53 | `In_country1 ->
54 let%map co1 = m97_of_alpha c in
55 `In_country2 co1
56 | `In_country2 co1 ->
57 let%map co2 = m97_of_alpha c in
58 `In_check1 M97.((co1 * ~$100) + co2)
59 | `In_check1 co ->
60 let%map ch1 = m97_of_digit c in
61 `In_check2 (co, ch1)
62 | `In_check2 (co, ch1) ->
63 let%map ch2 = m97_of_digit c in
64 `In_bban M97.(co, (ch1 * ~$10) + ch2, ~$0)
65 | `In_bban (co, ch, bban) ->
66 let%map v = m97_of_alnum c in
67 let bban' =
68 M97.(if lt v ~$10 then (bban * ~$10) + v else (bban * ~$100) + v)
69 in
70 `In_bban (co, ch, bban'))
71 |> function
72 | Some (`In_bban (co, ch, bban)) ->
73 Some M97.((bban * ~$1000000) + (co * ~$100) + ch)
74 | _ -> None
75
76let check_iban s =
77 String.length s <= 34 && Option.exists (m97_of_iban s) ~f:M97.(equal ~$1)
78
79let make s : t option = if check_iban s then Some s else None
80let to_string = Fn.id
81
82let of_string s =
83 match make s with
84 | Some iban -> iban
85 | None -> Printf.failwithf "Iban.of_string: %S" s ()
86
87let equal = String.equal
diff --git a/lib/iban.mli b/lib/iban.mli
new file mode 100644
index 0000000..944928c
--- /dev/null
+++ b/lib/iban.mli
@@ -0,0 +1,8 @@
1open Core
2
3type t
4
5val make : string -> t option
6
7include Stringable.S with type t := t
8include Equal.S with type t := t
diff --git a/lib/ingcsv.ml b/lib/ingcsv.ml
new file mode 100644
index 0000000..a8eba51
--- /dev/null
+++ b/lib/ingcsv.ml
@@ -0,0 +1,487 @@
1open Core
2module Time_ns = Time_ns_unix
3
4module Debit_credit = struct
5 type t = Debit | Credit
6
7 let of_string = function
8 | "Debit" -> Debit
9 | "Credit" -> Credit
10 | s -> Printf.failwithf "DebitCredit.of_string: %S" s ()
11
12 let to_string = function Debit -> "Debit" | Credit -> "Credit"
13end
14
15module Cents = struct
16 type t = Z.t
17
18 let of_string s =
19 (* TODO: consider being more bitchy here *)
20 String.lsplit2_exn s ~on:',' |> Tuple2.map ~f:Z.of_string
21 |> fun (high, low) -> Z.((high * ~$100) + low)
22end
23
24module Transaction_type = struct
25 type t =
26 | Accept_giro (* AC (acceptgiro) *)
27 | Atm_withdrawal (* GM (geldautomaat, Giromaat) *)
28 | Batch_payment (* VZ (verzamelbetaling); 'Batch payment' *)
29 | Branch_posting (* FL (filiaalboeking) *)
30 | Deposit (* ST (storting) *)
31 | Direct_debit (* IC (incasso); 'SEPA direct debit' *)
32 | Ideal (* ID (iDEAL); 'iDEAL' *)
33 | Online_banking (* GT (internetbankieren, Girotel); 'Online Banking' *)
34 | Office_withdrawal (* PK (opname kantoor, postkantoor) *)
35 | Payment_terminal (* BA (betaalautomaat); 'Payment terminal' *)
36 | Periodic_transfer (* PO (periodieke overschrijving) *)
37 | Phone_banking (* GF (telefonisch bankieren, Girofoon) *)
38 | Transfer (* OV (overboeking); 'Transfer' *)
39 | Various (* DV (diversen) *)
40 [@@deriving equal, string]
41
42 let of_code = function
43 | "AC" -> Accept_giro
44 | "GM" -> Atm_withdrawal
45 | "VZ" -> Batch_payment
46 | "FL" -> Branch_posting
47 | "ST" -> Deposit
48 | "IC" -> Direct_debit
49 | "ID" -> Ideal
50 | "GT" -> Online_banking
51 | "PK" -> Office_withdrawal
52 | "BA" -> Payment_terminal
53 | "PO" -> Periodic_transfer
54 | "GF" -> Phone_banking
55 | "OV" -> Transfer
56 | "DV" -> Various
57 | s -> Printf.failwithf "TransactionType.of_code: %S" s ()
58
59 let of_type = function
60 | "SEPA direct debit" -> Direct_debit
61 | "Batch payment" -> Batch_payment
62 | "Online Banking" -> Online_banking
63 | "Payment terminal" -> Payment_terminal
64 | "Transfer" -> Transfer
65 | "iDEAL" -> Ideal
66 | s -> Printf.failwithf "TransactionType.of_type: %S" s ()
67end
68
69module Primitive_tx = struct
70 type t = {
71 date : Date.t;
72 description : string;
73 account : Iban.t;
74 counterparty : Iban.t option;
75 type_ : Transaction_type.t;
76 debit_credit : Debit_credit.t;
77 amount : Cents.t;
78 notifications : string;
79 resulting_balance : Cents.t;
80 tag : string;
81 }
82 [@@deriving fields]
83
84 let opt_field (f : string -> 'a) (v : string) : 'a option =
85 if String.is_empty (String.strip v) then None else Some (f v)
86
87 let parse : t Delimited.Read.t =
88 let open Delimited.Read.Let_syntax in
89 let%map_open date = at_header "Date" ~f:Date.of_string
90 and description = at_header "Name / Description" ~f:Fn.id
91 and account = at_header "Account" ~f:Iban.of_string
92 and counterparty = at_header "Counterparty" ~f:(opt_field Iban.of_string)
93 and code = at_header "Code" ~f:Transaction_type.of_code
94 and debit_credit = at_header "Debit/credit" ~f:Debit_credit.of_string
95 and amount = at_header "Amount (EUR)" ~f:Cents.of_string
96 and type_ = at_header "Transaction type" ~f:Transaction_type.of_type
97 and notifications = at_header "Notifications" ~f:Fn.id
98 and resulting_balance = at_header "Resulting balance" ~f:Cents.of_string
99 and tag = at_header "Tag" ~f:Fn.id in
100 if not ([%equal: Transaction_type.t] code type_) then
101 Printf.failwithf
102 "Primitive_tx.parse: parsed transaction code (%S) and type (%S) do not \
103 match"
104 (Transaction_type.to_string code)
105 (Transaction_type.to_string type_)
106 ();
107 {
108 date;
109 description;
110 account;
111 counterparty;
112 type_;
113 debit_credit;
114 amount;
115 notifications;
116 resulting_balance;
117 tag;
118 }
119end
120
121type tx_base = {
122 date : Date.t;
123 account : Iban.t;
124 amount : Cents.t;
125 res_bal : Cents.t;
126 tag : string;
127}
128
129type tx_specifics =
130 | Payment_terminal_payment of {
131 counterparty_name : string;
132 card_sequence_no : string;
133 timestamp : Time_ns.t;
134 transaction : string;
135 terminal : string;
136 google_pay : bool;
137 }
138 | Payment_terminal_cashback of {
139 counterparty_name : string;
140 card_sequence_no : string;
141 timestamp : Time_ns.t;
142 transaction : string;
143 terminal : string;
144 }
145 | Online_banking_credit of {
146 counterparty_name : string;
147 counterparty_iban : Iban.t;
148 description : string;
149 timestamp : Time_ns.t;
150 }
151 | Online_banking_debit of {
152 counterparty_name : string;
153 counterparty_iban : Iban.t;
154 description : string;
155 mtimestamp : Time_ns.t option;
156 }
157 | Recurrent_direct_debit of {
158 counterparty_name : string;
159 counterparty_iban : Iban.t;
160 description : string;
161 reference : string;
162 mandate_id : string;
163 creditor_id : string;
164 other_party : string option;
165 }
166 | Rounding_savings_deposit of { savings_account : string }
167 | Deposit of {
168 counterparty_name : string;
169 counterparty_iban : Iban.t;
170 description : string;
171 reference : string;
172 }
173 | Ideal_debit of {
174 counterparty_name : string;
175 counterparty_iban : Iban.t;
176 description : string;
177 timestamp : Time_ns.t;
178 reference : string;
179 }
180 | Batch_payment of {
181 counterparty_name : string;
182 counterparty_iban : Iban.t;
183 description : string;
184 reference : string;
185 }
186
187type tx = Tx of tx_base * tx_specifics
188
189let assert_value_date (ptx : Primitive_tx.t) s =
190 let val_date = Date_unix.parse s ~fmt:"%d/%m/%Y" in
191 if not Date.(val_date = ptx.date) then
192 failwith
193 "assert_value_date: expected transaction date and value date to be the \
194 same"
195
196let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) :
197 Primitive_tx.t -> tx_specifics = function
198 | { type_ = Payment_terminal; debit_credit = Debit; _ } as ptx ->
199 let regex =
200 Re.Pcre.regexp
201 "^Card sequence no.: ([0-9]+) ? ([0-9]{2}/[0-9]{2}/[0-9]{4} \
202 [0-9]{2}:[0-9]{2}) Transaction: (.*) Term: ((.+) Google Pay|(.+)) \
203 Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
204 in
205 let [|
206 _;
207 card_seq_no;
208 timestamp_str;
209 transaction;
210 _;
211 gpay_term;
212 no_gpay_term;
213 val_date_str;
214 |] =
215 Re.Pcre.extract ~rex:regex ptx.notifications
216 in
217 assert_value_date ptx val_date_str;
218 let timestamp =
219 Time_ns.parse timestamp_str ~allow_trailing_input:false
220 ~fmt:"%d/%m/%Y %H:%M" ~zone:ams_tz
221 in
222 Payment_terminal_payment
223 {
224 counterparty_name = ptx.description;
225 card_sequence_no = card_seq_no;
226 timestamp;
227 transaction;
228 terminal =
229 (if String.is_empty gpay_term then no_gpay_term else gpay_term);
230 google_pay = String.is_empty no_gpay_term;
231 }
232 | { type_ = Payment_terminal; debit_credit = Credit; _ } as ptx ->
233 let regex =
234 Re.Pcre.regexp
235 "^Card sequence no.: ([0-9]+) ? ([0-9]{2}/[0-9]{2}/[0-9]{4} \
236 [0-9]{2}:[0-9]{2}) Transaction: (.*) Term: (.*) Cashback \
237 transaction Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
238 in
239 let [| _; card_seq_no; timestamp_str; transaction; term; val_date_str |] =
240 Re.Pcre.extract ~rex:regex ptx.notifications
241 in
242 assert_value_date ptx val_date_str;
243 let timestamp =
244 Time_ns.parse timestamp_str ~allow_trailing_input:false
245 ~fmt:"%d/%m/%Y %H:%M" ~zone:ams_tz
246 in
247 Payment_terminal_cashback
248 {
249 counterparty_name = ptx.description;
250 card_sequence_no = card_seq_no;
251 timestamp;
252 transaction;
253 terminal = term;
254 }
255 | { type_ = Online_banking; debit_credit = Credit; _ } as ptx ->
256 let regex =
257 Re.Pcre.regexp
258 "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Date/time: \
259 ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}:[0-9]{2}) Value date: \
260 ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
261 in
262 let [| _; name; desc; iban_str; timestamp_str; val_date_str |] =
263 Re.Pcre.extract ~rex:regex ptx.notifications
264 in
265 assert_value_date ptx val_date_str;
266 let iban = Iban.of_string iban_str
267 and timestamp =
268 Time_ns.parse timestamp_str ~allow_trailing_input:false
269 ~fmt:"%d-%m-%Y %H:%M:%S" ~zone:ams_tz
270 in
271 if not String.(name = ptx.description) then
272 failwith
273 "specifics_from_prim (Online_banking/Credit): expected counterparty \
274 name to match primitive description";
275 if not (Option.equal Iban.equal (Some iban) ptx.counterparty) then
276 failwith
277 "specifics_from_prim (Online_banking/Credit): expected IBAN to match \
278 and primitive counterparty IBAN";
279 Online_banking_credit
280 {
281 counterparty_name = name;
282 counterparty_iban = iban;
283 description = desc;
284 timestamp;
285 }
286 | { type_ = Online_banking; debit_credit = Debit; _ } as ptx ->
287 let regex =
288 Re.Pcre.regexp
289 "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) (Date/time: \
290 ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}:[0-9]{2}) )?Value \
291 date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
292 in
293 let [| _; name; desc; iban_str; _; timestamp_str; val_date_str |] =
294 Re.Pcre.extract ~rex:regex ptx.notifications
295 in
296 assert_value_date ptx val_date_str;
297 let iban = Iban.of_string iban_str
298 and mtimestamp =
299 if String.is_empty timestamp_str then None
300 else
301 Some
302 (Time_ns.parse timestamp_str ~allow_trailing_input:false
303 ~fmt:"%d-%m-%Y %H:%M:%S" ~zone:ams_tz)
304 in
305 if not String.(name = ptx.description) then
306 failwith
307 "specifics_from_prim (Online_banking/Debit): expected counterparty \
308 name to match primitive description";
309 if not (Option.equal Iban.equal (Some iban) ptx.counterparty) then
310 failwith
311 "specifics_from_prim (Online_banking/Debit): expected IBAN to match \
312 and primitive counterparty IBAN";
313 Online_banking_debit
314 {
315 counterparty_name = name;
316 counterparty_iban = iban;
317 description = desc;
318 mtimestamp;
319 }
320 | { type_ = Direct_debit; debit_credit = Debit; _ } as ptx
321 when String.is_suffix ptx.notifications
322 ~suffix:"Recurrent SEPA direct debit" ->
323 let regex =
324 Re.Pcre.regexp
325 "^Name: (.* ING Verzekeren) Description: (.*) IBAN: ([A-Z0-9]+) \
326 Reference: (.*) Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA \
327 direct debit$"
328 in
329 let [| _; name; desc; iban_str; ref_; mandate_id; creditor_id |] =
330 Re.Pcre.extract ~rex:regex ptx.notifications
331 in
332 let iban = Iban.of_string iban_str in
333 if not String.(name = ptx.description) then
334 failwith
335 "specifics_from_prim (Direct_debit/Debit): expected counterparty \
336 name to match primitive description";
337 if not (Option.equal Iban.equal (Some iban) ptx.counterparty) then
338 failwith
339 "specifics_from_prim (Direct_debit/Debit): expected IBAN to match \
340 and primitive counterparty IBAN";
341 Recurrent_direct_debit
342 {
343 counterparty_name = name;
344 counterparty_iban = iban;
345 description = desc;
346 reference = ref_;
347 mandate_id;
348 creditor_id;
349 other_party = None;
350 }
351 | { type_ = Direct_debit; debit_credit = Debit; _ } as ptx ->
352 let regex =
353 Re.Pcre.regexp
354 "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) \
355 Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit \
356 (Other party: (.*) )?Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
357 in
358 let [|
359 _;
360 name;
361 desc;
362 iban_str;
363 ref_;
364 mandate_id;
365 creditor_id;
366 _;
367 other_party;
368 val_date_str;
369 |] =
370 Re.Pcre.extract ~rex:regex ptx.notifications
371 in
372 assert_value_date ptx val_date_str;
373 let iban = Iban.of_string iban_str in
374 if not String.(name = ptx.description) then
375 failwith
376 "specifics_from_prim (Direct_debit/Debit): expected counterparty \
377 name to match primitive description";
378 if not (Option.equal Iban.equal (Some iban) ptx.counterparty) then
379 failwith
380 "specifics_from_prim (Direct_debit/Debit): expected IBAN to match \
381 and primitive counterparty IBAN";
382 Recurrent_direct_debit
383 {
384 counterparty_name = name;
385 counterparty_iban = iban;
386 description = desc;
387 reference = ref_;
388 mandate_id;
389 creditor_id;
390 other_party =
391 (if String.is_empty other_party then None else Some other_party);
392 }
393 | { type_ = Transfer; debit_credit = Credit; _ } as ptx ->
394 let regex =
395 Re.Pcre.regexp
396 "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) \
397 Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
398 in
399 let [| _; name; desc; iban_str; ref_; val_date_str |] =
400 Re.Pcre.extract ~rex:regex ptx.notifications
401 in
402 assert_value_date ptx val_date_str;
403 let iban = Iban.of_string iban_str in
404 if not String.(name = ptx.description) then
405 failwith
406 "specifics_from_prim (Transfer/Credit): expected counterparty name \
407 to match primitive description";
408 if not (Option.equal Iban.equal (Some iban) ptx.counterparty) then
409 failwith
410 "specifics_from_prim (Direct_debit/Debit): expected IBAN to match \
411 and primitive counterparty IBAN";
412 Deposit
413 {
414 counterparty_name = name;
415 counterparty_iban = iban;
416 description = desc;
417 reference = ref_;
418 }
419 | { type_ = Transfer; debit_credit = Debit; _ } as ptx ->
420 let regex =
421 Re.Pcre.regexp
422 "^To Oranje spaarrekening ([A-Z0-9]+) Afronding Value date: \
423 ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
424 in
425 let [| _; savings_account; val_date_str |] =
426 Re.Pcre.extract ~rex:regex ptx.notifications
427 in
428 assert_value_date ptx val_date_str;
429 Rounding_savings_deposit { savings_account }
430 | { type_ = Ideal; debit_credit = Debit; _ } as ptx ->
431 let regex =
432 Re.Pcre.regexp
433 "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: \
434 ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}) ([0-9]+) Value date: \
435 ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
436 in
437 let [| _; name; desc; iban_str; timestamp_str; ref_; val_date_str |] =
438 Re.Pcre.extract ~rex:regex ptx.notifications
439 in
440 assert_value_date ptx val_date_str;
441 let timestamp =
442 Time_ns.parse timestamp_str ~allow_trailing_input:false
443 ~fmt:"%d-%m-%Y %H:%M" ~zone:ams_tz
444 in
445 let iban = Iban.of_string iban_str in
446 if not String.(name = ptx.description) then
447 failwith
448 "specifics_from_prim (Ideal/Debit): expected counterparty name to \
449 match primitive description";
450 if not (Option.equal Iban.equal (Some iban) ptx.counterparty) then
451 failwith
452 "specifics_from_prim (Ideal/Debit): expected IBAN to match and \
453 primitive counterparty IBAN";
454 Ideal_debit
455 {
456 counterparty_name = name;
457 counterparty_iban = iban;
458 description = desc;
459 timestamp;
460 reference = ref_;
461 }
462 | { type_ = Batch_payment; debit_credit = Credit; _ } as ptx ->
463 let regex =
464 Re.Pcre.regexp
465 "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) \
466 Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
467 in
468 let [| _; name; desc; iban_str; ref_; val_date_str |] =
469 Re.Pcre.extract ~rex:regex ptx.notifications
470 in
471 assert_value_date ptx val_date_str;
472 let iban = Iban.of_string iban_str in
473 if not String.(name = ptx.description) then
474 failwith
475 "specifics_from_prim (Batch_payment/Credit): expected counterparty \
476 name to match primitive description";
477 if not (Option.equal Iban.equal (Some iban) ptx.counterparty) then
478 failwith
479 "specifics_from_prim (Batch_payment/Credit): expected IBAN to match \
480 and primitive counterparty IBAN";
481 Batch_payment
482 {
483 counterparty_name = name;
484 counterparty_iban = iban;
485 description = desc;
486 reference = ref_;
487 }
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 @@
1open Core
2
3type account_type = Asset | Equity | Liability | Expense | Income
4
5type 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
17type iban_tag = Account_tag | Counterparty_iban_tag [@@deriving compare]
18
19type unit_tag = Filed_tag | GooglePay_tag | AutoRoundSavings_tag
20[@@deriving compare]
21
22type 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
36module 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
59end
60
61module Labels = Dmap.Make (Label)
62
63module 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
72end = 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)
81end
82
83type scalar = Amount of Money.t | Rate of Z.t [@@deriving equal, compare]
84type account_id = string list
85type commodity_id = string (* TODO: consider making this UUID *)
86
87type account = {
88 id : account_id;
89 description : string list;
90 commodity_id : commodity_id;
91 balance : Money.t;
92}
93
94type bal_assert = { account : account_id; amount : Money.t; labels : Labels.t }
95
96module Account_id_key = struct
97 type t = account_id
98 type comparator_witness
99end
100
101type 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
109type item = Tx_item of tx | Bal_assert_item of bal_assert
110type ledger = Ledger of item list