From e6873458facadea0dfb228bb33291d6baf68c427 Mon Sep 17 00:00:00 2001 From: Rutger Broekhoff Date: Tue, 26 Aug 2025 00:35:27 +0200 Subject: Basic import seems to be working --- lib/convert.ml | 13 +++++++++++++ lib/iban.ml | 1 + lib/iban.mli | 1 + lib/ingcsv.ml | 30 ++++++++++++++--------------- lib/ledger.ml | 60 +++++++++++++++++++++++++++++++++++++++++++++++++--------- 5 files changed, 81 insertions(+), 24 deletions(-) (limited to 'lib') diff --git a/lib/convert.ml b/lib/convert.ml index cbdb90f..fb41020 100644 --- a/lib/convert.ml +++ b/lib/convert.ml @@ -1,5 +1,6 @@ open Core open Ledger +open Result.Let_syntax let virt_checking_acc = [ "Unfiled"; "Checking" ] let virt_savings_acc = [ "Unfiled"; "Savings" ] @@ -162,3 +163,15 @@ let tx_from_current_acc euc_id (Ingcsv.Tx (base, spec)) = details.counterparty_name |> add (String_label Desc_tag) details.description |> add (String_label Reference_tag) details.reference) + +let ba_from_current_acc (Ingcsv.Tx (base, _)) = + { + account = virt_checking_acc; + amount = Money.of_z base.resulting_balance; + labels = Labels.(empty |> add (Iban_label Account_tag) base.account); + } + +let les_from_current_acc euc_id tx = + let%map tx' = tx_from_current_acc euc_id tx in + let ba = ba_from_current_acc tx in + [ Bal_assert_item ba; Tx_item tx' ] diff --git a/lib/iban.ml b/lib/iban.ml index 6e47e9d..1db6c7b 100644 --- a/lib/iban.ml +++ b/lib/iban.ml @@ -84,4 +84,5 @@ let of_string s = | Some iban -> iban | None -> Printf.failwithf "Iban.of_string: %S" s () +let sexp_of_t iban = Sexp.Atom iban let equal = String.equal diff --git a/lib/iban.mli b/lib/iban.mli index 944928c..c2cad9f 100644 --- a/lib/iban.mli +++ b/lib/iban.mli @@ -3,6 +3,7 @@ open Core type t val make : string -> t option +val sexp_of_t : t -> Sexp.t include Stringable.S with type t := t include Equal.S with type t := t diff --git a/lib/ingcsv.ml b/lib/ingcsv.ml index f3536bf..53258fe 100644 --- a/lib/ingcsv.ml +++ b/lib/ingcsv.ml @@ -3,14 +3,7 @@ open Result.Let_syntax module Time_ns = Time_ns_unix module Debit_credit = struct - type t = Debit | Credit - - let of_string = function - | "Debit" -> Debit - | "Credit" -> Credit - | s -> Printf.failwithf "Debit_credit.of_string: %S" s () - - let to_string = function Debit -> "Debit" | Credit -> "Credit" + type t = Debit | Credit [@@deriving string, sexp_of] end module Cents = struct @@ -38,7 +31,7 @@ module Transaction_type = struct | Phone_banking (* GF (telefonisch bankieren, Girofoon) *) | Transfer (* OV (overboeking); 'Transfer' *) | Various (* DV (diversen) *) - [@@deriving equal, string] + [@@deriving equal, string, sexp_of] let of_code = function | "AC" -> Accept_giro @@ -209,6 +202,7 @@ type parse_err = | Inconsistent_counterparty_name | Inconsistent_counterparty_iban | Inconsistent_transaction_code +[@@deriving string, sexp_of] let assert_value_date (ptx : Primitive_tx.t) d = if Date.(d = ptx.date) then Ok () else Error Inconsistent_value_date @@ -348,7 +342,7 @@ let credit_transfer_rex = 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 + match Re.Pcre.extract ~rex:credit_transfer_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 @@ -554,12 +548,18 @@ let tx_base_from_prim (ptx : Primitive_tx.t) : tx_base = tag = ptx.tag; } -let tx_from_prim ptx ~ams_tz : (tx, parse_err) result = +type parse_err_ext = Transaction_type.t * Debit_credit.t * parse_err +[@@deriving sexp_of] + +let tx_from_prim ptx ~ams_tz : (tx, parse_err_ext) result = let base = tx_base_from_prim ptx in - let%map specifics = tx_specifics_from_prim ams_tz ptx in + let%map specifics = + Result.map_error (tx_specifics_from_prim ams_tz ptx) ~f:(fun e -> + (ptx.type_, ptx.debit_credit, e)) + in Tx (base, specifics) -type csv_err = Parse_err of parse_err | Exn of exn +type csv_err = Parse_err of parse_err_ext | Exn of exn module List = struct include List @@ -580,8 +580,8 @@ 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) + (Delimited.Read.read_lines ~sep:';' + ~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) diff --git a/lib/ledger.ml b/lib/ledger.ml index 3b52bcc..ba21e49 100644 --- a/lib/ledger.ml +++ b/lib/ledger.ml @@ -14,10 +14,11 @@ type tx_type = | Direct_debit_tx | Periodic_tx -type iban_tag = Account_tag | Counterparty_iban_tag [@@deriving compare] +type iban_tag = Account_tag | Counterparty_iban_tag +[@@deriving compare, sexp_of] type unit_tag = Filed_tag | Google_pay_tag | Auto_round_savings_tag -[@@deriving compare] +[@@deriving compare, sexp_of] type string_tag = | Desc_tag @@ -31,7 +32,7 @@ type string_tag = | Terminal_tag | Card_seq_no_tag | Savings_account_tag -[@@deriving compare] +[@@deriving compare, sexp_of] module Label = struct type 'a t = @@ -58,7 +59,39 @@ module Label = struct | Unit_label _, _ -> Gt end -module Labels = Dmap.Make (Label) +module Labels = struct + include Dmap.Make (Label) + + let sexp_of_t m = + Sexp.List + (bindings m + |> List.map ~f:(function + | Binding (Iban_label tag, iban) -> + Sexp.List + [ + Sexp.Atom "Iban_label"; + [%sexp_of: iban_tag] tag; + [%sexp_of: Iban.t] iban; + ] + | Binding (String_label tag, s) -> + Sexp.List + [ + Sexp.Atom "String_label"; + [%sexp_of: string_tag] tag; + Sexp.Atom s; + ] + | Binding (Timestamp_label, ts) -> + Sexp.List + [ Sexp.Atom "Timestamp_label"; [%sexp_of: Time_ns_unix.t] ts ] + | Binding (Unit_label tag, ()) -> + Sexp.List [ Sexp.Atom "Unit_label"; [%sexp_of: unit_tag] tag ])) +end + +module Z = struct + include Z + + let sexp_of_t x = Sexp.Atom (Z.to_string x) +end module Money : sig type t @@ -69,8 +102,9 @@ module Money : sig val to_z : t -> Z.t val ( + ) : t -> t -> t val ( - ) : t -> t -> t + val sexp_of_t : t -> Sexp.t end = struct - type t = Z.t + type t = Z.t [@@deriving sexp_of] let equal = Z.equal let compare = Z.compare @@ -80,8 +114,11 @@ end = struct let ( - ) x y = Z.(x - y) end -type scalar = Amount of Money.t | Rate of Z.t [@@deriving equal, compare] -type commodity_id = string (* TODO: consider making this UUID *) +type scalar = Amount of Money.t | Rate of Z.t +[@@deriving equal, compare, sexp_of] + +type commodity_id = string +(* TODO: consider making this UUID *) [@@deriving sexp] module Account_id = struct type t = string list [@@deriving sexp, compare] @@ -93,12 +130,14 @@ type account = { commodity_id : commodity_id; balance : Money.t; } +[@@deriving sexp_of] type bal_assert = { account : Account_id.t; amount : Money.t; labels : Labels.t; } +[@@deriving sexp_of] module Account_id_map = Map.Make (Account_id) @@ -119,6 +158,7 @@ module Tx : sig val debit : t -> scalar Account_id_map.t val credit : t -> scalar Account_id_map.t val labels : t -> Labels.t + val sexp_of_t : t -> Sexp.t end = struct (* We hide this because we only want to allow constructing balanced transactions *) type t = { @@ -128,7 +168,7 @@ end = struct credit : scalar Account_id_map.t; labels : Labels.t; } - [@@deriving fields] + [@@deriving fields, sexp_of] type error = Unbalanced @@ -141,4 +181,6 @@ end = struct end type item = Tx_item of Tx.t | Bal_assert_item of bal_assert -type ledger = Ledger of item list +[@@deriving sexp_of] + +type t = item list [@@deriving sexp_of] -- cgit v1.2.3