OCaml

1 files changed, 0 insertions, 407 deletions

diff --git a/app/Import/Ing/CurrentAccountCsv.hs b/app/Import/Ing/CurrentAccountCsv.hs
deleted file mode 100644
index 21ca53d..0000000
--- a/app/Import/Ing/CurrentAccountCsv.hs
+++ /dev/null
@@ -1,407 +0,0 @@
-{-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Import.Ing.CurrentAccountCsv where
-
-import Control.Applicative ((<|>))
-import Control.Monad (when)
-import Data.ByteString.Lazy qualified as BS
-import Data.Csv ((.:))
-import Data.Csv qualified as C
-import Data.Decimal (Decimal)
-import Data.Generics.Product.Subtype (upcast)
-import Data.Iban (Iban)
-import Data.Res (Res (Err, Ok))
-import Data.Text qualified as T
-import Data.Time.Calendar (Day)
-import Data.Time.Clock (UTCTime)
-import Data.Time.Zones (TZ, loadTZFromDB)
-import Data.Vector qualified as V
-import GHC.Generics
-import Import.Ing.Shared
-  ( DebitCredit (Credit, Debit),
-    maybeCP,
-    parseDateM,
-    parseDecimalM,
-    parseIbanM,
-    parseTimestampM,
-    scsvOptions,
-  )
-import System.IO (Handle)
-import Text.Regex.TDFA ((=~~))
-
-data Tx = Tx TxBase TxSpecifics deriving (Show)
-
-data TxBase = TxBase
-  { date :: !Day,
-    account :: !Iban,
-    amount :: !Decimal,
-    resBal :: !Decimal,
-    tag :: !T.Text
-  }
-  deriving (Show, Generic)
-
-data TxSpecifics
-  = PaymentTerminalPayment
-      { counterpartyName :: !T.Text,
-        cardSequenceNo :: !T.Text,
-        timestamp :: !UTCTime,
-        transaction :: !T.Text,
-        terminal :: !T.Text,
-        googlePay :: !Bool
-      }
-  | PaymentTerminalCashback
-      { counterpartyName :: !T.Text,
-        cardSequenceNo :: !T.Text,
-        timestamp :: !UTCTime,
-        transaction :: !T.Text,
-        terminal :: !T.Text
-      }
-  | OnlineBankingCredit
-      { counterpartyName :: !T.Text,
-        counterpartyIban :: !Iban,
-        description :: !T.Text,
-        timestamp :: !UTCTime
-      }
-  | OnlineBankingDebit
-      { counterpartyName :: !T.Text,
-        counterpartyIban :: !Iban,
-        description :: T.Text,
-        mtimestamp :: !(Maybe UTCTime)
-      }
-  | RecurrentDirectDebit
-      { counterpartyName :: !T.Text,
-        counterpartyIban :: !Iban,
-        description :: !T.Text,
-        reference :: !T.Text,
-        mandateId :: !T.Text,
-        creditorId :: !T.Text,
-        otherParty :: !(Maybe T.Text)
-      }
-  | RoundingSavingsDeposit
-      {savingsAccount :: !T.Text}
-  | DepositTransfer
-      { counterpartyName :: !T.Text,
-        counterpartyIban :: !Iban,
-        description :: !T.Text,
-        reference :: !T.Text
-      }
-  | IdealDebit
-      { counterpartyName :: !T.Text,
-        counterpartyIban :: !Iban,
-        description :: !T.Text,
-        timestamp :: !UTCTime,
-        reference :: !T.Text
-      }
-  | BatchPayment
-      { counterpartyName :: !T.Text,
-        counterpartyIban :: !Iban,
-        description :: !T.Text,
-        reference :: !T.Text
-      }
-  deriving (Show, Generic)
-
-data TransactionType
-  = AcceptGiroType -- AC (acceptgiro)
-  | AtmWithdrawalType -- GM (geldautomaat, Giromaat)
-  | BatchPaymentType -- VZ (verzamelbetaling); 'Batch payment'
-  | BranchPostingType -- FL (filiaalboeking)
-  | DepositType -- ST (storting)
-  | DirectDebitType -- IC (incasso); 'SEPA direct debit'
-  | IdealType -- ID (iDEAL); 'iDEAL'
-  | OnlineBankingType -- GT (internetbankieren, Girotel); 'Online Banking'
-  | OfficeWithdrawalType -- PK (opname kantoor, postkantoor)
-  | PaymentTerminalType -- BA (betaalautomaat); 'Payment terminal'
-  | PeriodicTransferType -- PO (periodieke overschrijving)
-  | PhoneBankingType -- GF (telefonisch bankieren, Girofoon)
-  | TransferType -- OV (overboeking); 'Transfer'
-  | VariousType -- DV (diversen)
-  deriving (Eq, Show)
-
-parseCode :: T.Text -> C.Parser TransactionType
-parseCode "AC" = return AcceptGiroType
-parseCode "GM" = return AtmWithdrawalType
-parseCode "VZ" = return BatchPaymentType
-parseCode "FL" = return BranchPostingType
-parseCode "ST" = return DepositType
-parseCode "IC" = return DirectDebitType
-parseCode "ID" = return IdealType
-parseCode "GT" = return OnlineBankingType
-parseCode "PK" = return OfficeWithdrawalType
-parseCode "BA" = return PaymentTerminalType
-parseCode "PO" = return PeriodicTransferType
-parseCode "GF" = return PhoneBankingType
-parseCode "OV" = return TransferType
-parseCode "DV" = return VariousType
-parseCode t = fail $ "Unknown transaction code '" ++ T.unpack t ++ "'"
-
-parseType :: T.Text -> C.Parser TransactionType
-parseType "SEPA direct debit" = return DirectDebitType
-parseType "Batch payment" = return BatchPaymentType
-parseType "Online Banking" = return OnlineBankingType
-parseType "Payment terminal" = return PaymentTerminalType
-parseType "Transfer" = return TransferType
-parseType "iDEAL" = return IdealType
-parseType t = fail $ "Unknown transaction type '" ++ T.unpack t ++ "'"
-
-data PrimTx = PrimTx
-  { date :: !Day,
-    description :: !T.Text,
-    account :: !Iban,
-    counterparty :: !(Maybe Iban),
-    transactionType :: !TransactionType,
-    debitCredit :: !DebitCredit,
-    amount :: !Decimal,
-    notifications :: !T.Text,
-    resBal :: !Decimal,
-    tag :: !T.Text
-  }
-  deriving (Show, Generic)
-
-debitCreditCP :: T.Text -> C.Parser DebitCredit
-debitCreditCP "Debit" = return Debit
-debitCreditCP "Credit" = return Credit
-debitCreditCP t = fail ("Unknown debit/credit value '" ++ T.unpack t ++ "'")
-
-instance C.FromNamedRecord PrimTx where
-  parseNamedRecord m = do
-    code <- m .: "Code" >>= parseCode
-    txType <- m .: "Transaction type" >>= parseType
-    if code /= txType
-      then fail "Expected code and transaction type to agree"
-      else
-        PrimTx
-          <$> (m .: "Date" >>= parseDateM "%0Y%m%d")
-          <*> m .: "Name / Description"
-          <*> (m .: "Account" >>= parseIbanM)
-          <*> (m .: "Counterparty" >>= maybeCP parseIbanM)
-          <*> return txType
-          <*> (m .: "Debit/credit" >>= debitCreditCP)
-          <*> (m .: "Amount (EUR)" >>= parseDecimalM)
-          <*> m .: "Notifications"
-          <*> (m .: "Resulting balance" >>= parseDecimalM)
-          <*> m .: "Tag"
-
-processPrimTx :: TZ -> PrimTx -> Res String Tx
-processPrimTx amsTz ptx = Tx (txBaseFromPrim ptx) <$> specificsFromPrim amsTz ptx
-
-parseValueDate :: T.Text -> Res String Day
-parseValueDate = parseDateM "%d/%m/%Y"
-
-assertValueDate :: Day -> T.Text -> Res String ()
-assertValueDate expected t = do
-  valDate <- parseDateM "%d/%m/%Y" t
-  when (valDate /= expected) $
-    fail "Expected transaction date and value date to be the same"
-
-assertValueDatePtx :: PrimTx -> T.Text -> Res String ()
-assertValueDatePtx PrimTx {date = expected} = assertValueDate expected
-
-specificsFromPrim :: TZ -> PrimTx -> Res String TxSpecifics
-specificsFromPrim amsTz ptx@PrimTx {transactionType = PaymentTerminalType, debitCredit = Debit} = do
-  let regex = "^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})$" :: String
-  (_, _, _, [cardSeqNo, timestampTxt, transaction, _, gpayTerm, noGpayTerm, valDateTxt]) <-
-    ptx.notifications =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
-  assertValueDatePtx ptx valDateTxt
-  timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt
-  return $
-    PaymentTerminalPayment
-      { counterpartyName = ptx.description,
-        cardSequenceNo = cardSeqNo,
-        timestamp = timestamp,
-        transaction = transaction,
-        terminal = if T.null gpayTerm then noGpayTerm else gpayTerm,
-        googlePay = T.null noGpayTerm
-      }
-specificsFromPrim amsTz ptx@PrimTx {transactionType = PaymentTerminalType, debitCredit = Credit} = do
-  let regex = "^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})$" :: String
-  (_, _, _, [cardSeqNo, timestampTxt, transaction, term, valDateTxt]) <-
-    notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
-  assertValueDatePtx ptx valDateTxt
-  timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt
-  return $
-    PaymentTerminalCashback
-      { counterpartyName = ptx.description,
-        cardSequenceNo = cardSeqNo,
-        timestamp = timestamp,
-        transaction = transaction,
-        terminal = term
-      }
-specificsFromPrim amsTz ptx@PrimTx {transactionType = OnlineBankingType, debitCredit = Credit} = do
-  let regex = "^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})$" :: String
-  (_, _, _, [name, desc, ibanTxt, timestampTxt, valDateTxt]) <-
-    notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
-  assertValueDatePtx ptx valDateTxt
-  iban <- parseIbanM ibanTxt
-  timestamp <- parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt
-  when (name /= ptx.description) $
-    fail "Expected counterparty name for online banking credit to match primitive description"
-  when (Just iban /= ptx.counterparty) $
-    fail "Expected IBAN for online banking credit to match and primitive counterparty IBAN"
-  return $
-    OnlineBankingCredit
-      { counterpartyName = name,
-        counterpartyIban = iban,
-        description = desc,
-        timestamp = timestamp
-      }
-specificsFromPrim amsTz ptx@PrimTx {transactionType = OnlineBankingType, debitCredit = Debit} = do
-  let regex = "^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})$" :: String
-  (_, _, _, [name, desc, ibanTxt, _, timestampTxt, valDateTxt]) <-
-    notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
-  assertValueDatePtx ptx valDateTxt
-  iban <- parseIbanM ibanTxt
-  timestamp <-
-    if T.null timestampTxt
-      then pure Nothing
-      else Just <$> parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt
-  when (name /= ptx.description) $
-    fail "Expected counterparty name for online banking debit to match primitive description"
-  when (Just iban /= ptx.counterparty) $
-    fail "Expected IBAN for online banking debit to match and primitive counterparty IBAN"
-  return $
-    OnlineBankingDebit
-      { counterpartyIban = iban,
-        counterpartyName = name,
-        description = desc,
-        mtimestamp = timestamp
-      }
-specificsFromPrim _ ptx@PrimTx {transactionType = DirectDebitType, debitCredit = Debit} =
-  normalRecurrentDirectDebit <|> ingInsurancePayment
-  where
-    normalRecurrentDirectDebit = do
-      let regex = "^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})$" :: String
-      (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId, _, otherParty, valDateTxt]) <-
-        notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
-      assertValueDatePtx ptx valDateTxt
-      iban <- parseIbanM ibanTxt
-      when (name /= ptx.description) $
-        fail "Expected counterparty name for direct debit to match primitive description"
-      when (Just iban /= ptx.counterparty) $
-        fail "Expected IBAN for direct debit to match and primitive counterparty IBAN"
-      return $
-        RecurrentDirectDebit
-          { counterpartyName = name,
-            counterpartyIban = iban,
-            description = desc,
-            reference = ref,
-            mandateId = mandateId,
-            creditorId = creditorId,
-            otherParty = if T.null otherParty then Nothing else Just otherParty
-          }
-    ingInsurancePayment = do
-      let regex = "^Name: (.* ING Verzekeren) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit$" :: String
-      (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId]) <-
-        notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
-      iban <- parseIbanM ibanTxt
-      when (name /= ptx.description) $
-        fail "Expected counterparty name for direct debit to match primitive description"
-      when (Just iban /= ptx.counterparty) $
-        fail "Expected IBAN for direct debit to match and primitive counterparty IBAN"
-      return $
-        RecurrentDirectDebit
-          { counterpartyName = name,
-            counterpartyIban = iban,
-            description = desc,
-            reference = ref,
-            mandateId = mandateId,
-            creditorId = creditorId,
-            otherParty = Nothing
-          }
-specificsFromPrim _ ptx@PrimTx {transactionType = TransferType, debitCredit = Credit} = do
-  let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
-  (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <-
-    notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
-  assertValueDatePtx ptx valDateTxt
-  iban <- parseIbanM ibanTxt
-  when (name /= ptx.description) $
-    fail "Expected counterparty name for deposit transfer to match primitive description"
-  when (Just iban /= ptx.counterparty) $
-    fail "Expected IBAN for deposit transfer to match and primitive counterparty IBAN"
-  return $
-    DepositTransfer
-      { counterpartyName = name,
-        counterpartyIban = iban,
-        description = desc,
-        reference = ref
-      }
-specificsFromPrim _ ptx@PrimTx {transactionType = TransferType, debitCredit = Debit} = do
-  let regex = "^To Oranje spaarrekening ([A-Z0-9]+) Afronding Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
-  (_, _, _, [savingsAccount, valDateTxt]) <-
-    ptx.notifications =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
-  assertValueDatePtx ptx valDateTxt
-  return $ RoundingSavingsDeposit {savingsAccount = savingsAccount}
-specificsFromPrim amsTz ptx@PrimTx {transactionType = IdealType, debitCredit = Debit} = do
-  let regex = "^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})$" :: String
-  (_, _, _, [name, desc, ibanTxt, timestampTxt, ref, valDateTxt]) <-
-    notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
-  assertValueDatePtx ptx valDateTxt
-  timestamp <- parseTimestampM "%d-%m-%Y %H:%M" amsTz timestampTxt
-  iban <- parseIbanM ibanTxt
-  when (name /= ptx.description) $
-    fail "Expected counterparty name for iDEAL payment to match primitive description"
-  when (Just iban /= ptx.counterparty) $
-    fail "Expected IBAN for iDEAL payment to match and primitive counterparty IBAN"
-  return $
-    IdealDebit
-      { counterpartyName = name,
-        counterpartyIban = iban,
-        description = desc,
-        timestamp = timestamp,
-        reference = ref
-      }
-specificsFromPrim _ ptx@PrimTx {transactionType = BatchPaymentType, debitCredit = Credit} = do
-  let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
-  (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <-
-    notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
-  assertValueDatePtx ptx valDateTxt
-  iban <- parseIbanM ibanTxt
-  when (name /= ptx.description) $
-    fail "Expected counterparty name for batch payment to match primitive description"
-  when (Just iban /= ptx.counterparty) $
-    fail "Expected IBAN for batch payment to match and primitive counterparty IBAN"
-  return $
-    BatchPayment
-      { counterpartyName = name,
-        counterpartyIban = iban,
-        description = desc,
-        reference = ref
-      }
-specificsFromPrim _ ptx =
-  fail $
-    "Could not extract data from transaction ("
-      ++ show (transactionType ptx)
-      ++ " / "
-      ++ show (debitCredit ptx)
-      ++ ")"
-
-txBaseFromPrim :: PrimTx -> TxBase
-txBaseFromPrim = upcast
-
-readFile :: Handle -> IO (V.Vector Tx)
-readFile h = do
-  tz <- loadTZFromDB "Europe/Amsterdam"
-  contents <- BS.hGetContents h
-  primTxs <- case C.decodeByNameWith scsvOptions contents of
-    Left err -> fail err
-    Right
-      ( [ "Date",
-          "Name / Description",
-          "Account",
-          "Counterparty",
-          "Code",
-          "Debit/credit",
-          "Amount (EUR)",
-          "Transaction type",
-          "Notifications",
-          "Resulting balance",
-          "Tag"
-          ],
-        txs
-        ) ->
-        return txs
-    Right _ ->
-      fail "Headers do not match expected pattern"
-  case V.mapM (processPrimTx tz) primTxs of
-    Err err -> fail err
-    Ok txs -> return txs