diff options
author | Rutger Broekhoff | 2025-08-25 21:48:54 +0200 |
---|---|---|
committer | Rutger Broekhoff | 2025-08-25 21:48:54 +0200 |
commit | 3f5221c2da2a19cf5de05284821e9b854d31b7fb (patch) | |
tree | 300cd81d0b6233c38fbc58bdafb8b9262e6a1bc4 | |
parent | 95d50b25c990e8c945ce2507b16ff3c8b039d286 (diff) | |
download | rdcapsis-3f5221c2da2a19cf5de05284821e9b854d31b7fb.tar.gz rdcapsis-3f5221c2da2a19cf5de05284821e9b854d31b7fb.zip |
Clean up CSV parsing code a bit
-rw-r--r-- | lib/ingcsv.ml | 452 | ||||
-rw-r--r-- | lib/ledger.ml | 46 |
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 @@ | |||
1 | open Core | 1 | open Core |
2 | open Result.Let_syntax | ||
2 | module Time_ns = Time_ns_unix | 3 | module Time_ns = Time_ns_unix |
3 | 4 | ||
4 | module Debit_credit = struct | 5 | module 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" |
13 | end | 14 | end |
@@ -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 () |
67 | end | 68 | end |
68 | 69 | ||
69 | module Primitive_tx = struct | 70 | module Primitive_tx = struct |
@@ -186,39 +187,211 @@ type tx_specifics = | |||
186 | 187 | ||
187 | type tx = Tx of tx_base * tx_specifics | 188 | type tx = Tx of tx_base * tx_specifics |
188 | 189 | ||
189 | let assert_value_date (ptx : Primitive_tx.t) s = | 190 | type 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 | ||
196 | let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) : | 200 | let 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 | |||
203 | let assert_counterparty_name (ptx : Primitive_tx.t) name = | ||
204 | if String.(ptx.description = name) then Ok () | ||
205 | else Error Inconsistent_counterparty_name | ||
206 | |||
207 | let 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 | |||
211 | let parse_timestamp ~fmt ~zone s = | ||
212 | try Ok (Time_ns.parse ~allow_trailing_input:false ~fmt ~zone s) | ||
213 | with _ -> Error Unreadable_timestamp | ||
214 | |||
215 | let parse_val_date s = | ||
216 | try Ok (Date_unix.parse s ~fmt:"%d/%m/%Y") | ||
217 | with _ -> Error Unreadable_value_date | ||
218 | |||
219 | let parse_iban s = try Ok (Iban.of_string s) with _ -> Error Unreadable_iban | ||
220 | |||
221 | let 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 | |||
227 | let 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 | |||
245 | let 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 | |||
251 | let 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 | |||
260 | let 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 | |||
266 | let 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 | |||
276 | let 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 | |||
282 | let 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 | |||
295 | let 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 | |||
300 | let 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 | |||
307 | let 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 | |||
313 | let 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 | |||
332 | let 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 | |||
337 | let 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 | |||
345 | let 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 | |||
350 | let 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 | |||
357 | let 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 | |||
363 | let 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 | |||
373 | let 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 | |||
378 | let 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 | |||
386 | let 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 |
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 |