summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRutger Broekhoff2025-08-25 21:48:54 +0200
committerRutger Broekhoff2025-08-25 21:48:54 +0200
commit3f5221c2da2a19cf5de05284821e9b854d31b7fb (patch)
tree300cd81d0b6233c38fbc58bdafb8b9262e6a1bc4
parent95d50b25c990e8c945ce2507b16ff3c8b039d286 (diff)
downloadrdcapsis-3f5221c2da2a19cf5de05284821e9b854d31b7fb.tar.gz
rdcapsis-3f5221c2da2a19cf5de05284821e9b854d31b7fb.zip
Clean up CSV parsing code a bit
-rw-r--r--lib/ingcsv.ml452
-rw-r--r--lib/ledger.ml46
2 files changed, 287 insertions, 211 deletions
diff --git a/lib/ingcsv.ml b/lib/ingcsv.ml
index a8eba51..203a353 100644
--- a/lib/ingcsv.ml
+++ b/lib/ingcsv.ml
@@ -1,4 +1,5 @@
1open Core 1open Core
2open Result.Let_syntax
2module Time_ns = Time_ns_unix 3module Time_ns = Time_ns_unix
3 4
4module Debit_credit = struct 5module Debit_credit = struct
@@ -7,7 +8,7 @@ module Debit_credit = struct
7 let of_string = function 8 let of_string = function
8 | "Debit" -> Debit 9 | "Debit" -> Debit
9 | "Credit" -> Credit 10 | "Credit" -> Credit
10 | s -> Printf.failwithf "DebitCredit.of_string: %S" s () 11 | s -> Printf.failwithf "Debit_credit.of_string: %S" s ()
11 12
12 let to_string = function Debit -> "Debit" | Credit -> "Credit" 13 let to_string = function Debit -> "Debit" | Credit -> "Credit"
13end 14end
@@ -54,7 +55,7 @@ module Transaction_type = struct
54 | "GF" -> Phone_banking 55 | "GF" -> Phone_banking
55 | "OV" -> Transfer 56 | "OV" -> Transfer
56 | "DV" -> Various 57 | "DV" -> Various
57 | s -> Printf.failwithf "TransactionType.of_code: %S" s () 58 | s -> Printf.failwithf "Transaction_type.of_code: %S" s ()
58 59
59 let of_type = function 60 let of_type = function
60 | "SEPA direct debit" -> Direct_debit 61 | "SEPA direct debit" -> Direct_debit
@@ -63,7 +64,7 @@ module Transaction_type = struct
63 | "Payment terminal" -> Payment_terminal 64 | "Payment terminal" -> Payment_terminal
64 | "Transfer" -> Transfer 65 | "Transfer" -> Transfer
65 | "iDEAL" -> Ideal 66 | "iDEAL" -> Ideal
66 | s -> Printf.failwithf "TransactionType.of_type: %S" s () 67 | s -> Printf.failwithf "Transaction_type.of_type: %S" s ()
67end 68end
68 69
69module Primitive_tx = struct 70module Primitive_tx = struct
@@ -186,39 +187,211 @@ type tx_specifics =
186 187
187type tx = Tx of tx_base * tx_specifics 188type tx = Tx of tx_base * tx_specifics
188 189
189let assert_value_date (ptx : Primitive_tx.t) s = 190type parse_err =
190 let val_date = Date_unix.parse s ~fmt:"%d/%m/%Y" in 191 | Unknown_type_combination
191 if not Date.(val_date = ptx.date) then 192 | No_notifs_match
192 failwith 193 | Unreadable_timestamp
193 "assert_value_date: expected transaction date and value date to be the \ 194 | Unreadable_value_date
194 same" 195 | Unreadable_iban
196 | Inconsistent_value_date
197 | Inconsistent_counterparty_name
198 | Inconsistent_counterparty_iban
195 199
196let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) : 200let assert_value_date (ptx : Primitive_tx.t) d =
197 Primitive_tx.t -> tx_specifics = function 201 if Date.(d = ptx.date) then Ok () else Error Inconsistent_value_date
202
203let assert_counterparty_name (ptx : Primitive_tx.t) name =
204 if String.(ptx.description = name) then Ok ()
205 else Error Inconsistent_counterparty_name
206
207let assert_counterparty_iban (ptx : Primitive_tx.t) iban =
208 if Option.equal Iban.equal (Some iban) ptx.counterparty then Ok ()
209 else Error Inconsistent_counterparty_iban
210
211let parse_timestamp ~fmt ~zone s =
212 try Ok (Time_ns.parse ~allow_trailing_input:false ~fmt ~zone s)
213 with _ -> Error Unreadable_timestamp
214
215let parse_val_date s =
216 try Ok (Date_unix.parse s ~fmt:"%d/%m/%Y")
217 with _ -> Error Unreadable_value_date
218
219let parse_iban s = try Ok (Iban.of_string s) with _ -> Error Unreadable_iban
220
221let payment_terminal_debit_rex =
222 Re.Pcre.regexp
223 "^Card sequence no.: ([0-9]+) ? ([0-9]{2}/[0-9]{2}/[0-9]{4} \
224 [0-9]{2}:[0-9]{2}) Transaction: (.*) Term: ((.+) Google Pay|(.+)) Value \
225 date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
226
227let parse_payment_terminal_debit_notifs notifs ~ams_tz =
228 match Re.Pcre.extract ~rex:payment_terminal_debit_rex notifs with
229 | [|
230 _;
231 card_seq_no;
232 timestamp_str;
233 transaction;
234 _;
235 gpay_term;
236 no_gpay_term;
237 val_date_str;
238 |] ->
239 let%map timestamp =
240 parse_timestamp timestamp_str ~fmt:"%d/%m/%Y %H:%M" ~zone:ams_tz
241 and val_date = parse_val_date val_date_str in
242 (card_seq_no, timestamp, transaction, gpay_term, no_gpay_term, val_date)
243 | _ | (exception _) -> Error No_notifs_match
244
245let payment_terminal_credit_rex =
246 Re.Pcre.regexp
247 "^Card sequence no.: ([0-9]+) ? ([0-9]{2}/[0-9]{2}/[0-9]{4} \
248 [0-9]{2}:[0-9]{2}) Transaction: (.*) Term: (.*) Cashback transaction \
249 Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
250
251let parse_payment_terminal_credit_notifs notifs ~ams_tz =
252 match Re.Pcre.extract ~rex:payment_terminal_credit_rex notifs with
253 | [| _; card_seq_no; timestamp_str; transaction; term; val_date_str |] ->
254 let%map timestamp =
255 parse_timestamp timestamp_str ~fmt:"%d/%m/%Y %H:%M" ~zone:ams_tz
256 and val_date = parse_val_date val_date_str in
257 (card_seq_no, timestamp, transaction, term, val_date)
258 | _ | (exception _) -> Error No_notifs_match
259
260let online_banking_credit_rex =
261 Re.Pcre.regexp
262 "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Date/time: \
263 ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}:[0-9]{2}) Value date: \
264 ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
265
266let parse_online_banking_credit_notifs notifs ~ams_tz =
267 match Re.Pcre.extract ~rex:online_banking_credit_rex notifs with
268 | [| _; name; desc; iban_str; timestamp_str; val_date_str |] ->
269 let%map timestamp =
270 parse_timestamp timestamp_str ~fmt:"%d-%m-%Y %H:%M:%S" ~zone:ams_tz
271 and val_date = parse_val_date val_date_str
272 and iban = parse_iban iban_str in
273 (name, desc, iban, timestamp, val_date)
274 | _ | (exception _) -> Error No_notifs_match
275
276let online_banking_debit_rex =
277 Re.Pcre.regexp
278 "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) (Date/time: \
279 ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}:[0-9]{2}) )?Value date: \
280 ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
281
282let parse_online_banking_debit_notifs notifs ~ams_tz =
283 match Re.Pcre.extract ~rex:online_banking_debit_rex notifs with
284 | [| _; name; desc; iban_str; _; timestamp_str; val_date_str |] ->
285 let%map mtimestamp =
286 if String.is_empty timestamp_str then Ok None
287 else
288 parse_timestamp timestamp_str ~fmt:"%d-%m-%Y %H:%M:%S" ~zone:ams_tz
289 >>| Option.return
290 and val_date = parse_val_date val_date_str
291 and iban = parse_iban iban_str in
292 (name, desc, iban, mtimestamp, val_date)
293 | _ | (exception _) -> Error No_notifs_match
294
295let ing_insurance_direct_debit_rex =
296 Re.Pcre.regexp
297 "^Name: (.* ING Verzekeren) Description: (.*) IBAN: ([A-Z0-9]+) Reference: \
298 (.*) Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit$"
299
300let parse_ing_insurance_direct_debit_notifs notifs =
301 match Re.Pcre.extract ~rex:ing_insurance_direct_debit_rex notifs with
302 | [| _; name; desc; iban_str; ref_; mandate_id; creditor_id |] ->
303 let%map iban = parse_iban iban_str in
304 (name, desc, iban, ref_, mandate_id, creditor_id)
305 | _ | (exception _) -> Error No_notifs_match
306
307let normal_direct_debit_rex =
308 Re.Pcre.regexp
309 "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Mandate \
310 ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit (Other party: (.*) \
311 )?Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
312
313let parse_normal_direct_debit_notifs notifs =
314 match Re.Pcre.extract ~rex:normal_direct_debit_rex notifs with
315 | [|
316 _;
317 name;
318 desc;
319 iban_str;
320 ref_;
321 mandate_id;
322 creditor_id;
323 _;
324 other_party;
325 val_date_str;
326 |] ->
327 let%map iban = parse_iban iban_str
328 and val_date = parse_val_date val_date_str in
329 (name, desc, iban, ref_, mandate_id, creditor_id, other_party, val_date)
330 | _ | (exception _) -> Error No_notifs_match
331
332let credit_transfer_rex =
333 Re.Pcre.regexp
334 "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value \
335 date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
336
337let parse_credit_transfer_notifs notifs =
338 match Re.Pcre.extract ~rex:normal_direct_debit_rex notifs with
339 | [| _; name; desc; iban_str; ref_; val_date_str |] ->
340 let%map iban = parse_iban iban_str
341 and val_date = parse_val_date val_date_str in
342 (name, desc, iban, ref_, val_date)
343 | _ | (exception _) -> Error No_notifs_match
344
345let debit_transfer_rex =
346 Re.Pcre.regexp
347 "^To Oranje spaarrekening ([A-Z0-9]+) Afronding Value date: \
348 ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
349
350let parse_debit_transfer_notifs notifs =
351 match Re.Pcre.extract ~rex:debit_transfer_rex notifs with
352 | [| _; savings_account; val_date_str |] ->
353 let%map val_date = parse_val_date val_date_str in
354 (val_date, savings_account)
355 | _ | (exception _) -> Error No_notifs_match
356
357let ideal_debit_rex =
358 Re.Pcre.regexp
359 "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: \
360 ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}) ([0-9]+) Value date: \
361 ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
362
363let parse_ideal_debit_notifs notifs ~ams_tz =
364 match Re.Pcre.extract ~rex:ideal_debit_rex notifs with
365 | [| _; name; desc; iban_str; timestamp_str; ref_; val_date_str |] ->
366 let%map timestamp =
367 parse_timestamp timestamp_str ~fmt:"%d-%m-%Y %H:%M" ~zone:ams_tz
368 and iban = parse_iban iban_str
369 and val_date = parse_val_date val_date_str in
370 (name, desc, iban, timestamp, ref_, val_date)
371 | _ | (exception _) -> Error No_notifs_match
372
373let batch_payment_credit_rex =
374 Re.Pcre.regexp
375 "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value \
376 date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
377
378let parse_batch_payment_credit_notifs notifs =
379 match Re.Pcre.extract ~rex:batch_payment_credit_rex notifs with
380 | [| _; name; desc; iban_str; ref_; val_date_str |] ->
381 let%map iban = parse_iban iban_str
382 and val_date = parse_val_date val_date_str in
383 (name, desc, iban, ref_, val_date)
384 | _ | (exception _) -> Error No_notifs_match
385
386let specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) :
387 Primitive_tx.t -> (tx_specifics, parse_err) result = function
198 | { type_ = Payment_terminal; debit_credit = Debit; _ } as ptx -> 388 | { type_ = Payment_terminal; debit_credit = Debit; _ } as ptx ->
199 let regex = 389 let%bind
200 Re.Pcre.regexp 390 card_seq_no, timestamp, transaction, gpay_term, no_gpay_term, val_date
201 "^Card sequence no.: ([0-9]+) ? ([0-9]{2}/[0-9]{2}/[0-9]{4} \ 391 =
202 [0-9]{2}:[0-9]{2}) Transaction: (.*) Term: ((.+) Google Pay|(.+)) \ 392 parse_payment_terminal_debit_notifs ptx.notifications ~ams_tz
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 393 in
394 let%map () = assert_value_date ptx val_date in
222 Payment_terminal_payment 395 Payment_terminal_payment
223 { 396 {
224 counterparty_name = ptx.description; 397 counterparty_name = ptx.description;
@@ -230,20 +403,10 @@ let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) :
230 google_pay = String.is_empty no_gpay_term; 403 google_pay = String.is_empty no_gpay_term;
231 } 404 }
232 | { type_ = Payment_terminal; debit_credit = Credit; _ } as ptx -> 405 | { type_ = Payment_terminal; debit_credit = Credit; _ } as ptx ->
233 let regex = 406 let%bind card_seq_no, timestamp, transaction, term, val_date =
234 Re.Pcre.regexp 407 parse_payment_terminal_credit_notifs ptx.notifications ~ams_tz
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 408 in
409 let%map () = assert_value_date ptx val_date in
247 Payment_terminal_cashback 410 Payment_terminal_cashback
248 { 411 {
249 counterparty_name = ptx.description; 412 counterparty_name = ptx.description;
@@ -253,29 +416,12 @@ let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) :
253 terminal = term; 416 terminal = term;
254 } 417 }
255 | { type_ = Online_banking; debit_credit = Credit; _ } as ptx -> 418 | { type_ = Online_banking; debit_credit = Credit; _ } as ptx ->
256 let regex = 419 let%bind name, desc, iban, timestamp, val_date =
257 Re.Pcre.regexp 420 parse_online_banking_credit_notifs ptx.notifications ~ams_tz
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 421 in
271 if not String.(name = ptx.description) then 422 let%map () = assert_value_date ptx val_date
272 failwith 423 and () = assert_counterparty_name ptx name
273 "specifics_from_prim (Online_banking/Credit): expected counterparty \ 424 and () = assert_counterparty_iban ptx iban in
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 425 Online_banking_credit
280 { 426 {
281 counterparty_name = name; 427 counterparty_name = name;
@@ -284,32 +430,12 @@ let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) :
284 timestamp; 430 timestamp;
285 } 431 }
286 | { type_ = Online_banking; debit_credit = Debit; _ } as ptx -> 432 | { type_ = Online_banking; debit_credit = Debit; _ } as ptx ->
287 let regex = 433 let%bind name, desc, iban, mtimestamp, val_date =
288 Re.Pcre.regexp 434 parse_online_banking_debit_notifs ptx.notifications ~ams_tz
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 435 in
293 let [| _; name; desc; iban_str; _; timestamp_str; val_date_str |] = 436 let%map () = assert_value_date ptx val_date
294 Re.Pcre.extract ~rex:regex ptx.notifications 437 and () = assert_counterparty_name ptx name
295 in 438 and () = assert_counterparty_iban ptx iban 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 439 Online_banking_debit
314 { 440 {
315 counterparty_name = name; 441 counterparty_name = name;
@@ -320,24 +446,11 @@ let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) :
320 | { type_ = Direct_debit; debit_credit = Debit; _ } as ptx 446 | { type_ = Direct_debit; debit_credit = Debit; _ } as ptx
321 when String.is_suffix ptx.notifications 447 when String.is_suffix ptx.notifications
322 ~suffix:"Recurrent SEPA direct debit" -> 448 ~suffix:"Recurrent SEPA direct debit" ->
323 let regex = 449 let%bind name, desc, iban, ref_, mandate_id, creditor_id =
324 Re.Pcre.regexp 450 parse_ing_insurance_direct_debit_notifs ptx.notifications
325 "^Name: (.* ING Verzekeren) Description: (.*) IBAN: ([A-Z0-9]+) \
326 Reference: (.*) Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA \
327 direct debit$"
328 in 451 in
329 let [| _; name; desc; iban_str; ref_; mandate_id; creditor_id |] = 452 let%map () = assert_counterparty_name ptx name
330 Re.Pcre.extract ~rex:regex ptx.notifications 453 and () = assert_counterparty_iban ptx iban in
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 454 Recurrent_direct_debit
342 { 455 {
343 counterparty_name = name; 456 counterparty_name = name;
@@ -349,36 +462,14 @@ let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) :
349 other_party = None; 462 other_party = None;
350 } 463 }
351 | { type_ = Direct_debit; debit_credit = Debit; _ } as ptx -> 464 | { type_ = Direct_debit; debit_credit = Debit; _ } as ptx ->
352 let regex = 465 let%bind
353 Re.Pcre.regexp 466 name, desc, iban, ref_, mandate_id, creditor_id, other_party, val_date
354 "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) \ 467 =
355 Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit \ 468 parse_normal_direct_debit_notifs ptx.notifications
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 469 in
372 assert_value_date ptx val_date_str; 470 let%map () = assert_value_date ptx val_date
373 let iban = Iban.of_string iban_str in 471 and () = assert_counterparty_name ptx name
374 if not String.(name = ptx.description) then 472 and () = assert_counterparty_iban ptx iban in
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 473 Recurrent_direct_debit
383 { 474 {
384 counterparty_name = name; 475 counterparty_name = name;
@@ -391,24 +482,12 @@ let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) :
391 (if String.is_empty other_party then None else Some other_party); 482 (if String.is_empty other_party then None else Some other_party);
392 } 483 }
393 | { type_ = Transfer; debit_credit = Credit; _ } as ptx -> 484 | { type_ = Transfer; debit_credit = Credit; _ } as ptx ->
394 let regex = 485 let%bind name, desc, iban, ref_, val_date =
395 Re.Pcre.regexp 486 parse_credit_transfer_notifs ptx.notifications
396 "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) \
397 Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
398 in 487 in
399 let [| _; name; desc; iban_str; ref_; val_date_str |] = 488 let%map () = assert_value_date ptx val_date
400 Re.Pcre.extract ~rex:regex ptx.notifications 489 and () = assert_counterparty_name ptx name
401 in 490 and () = assert_counterparty_iban ptx iban 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 491 Deposit
413 { 492 {
414 counterparty_name = name; 493 counterparty_name = name;
@@ -417,40 +496,18 @@ let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) :
417 reference = ref_; 496 reference = ref_;
418 } 497 }
419 | { type_ = Transfer; debit_credit = Debit; _ } as ptx -> 498 | { type_ = Transfer; debit_credit = Debit; _ } as ptx ->
420 let regex = 499 let%bind val_date, savings_account =
421 Re.Pcre.regexp 500 parse_debit_transfer_notifs ptx.notifications
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 501 in
428 assert_value_date ptx val_date_str; 502 let%map () = assert_value_date ptx val_date in
429 Rounding_savings_deposit { savings_account } 503 Rounding_savings_deposit { savings_account }
430 | { type_ = Ideal; debit_credit = Debit; _ } as ptx -> 504 | { type_ = Ideal; debit_credit = Debit; _ } as ptx ->
431 let regex = 505 let%bind name, desc, iban, timestamp, ref_, val_date =
432 Re.Pcre.regexp 506 parse_ideal_debit_notifs ptx.notifications ~ams_tz
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 507 in
440 assert_value_date ptx val_date_str; 508 let%map () = assert_value_date ptx val_date
441 let timestamp = 509 and () = assert_counterparty_name ptx name
442 Time_ns.parse timestamp_str ~allow_trailing_input:false 510 and () = assert_counterparty_iban ptx iban in
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 511 Ideal_debit
455 { 512 {
456 counterparty_name = name; 513 counterparty_name = name;
@@ -460,24 +517,12 @@ let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) :
460 reference = ref_; 517 reference = ref_;
461 } 518 }
462 | { type_ = Batch_payment; debit_credit = Credit; _ } as ptx -> 519 | { type_ = Batch_payment; debit_credit = Credit; _ } as ptx ->
463 let regex = 520 let%bind name, desc, iban, ref_, val_date =
464 Re.Pcre.regexp 521 parse_batch_payment_credit_notifs ptx.notifications
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 522 in
471 assert_value_date ptx val_date_str; 523 let%map () = assert_value_date ptx val_date
472 let iban = Iban.of_string iban_str in 524 and () = assert_counterparty_name ptx name
473 if not String.(name = ptx.description) then 525 and () = assert_counterparty_iban ptx iban in
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 526 Batch_payment
482 { 527 {
483 counterparty_name = name; 528 counterparty_name = name;
@@ -485,3 +530,4 @@ let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) :
485 description = desc; 530 description = desc;
486 reference = ref_; 531 reference = ref_;
487 } 532 }
533 | _ -> Error Unknown_type_combination
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
99end 99end
100 100
101type tx = { 101module 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
118end = 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 }
137end
108 138
109type item = Tx_item of tx | Bal_assert_item of bal_assert 139type item = Tx_item of Tx.t | Bal_assert_item of bal_assert
110type ledger = Ledger of item list 140type ledger = Ledger of item list