Conversion

3 files changed, 245 insertions, 22 deletions

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]