From b8fbaa53b912347b3b50cac3e913a142db460b0a Mon Sep 17 00:00:00 2001 From: Rutger Broekhoff Date: Mon, 25 Aug 2025 23:39:51 +0200 Subject: Conversion --- lib/convert.ml | 164 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ lib/ingcsv.ml | 71 ++++++++++++++++++++++--- lib/ledger.ml | 32 ++++++----- 3 files changed, 245 insertions(+), 22 deletions(-) create mode 100644 lib/convert.ml (limited to 'lib') diff --git a/lib/convert.ml b/lib/convert.ml new file mode 100644 index 0000000..cbdb90f --- /dev/null +++ b/lib/convert.ml @@ -0,0 +1,164 @@ +open Core +open Ledger + +let virt_checking_acc = [ "Unfiled"; "Checking" ] +let virt_savings_acc = [ "Unfiled"; "Savings" ] +let virt_counterparty = [ "Unfiled"; "Counterparty" ] + +(* TODO: clean up *) +type convert_err = Nonpositive_amount | Other of Tx.error + +let cents n = Amount (Money.of_z n) + +let tx_from_current_acc euc_id (Ingcsv.Tx (base, spec)) = + if Z.(lt base.amount ~$0) then Error Nonpositive_amount + else + Result.map_error ~f:(fun e -> Other e) + @@ + match spec with + | Payment_terminal_payment details -> + Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id + ~credit: + (Account_id_map.singleton virt_checking_acc @@ cents base.amount) + ~debit: + (Account_id_map.singleton virt_counterparty @@ cents base.amount) + ~labels: + Labels.( + empty + |> add (Iban_label Account_tag) base.account + |> add (String_label Counterparty_name_tag) + details.counterparty_name + |> add (String_label Card_seq_no_tag) details.card_sequence_no + |> add (String_label Terminal_tag) details.terminal + |> add (String_label Transaction_tag) details.transaction + |> add Timestamp_label details.timestamp + |> + if details.google_pay then add (Unit_label Google_pay_tag) () + else Fn.id) + | Payment_terminal_cashback details -> + Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id + ~debit: + (Account_id_map.singleton virt_checking_acc @@ cents base.amount) + ~credit: + (Account_id_map.singleton virt_counterparty @@ cents base.amount) + ~labels: + Labels.( + empty + |> add (Iban_label Account_tag) base.account + |> add (String_label Counterparty_name_tag) + details.counterparty_name + |> add (String_label Card_seq_no_tag) details.card_sequence_no + |> add (String_label Terminal_tag) details.terminal + |> add (String_label Transaction_tag) details.transaction + |> add Timestamp_label details.timestamp) + | Online_banking_credit details -> + Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id + ~debit: + (Account_id_map.singleton virt_checking_acc @@ cents base.amount) + ~credit: + (Account_id_map.singleton virt_counterparty @@ cents base.amount) + ~labels: + Labels.( + empty + |> add (Iban_label Account_tag) base.account + |> add (String_label Counterparty_name_tag) + details.counterparty_name + |> add (Iban_label Counterparty_iban_tag) + details.counterparty_iban + |> add (String_label Desc_tag) details.description + |> add Timestamp_label details.timestamp) + | Online_banking_debit details -> + Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id + ~debit: + (Account_id_map.singleton virt_counterparty @@ cents base.amount) + ~credit: + (Account_id_map.singleton virt_checking_acc @@ cents base.amount) + ~labels: + Labels.( + empty + |> add (Iban_label Account_tag) base.account + |> add (String_label Counterparty_name_tag) + details.counterparty_name + |> add (Iban_label Counterparty_iban_tag) + details.counterparty_iban + |> add (String_label Desc_tag) details.description) + | Recurrent_direct_debit details -> + Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id + ~debit: + (Account_id_map.singleton virt_counterparty @@ cents base.amount) + ~credit: + (Account_id_map.singleton virt_checking_acc @@ cents base.amount) + ~labels: + Labels.( + empty + |> add (Iban_label Account_tag) base.account + |> add (Iban_label Counterparty_iban_tag) + details.counterparty_iban + |> add (String_label Counterparty_name_tag) + details.counterparty_name + |> add (String_label Desc_tag) details.description + |> add (String_label Reference_tag) details.reference + |> add (String_label Mandate_id_tag) details.mandate_id + |> add (String_label Creditor_id_tag) details.creditor_id + |> + match details.other_party with + | None -> Fn.id + | Some other_party -> + add (String_label Other_party_tag) other_party) + | Rounding_savings_deposit details -> + Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id + ~debit: + (Account_id_map.singleton virt_counterparty @@ cents base.amount) + ~credit: + (Account_id_map.singleton virt_checking_acc @@ cents base.amount) + ~labels: + Labels.( + empty + |> add (Unit_label Auto_round_savings_tag) () + |> add (String_label Savings_account_tag) details.savings_account) + | Deposit details -> + Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id + ~debit: + (Account_id_map.singleton virt_checking_acc @@ cents base.amount) + ~credit: + (Account_id_map.singleton virt_counterparty @@ cents base.amount) + ~labels: + Labels.( + empty + |> add (Iban_label Counterparty_iban_tag) + details.counterparty_iban + |> add (String_label Counterparty_name_tag) + details.counterparty_name + |> add (String_label Desc_tag) details.description + |> add (String_label Reference_tag) details.reference) + | Ideal_debit details -> + Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id + ~debit: + (Account_id_map.singleton virt_counterparty @@ cents base.amount) + ~credit: + (Account_id_map.singleton virt_checking_acc @@ cents base.amount) + ~labels: + Labels.( + empty + |> add (Iban_label Counterparty_iban_tag) + details.counterparty_iban + |> add (String_label Counterparty_name_tag) + details.counterparty_name + |> add (String_label Desc_tag) details.description + |> add (String_label Reference_tag) details.reference + |> add Timestamp_label details.timestamp) + | Batch_payment details -> + Tx.make ~cleared:(Some base.date) ~commodity_id:euc_id + ~debit: + (Account_id_map.singleton virt_counterparty @@ cents base.amount) + ~credit: + (Account_id_map.singleton virt_checking_acc @@ cents base.amount) + ~labels: + Labels.( + empty + |> add (Iban_label Counterparty_iban_tag) + details.counterparty_iban + |> add (String_label Counterparty_name_tag) + details.counterparty_name + |> add (String_label Desc_tag) details.description + |> add (String_label Reference_tag) details.reference) diff --git a/lib/ingcsv.ml b/lib/ingcsv.ml index 203a353..f3536bf 100644 --- a/lib/ingcsv.ml +++ b/lib/ingcsv.ml @@ -68,6 +68,8 @@ module Transaction_type = struct end module Primitive_tx = struct + exception Inconsistent_transaction_code + type t = { date : Date.t; description : string; @@ -85,6 +87,21 @@ module Primitive_tx = struct let opt_field (f : string -> 'a) (v : string) : 'a option = if String.is_empty (String.strip v) then None else Some (f v) + let headers = + [ + "Date"; + "Name / Description"; + "Account"; + "Counterparty"; + "Code"; + "Debit/credit"; + "Amount (EUR)"; + "Transaction type"; + "Notifications"; + "Resulting balance"; + "Tag"; + ] + let parse : t Delimited.Read.t = let open Delimited.Read.Let_syntax in let%map_open date = at_header "Date" ~f:Date.of_string @@ -99,12 +116,7 @@ module Primitive_tx = struct and resulting_balance = at_header "Resulting balance" ~f:Cents.of_string and tag = at_header "Tag" ~f:Fn.id in if not ([%equal: Transaction_type.t] code type_) then - Printf.failwithf - "Primitive_tx.parse: parsed transaction code (%S) and type (%S) do not \ - match" - (Transaction_type.to_string code) - (Transaction_type.to_string type_) - (); + raise Inconsistent_transaction_code; { date; description; @@ -123,7 +135,7 @@ type tx_base = { date : Date.t; account : Iban.t; amount : Cents.t; - res_bal : Cents.t; + resulting_balance : Cents.t; tag : string; } @@ -196,6 +208,7 @@ type parse_err = | Inconsistent_value_date | Inconsistent_counterparty_name | Inconsistent_counterparty_iban + | Inconsistent_transaction_code let assert_value_date (ptx : Primitive_tx.t) d = if Date.(d = ptx.date) then Ok () else Error Inconsistent_value_date @@ -383,7 +396,7 @@ let parse_batch_payment_credit_notifs notifs = (name, desc, iban, ref_, val_date) | _ | (exception _) -> Error No_notifs_match -let specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) : +let tx_specifics_from_prim (ams_tz : Time_ns.Zone.t) : Primitive_tx.t -> (tx_specifics, parse_err) result = function | { type_ = Payment_terminal; debit_credit = Debit; _ } as ptx -> let%bind @@ -531,3 +544,45 @@ let specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) : reference = ref_; } | _ -> Error Unknown_type_combination + +let tx_base_from_prim (ptx : Primitive_tx.t) : tx_base = + { + date = ptx.date; + account = ptx.account; + amount = ptx.amount; + resulting_balance = ptx.resulting_balance; + tag = ptx.tag; + } + +let tx_from_prim ptx ~ams_tz : (tx, parse_err) result = + let base = tx_base_from_prim ptx in + let%map specifics = tx_specifics_from_prim ams_tz ptx in + Tx (base, specifics) + +type csv_err = Parse_err of parse_err | Exn of exn + +module List = struct + include List + + let map_result ~(f : 'a -> ('b, 'c) result) : 'a list -> ('b list, 'c) result + = + let open Result.Let_syntax in + let rec go = function + | [] -> return [] + | x :: xs -> + let%map x' = f x and xs' = go xs in + x' :: xs' + in + go +end + +let read_channel (c : In_channel.t) ~ams_tz : (tx list, csv_err) result = + let%bind ptxs = + try + Ok + (Delimited.Read.read_lines ~header:(`Require Primitive_tx.headers) + Primitive_tx.parse c) + with e -> Error (Exn e) + in + List.map_result ptxs ~f:(tx_from_prim ~ams_tz) + |> Result.map_error ~f:(fun e -> Parse_err e) diff --git a/lib/ledger.ml b/lib/ledger.ml index 1d9a63c..3b52bcc 100644 --- a/lib/ledger.ml +++ b/lib/ledger.ml @@ -16,7 +16,7 @@ type tx_type = type iban_tag = Account_tag | Counterparty_iban_tag [@@deriving compare] -type unit_tag = Filed_tag | GooglePay_tag | AutoRoundSavings_tag +type unit_tag = Filed_tag | Google_pay_tag | Auto_round_savings_tag [@@deriving compare] type string_tag = @@ -81,22 +81,26 @@ end = struct end type scalar = Amount of Money.t | Rate of Z.t [@@deriving equal, compare] -type account_id = string list type commodity_id = string (* TODO: consider making this UUID *) +module Account_id = struct + type t = string list [@@deriving sexp, compare] +end + type account = { - id : account_id; + id : Account_id.t; description : string list; commodity_id : commodity_id; balance : Money.t; } -type bal_assert = { account : account_id; amount : Money.t; labels : Labels.t } +type bal_assert = { + account : Account_id.t; + amount : Money.t; + labels : Labels.t; +} -module Account_id_key = struct - type t = account_id - type comparator_witness -end +module Account_id_map = Map.Make (Account_id) module Tx : sig type t @@ -105,23 +109,23 @@ module Tx : sig 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 -> + debit:scalar Account_id_map.t -> + credit:scalar Account_id_map.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 debit : t -> scalar Account_id_map.t + val credit : t -> scalar Account_id_map.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; + debit : scalar Account_id_map.t; + credit : scalar Account_id_map.t; labels : Labels.t; } [@@deriving fields] -- cgit v1.2.3