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 --- .gitignore | 1 + bin/dune | 2 ++ bin/main.ml | 40 ++++++++++++++++++++++++++++++++++++++- lib/convert.ml | 13 +++++++++++++ lib/iban.ml | 1 + lib/iban.mli | 1 + lib/ingcsv.ml | 30 ++++++++++++++--------------- lib/ledger.ml | 60 +++++++++++++++++++++++++++++++++++++++++++++++++--------- 8 files changed, 123 insertions(+), 25 deletions(-) diff --git a/.gitignore b/.gitignore index c4c4112..27fffed 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,4 @@ *~ _build/ _opam/ +*.csv diff --git a/bin/dune b/bin/dune index b82e38f..34c3866 100644 --- a/bin/dune +++ b/bin/dune @@ -1,4 +1,6 @@ (executable (public_name rdcapsis) (name main) + (preprocess + (pps ppx_jane)) (libraries rdcapsis)) diff --git a/bin/main.ml b/bin/main.ml index 7bf6048..1c6c6c9 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -1 +1,39 @@ -let () = print_endline "Hello, World!" +open Core +module Time_ns = Time_ns_unix + +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 + +module Result = struct + include Result + + let unwrap = function + | Error _ -> failwith "Result.unwrap: unexpected (Error _)" + | Ok v -> v +end + +let () = + let ams_tz = Time_ns.Zone.find_exn "Europe/Amsterdam" in + let prim_txs = + In_channel.with_file ~binary:true "test.csv" + ~f:(Rdcapsis.Ingcsv.read_channel ~ams_tz) + |> Result.unwrap + in + let euc_id = "EUC" in + let ledger = + List.map_result ~f:(Rdcapsis.Convert.les_from_current_acc euc_id) prim_txs + |> Result.unwrap |> List.concat + in + print_endline (Sexp.to_string_hum ([%sexp_of: Rdcapsis.Ledger.t] ledger)) 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