path: root/lib/ingcsv.ml

open Prelude
open Result.Let_syntax

module Debit_credit = struct
  type t = Debit | Credit [@@deriving string, sexp_of]
end

module Cents = struct
  type t = Z.t

  let of_string s =
    let high, low = String.lsplit2_exn s ~on:',' in
    assert (String.length low = 2);
    Z.((of_string high * ~$100) + of_string low)
end

module Transaction_type = struct
  type t =
    | Accept_giro (* AC (acceptgiro) *)
    | Atm_withdrawal (* GM (geldautomaat, Giromaat) *)
    | Batch_payment (* VZ (verzamelbetaling); 'Batch payment' *)
    | Branch_posting (* FL (filiaalboeking) *)
    | Deposit (* ST (storting) *)
    | Direct_debit (* IC (incasso); 'SEPA direct debit' *)
    | Ideal (* ID (iDEAL); 'iDEAL' *)
    | Online_banking (* GT (internetbankieren, Girotel); 'Online Banking' *)
    | Office_withdrawal (* PK (opname kantoor, postkantoor) *)
    | Payment_terminal (* BA (betaalautomaat); 'Payment terminal' *)
    | Periodic_transfer (* PO (periodieke overschrijving) *)
    | Phone_banking (* GF (telefonisch bankieren, Girofoon) *)
    | Transfer (* OV (overboeking); 'Transfer' *)
    | Various (* DV (diversen) *)
  [@@deriving equal, string, sexp_of]

  let of_code = function
    | "AC" -> Accept_giro
    | "GM" -> Atm_withdrawal
    | "VZ" -> Batch_payment
    | "FL" -> Branch_posting
    | "ST" -> Deposit
    | "IC" -> Direct_debit
    | "ID" -> Ideal
    | "GT" -> Online_banking
    | "PK" -> Office_withdrawal
    | "BA" -> Payment_terminal
    | "PO" -> Periodic_transfer
    | "GF" -> Phone_banking
    | "OV" -> Transfer
    | "DV" -> Various
    | s -> Printf.failwithf "Transaction_type.of_code: %S" s ()

  let of_type = function
    | "SEPA direct debit" -> Direct_debit
    | "Batch payment" -> Batch_payment
    | "Online Banking" -> Online_banking
    | "Payment terminal" -> Payment_terminal
    | "Transfer" -> Transfer
    | "iDEAL" -> Ideal
    | s -> Printf.failwithf "Transaction_type.of_type: %S" s ()
end

module Primitive_tx = struct
  exception Inconsistent_transaction_code

  type t = {
    date : Date.t;
    description : string;
    account : Iban.t;
    counterparty : Iban.t option;
    type_ : Transaction_type.t;
    debit_credit : Debit_credit.t;
    amount : Cents.t;
    notifications : string;
    resulting_balance : Cents.t;
    tag : string;
  }
  [@@deriving fields]

  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
    and description = at_header "Name / Description" ~f:Fn.id
    and account = at_header "Account" ~f:Iban.of_string
    and counterparty = at_header "Counterparty" ~f:(opt_field Iban.of_string)
    and code = at_header "Code" ~f:Transaction_type.of_code
    and debit_credit = at_header "Debit/credit" ~f:Debit_credit.of_string
    and amount = at_header "Amount (EUR)" ~f:Cents.of_string
    and type_ = at_header "Transaction type" ~f:Transaction_type.of_type
    and notifications = at_header "Notifications" ~f:Fn.id
    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
      raise Inconsistent_transaction_code;
    {
      date;
      description;
      account;
      counterparty;
      type_;
      debit_credit;
      amount;
      notifications;
      resulting_balance;
      tag;
    }
end

type tx_base = {
  date : Date.t;
  account : Iban.t;
  amount : Cents.t;
  resulting_balance : Cents.t;
  tag : string;
}

type tx_specifics =
  | Payment_terminal_payment of {
      counterparty_name : string;
      card_sequence_no : string;
      timestamp : Time_ns.t;
      transaction : string;
      terminal : string;
      google_pay : bool;
    }
  | Payment_terminal_cashback of {
      counterparty_name : string;
      card_sequence_no : string;
      timestamp : Time_ns.t;
      transaction : string;
      terminal : string;
    }
  | Online_banking_credit of {
      counterparty_name : string;
      counterparty_iban : Iban.t;
      description : string;
      timestamp : Time_ns.t;
    }
  | Online_banking_debit of {
      counterparty_name : string;
      counterparty_iban : Iban.t;
      description : string;
      mtimestamp : Time_ns.t option;
    }
  | Recurrent_direct_debit of {
      counterparty_name : string;
      counterparty_iban : Iban.t;
      description : string;
      reference : string;
      mandate_id : string;
      creditor_id : string;
      other_party : string option;
    }
  | Rounding_savings_deposit of { savings_account : string }
  | Deposit of {
      counterparty_name : string;
      counterparty_iban : Iban.t;
      description : string;
      reference : string;
    }
  | Ideal_debit of {
      counterparty_name : string;
      counterparty_iban : Iban.t;
      description : string;
      timestamp : Time_ns.t;
      reference : string;
    }
  | Batch_payment of {
      counterparty_name : string;
      counterparty_iban : Iban.t;
      description : string;
      reference : string;
    }

type tx = Tx of tx_base * tx_specifics

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
  | 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

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: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
      (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 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
          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;
          card_sequence_no = card_seq_no;
          timestamp;
          transaction;
          terminal =
            (if String.is_empty gpay_term then no_gpay_term else gpay_term);
          google_pay = String.is_empty no_gpay_term;
        }
  | { type_ = Payment_terminal; debit_credit = Credit; _ } as ptx ->
      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;
          card_sequence_no = card_seq_no;
          timestamp;
          transaction;
          terminal = term;
        }
  | { type_ = Online_banking; debit_credit = Credit; _ } as ptx ->
      let%bind name, desc, iban, timestamp, val_date =
        parse_online_banking_credit_notifs ptx.notifications ~ams_tz
      in
      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;
          counterparty_iban = iban;
          description = desc;
          timestamp;
        }
  | { type_ = Online_banking; debit_credit = Debit; _ } as ptx ->
      let%bind name, desc, iban, mtimestamp, val_date =
        parse_online_banking_debit_notifs ptx.notifications ~ams_tz
      in
      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;
          counterparty_iban = iban;
          description = desc;
          mtimestamp;
        }
  | { type_ = Direct_debit; debit_credit = Debit; _ } as ptx
    when String.is_suffix ptx.notifications
           ~suffix:"Recurrent SEPA direct debit" ->
      let%bind name, desc, iban, ref_, mandate_id, creditor_id =
        parse_ing_insurance_direct_debit_notifs ptx.notifications
      in
      let%map () = assert_counterparty_name ptx name
      and () = assert_counterparty_iban ptx iban in
      Recurrent_direct_debit
        {
          counterparty_name = name;
          counterparty_iban = iban;
          description = desc;
          reference = ref_;
          mandate_id;
          creditor_id;
          other_party = None;
        }
  | { type_ = Direct_debit; debit_credit = Debit; _ } as ptx ->
      let%bind
          name, desc, iban, ref_, mandate_id, creditor_id, other_party, val_date
          =
        parse_normal_direct_debit_notifs ptx.notifications
      in
      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;
          counterparty_iban = iban;
          description = desc;
          reference = ref_;
          mandate_id;
          creditor_id;
          other_party =
            (if String.is_empty other_party then None else Some other_party);
        }
  | { type_ = Transfer; debit_credit = Credit; _ } as ptx ->
      let%bind name, desc, iban, ref_, val_date =
        parse_credit_transfer_notifs ptx.notifications
      in
      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;
          counterparty_iban = iban;
          description = desc;
          reference = ref_;
        }
  | { type_ = Transfer; debit_credit = Debit; _ } as ptx ->
      let%bind val_date, savings_account =
        parse_debit_transfer_notifs ptx.notifications
      in
      let%map () = assert_value_date ptx val_date in
      Rounding_savings_deposit { savings_account }
  | { type_ = Ideal; debit_credit = Debit; _ } as ptx ->
      let%bind name, desc, iban, timestamp, ref_, val_date =
        parse_ideal_debit_notifs ptx.notifications ~ams_tz
      in
      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;
          counterparty_iban = iban;
          description = desc;
          timestamp;
          reference = ref_;
        }
  | { type_ = Batch_payment; debit_credit = Credit; _ } as ptx ->
      let%bind name, desc, iban, ref_, val_date =
        parse_batch_payment_credit_notifs ptx.notifications
      in
      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;
          counterparty_iban = iban;
          description = desc;
          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;
  }

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 =
    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_ext | Exn of exn

let read_channel (c : In_channel.t) ~ams_tz : (tx list, csv_err) result =
  let%bind ptxs =
    try
      Ok
        (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)
  |> Result.map_error ~f:(fun e -> Parse_err e)