From 3f5221c2da2a19cf5de05284821e9b854d31b7fb Mon Sep 17 00:00:00 2001 From: Rutger Broekhoff Date: Mon, 25 Aug 2025 21:48:54 +0200 Subject: Clean up CSV parsing code a bit --- lib/ingcsv.ml | 452 ++++++++++++++++++++++++++++++++-------------------------- 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 @@ open Core +open Result.Let_syntax module Time_ns = Time_ns_unix module Debit_credit = struct @@ -7,7 +8,7 @@ module Debit_credit = struct let of_string = function | "Debit" -> Debit | "Credit" -> Credit - | s -> Printf.failwithf "DebitCredit.of_string: %S" s () + | s -> Printf.failwithf "Debit_credit.of_string: %S" s () let to_string = function Debit -> "Debit" | Credit -> "Credit" end @@ -54,7 +55,7 @@ module Transaction_type = struct | "GF" -> Phone_banking | "OV" -> Transfer | "DV" -> Various - | s -> Printf.failwithf "TransactionType.of_code: %S" s () + | s -> Printf.failwithf "Transaction_type.of_code: %S" s () let of_type = function | "SEPA direct debit" -> Direct_debit @@ -63,7 +64,7 @@ module Transaction_type = struct | "Payment terminal" -> Payment_terminal | "Transfer" -> Transfer | "iDEAL" -> Ideal - | s -> Printf.failwithf "TransactionType.of_type: %S" s () + | s -> Printf.failwithf "Transaction_type.of_type: %S" s () end module Primitive_tx = struct @@ -186,39 +187,211 @@ type tx_specifics = type tx = Tx of tx_base * tx_specifics -let assert_value_date (ptx : Primitive_tx.t) s = - let val_date = Date_unix.parse s ~fmt:"%d/%m/%Y" in - if not Date.(val_date = ptx.date) then - failwith - "assert_value_date: expected transaction date and value date to be the \ - same" +type parse_err = + | Unknown_type_combination + | No_notifs_match + | Unreadable_timestamp + | Unreadable_value_date + | Unreadable_iban + | Inconsistent_value_date + | Inconsistent_counterparty_name + | Inconsistent_counterparty_iban -let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) : - Primitive_tx.t -> tx_specifics = function +let assert_value_date (ptx : Primitive_tx.t) d = + if Date.(d = ptx.date) then Ok () else Error Inconsistent_value_date + +let assert_counterparty_name (ptx : Primitive_tx.t) name = + if String.(ptx.description = name) then Ok () + else Error Inconsistent_counterparty_name + +let assert_counterparty_iban (ptx : Primitive_tx.t) iban = + if Option.equal Iban.equal (Some iban) ptx.counterparty then Ok () + else Error Inconsistent_counterparty_iban + +let parse_timestamp ~fmt ~zone s = + try Ok (Time_ns.parse ~allow_trailing_input:false ~fmt ~zone s) + with _ -> Error Unreadable_timestamp + +let parse_val_date s = + try Ok (Date_unix.parse s ~fmt:"%d/%m/%Y") + with _ -> Error Unreadable_value_date + +let parse_iban s = try Ok (Iban.of_string s) with _ -> Error Unreadable_iban + +let payment_terminal_debit_rex = + Re.Pcre.regexp + "^Card sequence no.: ([0-9]+) ? ([0-9]{2}/[0-9]{2}/[0-9]{4} \ + [0-9]{2}:[0-9]{2}) Transaction: (.*) Term: ((.+) Google Pay|(.+)) Value \ + date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" + +let parse_payment_terminal_debit_notifs notifs ~ams_tz = + match Re.Pcre.extract ~rex:payment_terminal_debit_rex notifs with + | [| + _; + card_seq_no; + timestamp_str; + transaction; + _; + gpay_term; + no_gpay_term; + val_date_str; + |] -> + let%map timestamp = + parse_timestamp timestamp_str ~fmt:"%d/%m/%Y %H:%M" ~zone:ams_tz + and val_date = parse_val_date val_date_str in + (card_seq_no, timestamp, transaction, gpay_term, no_gpay_term, val_date) + | _ | (exception _) -> Error No_notifs_match + +let payment_terminal_credit_rex = + Re.Pcre.regexp + "^Card sequence no.: ([0-9]+) ? ([0-9]{2}/[0-9]{2}/[0-9]{4} \ + [0-9]{2}:[0-9]{2}) Transaction: (.*) Term: (.*) Cashback transaction \ + Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" + +let parse_payment_terminal_credit_notifs notifs ~ams_tz = + match Re.Pcre.extract ~rex:payment_terminal_credit_rex notifs with + | [| _; card_seq_no; timestamp_str; transaction; term; val_date_str |] -> + let%map timestamp = + parse_timestamp timestamp_str ~fmt:"%d/%m/%Y %H:%M" ~zone:ams_tz + and val_date = parse_val_date val_date_str in + (card_seq_no, timestamp, transaction, term, val_date) + | _ | (exception _) -> Error No_notifs_match + +let online_banking_credit_rex = + Re.Pcre.regexp + "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Date/time: \ + ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}:[0-9]{2}) Value date: \ + ([0-9]{2}/[0-9]{2}/[0-9]{4})$" + +let parse_online_banking_credit_notifs notifs ~ams_tz = + match Re.Pcre.extract ~rex:online_banking_credit_rex notifs with + | [| _; name; desc; iban_str; timestamp_str; val_date_str |] -> + let%map timestamp = + parse_timestamp timestamp_str ~fmt:"%d-%m-%Y %H:%M:%S" ~zone:ams_tz + and val_date = parse_val_date val_date_str + and iban = parse_iban iban_str in + (name, desc, iban, timestamp, val_date) + | _ | (exception _) -> Error No_notifs_match + +let online_banking_debit_rex = + Re.Pcre.regexp + "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) (Date/time: \ + ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}:[0-9]{2}) )?Value date: \ + ([0-9]{2}/[0-9]{2}/[0-9]{4})$" + +let parse_online_banking_debit_notifs notifs ~ams_tz = + match Re.Pcre.extract ~rex:online_banking_debit_rex notifs with + | [| _; name; desc; iban_str; _; timestamp_str; val_date_str |] -> + let%map mtimestamp = + if String.is_empty timestamp_str then Ok None + else + parse_timestamp timestamp_str ~fmt:"%d-%m-%Y %H:%M:%S" ~zone:ams_tz + >>| Option.return + and val_date = parse_val_date val_date_str + and iban = parse_iban iban_str in + (name, desc, iban, mtimestamp, val_date) + | _ | (exception _) -> Error No_notifs_match + +let ing_insurance_direct_debit_rex = + Re.Pcre.regexp + "^Name: (.* ING Verzekeren) Description: (.*) IBAN: ([A-Z0-9]+) Reference: \ + (.*) Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit$" + +let parse_ing_insurance_direct_debit_notifs notifs = + match Re.Pcre.extract ~rex:ing_insurance_direct_debit_rex notifs with + | [| _; name; desc; iban_str; ref_; mandate_id; creditor_id |] -> + let%map iban = parse_iban iban_str in + (name, desc, iban, ref_, mandate_id, creditor_id) + | _ | (exception _) -> Error No_notifs_match + +let normal_direct_debit_rex = + Re.Pcre.regexp + "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Mandate \ + ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit (Other party: (.*) \ + )?Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" + +let parse_normal_direct_debit_notifs notifs = + match Re.Pcre.extract ~rex:normal_direct_debit_rex notifs with + | [| + _; + name; + desc; + iban_str; + ref_; + mandate_id; + creditor_id; + _; + other_party; + val_date_str; + |] -> + let%map iban = parse_iban iban_str + and val_date = parse_val_date val_date_str in + (name, desc, iban, ref_, mandate_id, creditor_id, other_party, val_date) + | _ | (exception _) -> Error No_notifs_match + +let credit_transfer_rex = + Re.Pcre.regexp + "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value \ + date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" + +let parse_credit_transfer_notifs notifs = + match Re.Pcre.extract ~rex:normal_direct_debit_rex notifs with + | [| _; name; desc; iban_str; ref_; val_date_str |] -> + let%map iban = parse_iban iban_str + and val_date = parse_val_date val_date_str in + (name, desc, iban, ref_, val_date) + | _ | (exception _) -> Error No_notifs_match + +let debit_transfer_rex = + Re.Pcre.regexp + "^To Oranje spaarrekening ([A-Z0-9]+) Afronding Value date: \ + ([0-9]{2}/[0-9]{2}/[0-9]{4})$" + +let parse_debit_transfer_notifs notifs = + match Re.Pcre.extract ~rex:debit_transfer_rex notifs with + | [| _; savings_account; val_date_str |] -> + let%map val_date = parse_val_date val_date_str in + (val_date, savings_account) + | _ | (exception _) -> Error No_notifs_match + +let ideal_debit_rex = + Re.Pcre.regexp + "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: \ + ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}) ([0-9]+) Value date: \ + ([0-9]{2}/[0-9]{2}/[0-9]{4})$" + +let parse_ideal_debit_notifs notifs ~ams_tz = + match Re.Pcre.extract ~rex:ideal_debit_rex notifs with + | [| _; name; desc; iban_str; timestamp_str; ref_; val_date_str |] -> + let%map timestamp = + parse_timestamp timestamp_str ~fmt:"%d-%m-%Y %H:%M" ~zone:ams_tz + and iban = parse_iban iban_str + and val_date = parse_val_date val_date_str in + (name, desc, iban, timestamp, ref_, val_date) + | _ | (exception _) -> Error No_notifs_match + +let batch_payment_credit_rex = + Re.Pcre.regexp + "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value \ + date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" + +let parse_batch_payment_credit_notifs notifs = + match Re.Pcre.extract ~rex:batch_payment_credit_rex notifs with + | [| _; name; desc; iban_str; ref_; val_date_str |] -> + let%map iban = parse_iban iban_str + and val_date = parse_val_date val_date_str in + (name, desc, iban, ref_, val_date) + | _ | (exception _) -> Error No_notifs_match + +let specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) : + Primitive_tx.t -> (tx_specifics, parse_err) result = function | { type_ = Payment_terminal; debit_credit = Debit; _ } as ptx -> - let regex = - Re.Pcre.regexp - "^Card sequence no.: ([0-9]+) ? ([0-9]{2}/[0-9]{2}/[0-9]{4} \ - [0-9]{2}:[0-9]{2}) Transaction: (.*) Term: ((.+) Google Pay|(.+)) \ - Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" - in - let [| - _; - card_seq_no; - timestamp_str; - transaction; - _; - gpay_term; - no_gpay_term; - val_date_str; - |] = - Re.Pcre.extract ~rex:regex ptx.notifications - in - assert_value_date ptx val_date_str; - let timestamp = - Time_ns.parse timestamp_str ~allow_trailing_input:false - ~fmt:"%d/%m/%Y %H:%M" ~zone:ams_tz + let%bind + card_seq_no, timestamp, transaction, gpay_term, no_gpay_term, val_date + = + parse_payment_terminal_debit_notifs ptx.notifications ~ams_tz in + let%map () = assert_value_date ptx val_date in Payment_terminal_payment { counterparty_name = ptx.description; @@ -230,20 +403,10 @@ let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) : google_pay = String.is_empty no_gpay_term; } | { type_ = Payment_terminal; debit_credit = Credit; _ } as ptx -> - let regex = - Re.Pcre.regexp - "^Card sequence no.: ([0-9]+) ? ([0-9]{2}/[0-9]{2}/[0-9]{4} \ - [0-9]{2}:[0-9]{2}) Transaction: (.*) Term: (.*) Cashback \ - transaction Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" - in - let [| _; card_seq_no; timestamp_str; transaction; term; val_date_str |] = - Re.Pcre.extract ~rex:regex ptx.notifications - in - assert_value_date ptx val_date_str; - let timestamp = - Time_ns.parse timestamp_str ~allow_trailing_input:false - ~fmt:"%d/%m/%Y %H:%M" ~zone:ams_tz + let%bind card_seq_no, timestamp, transaction, term, val_date = + parse_payment_terminal_credit_notifs ptx.notifications ~ams_tz in + let%map () = assert_value_date ptx val_date in Payment_terminal_cashback { counterparty_name = ptx.description; @@ -253,29 +416,12 @@ let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) : terminal = term; } | { type_ = Online_banking; debit_credit = Credit; _ } as ptx -> - let regex = - Re.Pcre.regexp - "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Date/time: \ - ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}:[0-9]{2}) Value date: \ - ([0-9]{2}/[0-9]{2}/[0-9]{4})$" - in - let [| _; name; desc; iban_str; timestamp_str; val_date_str |] = - Re.Pcre.extract ~rex:regex ptx.notifications - in - assert_value_date ptx val_date_str; - let iban = Iban.of_string iban_str - and timestamp = - Time_ns.parse timestamp_str ~allow_trailing_input:false - ~fmt:"%d-%m-%Y %H:%M:%S" ~zone:ams_tz + let%bind name, desc, iban, timestamp, val_date = + parse_online_banking_credit_notifs ptx.notifications ~ams_tz in - if not String.(name = ptx.description) then - failwith - "specifics_from_prim (Online_banking/Credit): expected counterparty \ - name to match primitive description"; - if not (Option.equal Iban.equal (Some iban) ptx.counterparty) then - failwith - "specifics_from_prim (Online_banking/Credit): expected IBAN to match \ - and primitive counterparty IBAN"; + let%map () = assert_value_date ptx val_date + and () = assert_counterparty_name ptx name + and () = assert_counterparty_iban ptx iban in Online_banking_credit { counterparty_name = name; @@ -284,32 +430,12 @@ let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) : timestamp; } | { type_ = Online_banking; debit_credit = Debit; _ } as ptx -> - let regex = - Re.Pcre.regexp - "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) (Date/time: \ - ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}:[0-9]{2}) )?Value \ - date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" + let%bind name, desc, iban, mtimestamp, val_date = + parse_online_banking_debit_notifs ptx.notifications ~ams_tz in - let [| _; name; desc; iban_str; _; timestamp_str; val_date_str |] = - Re.Pcre.extract ~rex:regex ptx.notifications - in - assert_value_date ptx val_date_str; - let iban = Iban.of_string iban_str - and mtimestamp = - if String.is_empty timestamp_str then None - else - Some - (Time_ns.parse timestamp_str ~allow_trailing_input:false - ~fmt:"%d-%m-%Y %H:%M:%S" ~zone:ams_tz) - in - if not String.(name = ptx.description) then - failwith - "specifics_from_prim (Online_banking/Debit): expected counterparty \ - name to match primitive description"; - if not (Option.equal Iban.equal (Some iban) ptx.counterparty) then - failwith - "specifics_from_prim (Online_banking/Debit): expected IBAN to match \ - and primitive counterparty IBAN"; + let%map () = assert_value_date ptx val_date + and () = assert_counterparty_name ptx name + and () = assert_counterparty_iban ptx iban in Online_banking_debit { counterparty_name = name; @@ -320,24 +446,11 @@ let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) : | { type_ = Direct_debit; debit_credit = Debit; _ } as ptx when String.is_suffix ptx.notifications ~suffix:"Recurrent SEPA direct debit" -> - let regex = - Re.Pcre.regexp - "^Name: (.* ING Verzekeren) Description: (.*) IBAN: ([A-Z0-9]+) \ - Reference: (.*) Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA \ - direct debit$" + let%bind name, desc, iban, ref_, mandate_id, creditor_id = + parse_ing_insurance_direct_debit_notifs ptx.notifications in - let [| _; name; desc; iban_str; ref_; mandate_id; creditor_id |] = - Re.Pcre.extract ~rex:regex ptx.notifications - in - let iban = Iban.of_string iban_str in - if not String.(name = ptx.description) then - failwith - "specifics_from_prim (Direct_debit/Debit): expected counterparty \ - name to match primitive description"; - if not (Option.equal Iban.equal (Some iban) ptx.counterparty) then - failwith - "specifics_from_prim (Direct_debit/Debit): expected IBAN to match \ - and primitive counterparty IBAN"; + let%map () = assert_counterparty_name ptx name + and () = assert_counterparty_iban ptx iban in Recurrent_direct_debit { counterparty_name = name; @@ -349,36 +462,14 @@ let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) : other_party = None; } | { type_ = Direct_debit; debit_credit = Debit; _ } as ptx -> - let regex = - Re.Pcre.regexp - "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) \ - Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit \ - (Other party: (.*) )?Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" - in - let [| - _; - name; - desc; - iban_str; - ref_; - mandate_id; - creditor_id; - _; - other_party; - val_date_str; - |] = - Re.Pcre.extract ~rex:regex ptx.notifications + let%bind + name, desc, iban, ref_, mandate_id, creditor_id, other_party, val_date + = + parse_normal_direct_debit_notifs ptx.notifications in - assert_value_date ptx val_date_str; - let iban = Iban.of_string iban_str in - if not String.(name = ptx.description) then - failwith - "specifics_from_prim (Direct_debit/Debit): expected counterparty \ - name to match primitive description"; - if not (Option.equal Iban.equal (Some iban) ptx.counterparty) then - failwith - "specifics_from_prim (Direct_debit/Debit): expected IBAN to match \ - and primitive counterparty IBAN"; + let%map () = assert_value_date ptx val_date + and () = assert_counterparty_name ptx name + and () = assert_counterparty_iban ptx iban in Recurrent_direct_debit { counterparty_name = name; @@ -391,24 +482,12 @@ let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) : (if String.is_empty other_party then None else Some other_party); } | { type_ = Transfer; debit_credit = Credit; _ } as ptx -> - let regex = - Re.Pcre.regexp - "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) \ - Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" + let%bind name, desc, iban, ref_, val_date = + parse_credit_transfer_notifs ptx.notifications in - let [| _; name; desc; iban_str; ref_; val_date_str |] = - Re.Pcre.extract ~rex:regex ptx.notifications - in - assert_value_date ptx val_date_str; - let iban = Iban.of_string iban_str in - if not String.(name = ptx.description) then - failwith - "specifics_from_prim (Transfer/Credit): expected counterparty name \ - to match primitive description"; - if not (Option.equal Iban.equal (Some iban) ptx.counterparty) then - failwith - "specifics_from_prim (Direct_debit/Debit): expected IBAN to match \ - and primitive counterparty IBAN"; + let%map () = assert_value_date ptx val_date + and () = assert_counterparty_name ptx name + and () = assert_counterparty_iban ptx iban in Deposit { counterparty_name = name; @@ -417,40 +496,18 @@ let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) : reference = ref_; } | { type_ = Transfer; debit_credit = Debit; _ } as ptx -> - let regex = - Re.Pcre.regexp - "^To Oranje spaarrekening ([A-Z0-9]+) Afronding Value date: \ - ([0-9]{2}/[0-9]{2}/[0-9]{4})$" - in - let [| _; savings_account; val_date_str |] = - Re.Pcre.extract ~rex:regex ptx.notifications + let%bind val_date, savings_account = + parse_debit_transfer_notifs ptx.notifications in - assert_value_date ptx val_date_str; + let%map () = assert_value_date ptx val_date in Rounding_savings_deposit { savings_account } | { type_ = Ideal; debit_credit = Debit; _ } as ptx -> - let regex = - Re.Pcre.regexp - "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: \ - ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}) ([0-9]+) Value date: \ - ([0-9]{2}/[0-9]{2}/[0-9]{4})$" - in - let [| _; name; desc; iban_str; timestamp_str; ref_; val_date_str |] = - Re.Pcre.extract ~rex:regex ptx.notifications + let%bind name, desc, iban, timestamp, ref_, val_date = + parse_ideal_debit_notifs ptx.notifications ~ams_tz in - assert_value_date ptx val_date_str; - let timestamp = - Time_ns.parse timestamp_str ~allow_trailing_input:false - ~fmt:"%d-%m-%Y %H:%M" ~zone:ams_tz - in - let iban = Iban.of_string iban_str in - if not String.(name = ptx.description) then - failwith - "specifics_from_prim (Ideal/Debit): expected counterparty name to \ - match primitive description"; - if not (Option.equal Iban.equal (Some iban) ptx.counterparty) then - failwith - "specifics_from_prim (Ideal/Debit): expected IBAN to match and \ - primitive counterparty IBAN"; + let%map () = assert_value_date ptx val_date + and () = assert_counterparty_name ptx name + and () = assert_counterparty_iban ptx iban in Ideal_debit { counterparty_name = name; @@ -460,24 +517,12 @@ let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) : reference = ref_; } | { type_ = Batch_payment; debit_credit = Credit; _ } as ptx -> - let regex = - Re.Pcre.regexp - "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) \ - Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" - in - let [| _; name; desc; iban_str; ref_; val_date_str |] = - Re.Pcre.extract ~rex:regex ptx.notifications + let%bind name, desc, iban, ref_, val_date = + parse_batch_payment_credit_notifs ptx.notifications in - assert_value_date ptx val_date_str; - let iban = Iban.of_string iban_str in - if not String.(name = ptx.description) then - failwith - "specifics_from_prim (Batch_payment/Credit): expected counterparty \ - name to match primitive description"; - if not (Option.equal Iban.equal (Some iban) ptx.counterparty) then - failwith - "specifics_from_prim (Batch_payment/Credit): expected IBAN to match \ - and primitive counterparty IBAN"; + let%map () = assert_value_date ptx val_date + and () = assert_counterparty_name ptx name + and () = assert_counterparty_iban ptx iban in Batch_payment { counterparty_name = name; @@ -485,3 +530,4 @@ let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) : description = desc; reference = ref_; } + | _ -> 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 type comparator_witness end -type tx = { - cleared : Date.t option; - commodity_id : commodity_id; - debit : scalar Map.M(Account_id_key).t; - credit : scalar Map.M(Account_id_key).t; - labels : Labels.t; -} +module Tx : sig + type t + type error = Unbalanced + + val make : + cleared:Date.t option -> + commodity_id:commodity_id -> + debit:scalar Map.M(Account_id_key).t -> + credit:scalar Map.M(Account_id_key).t -> + labels:Labels.t -> + (t, error) result + + val cleared : t -> Date.t option + val commodity_id : t -> commodity_id + val debit : t -> scalar Map.M(Account_id_key).t + val credit : t -> scalar Map.M(Account_id_key).t + val labels : t -> Labels.t +end = struct + (* We hide this because we only want to allow constructing balanced transactions *) + type t = { + cleared : Date.t option; + commodity_id : commodity_id; + debit : scalar Map.M(Account_id_key).t; + credit : scalar Map.M(Account_id_key).t; + labels : Labels.t; + } + [@@deriving fields] + + type error = Unbalanced + + (* TODO: check if debits and credits are balanced *) + let is_balanced _debits _credits = true + + let make ~cleared ~commodity_id ~debit ~credit ~labels = + if not (is_balanced debit credit) then Error Unbalanced + else Ok { cleared; commodity_id; debit; credit; labels } +end -type item = Tx_item of tx | Bal_assert_item of bal_assert +type item = Tx_item of Tx.t | Bal_assert_item of bal_assert type ledger = Ledger of item list -- cgit v1.2.3