From 6b27332df29a294167fe4f5b91e2fa0a8f96c665 Mon Sep 17 00:00:00 2001 From: Rutger Broekhoff Date: Sat, 22 Mar 2025 14:53:56 +0100 Subject: Get rid of older current account statement parser --- app/Import/Ing/CurrentAccountCsv2.hs | 411 ----------------------------------- 1 file changed, 411 deletions(-) delete mode 100644 app/Import/Ing/CurrentAccountCsv2.hs (limited to 'app/Import/Ing/CurrentAccountCsv2.hs') diff --git a/app/Import/Ing/CurrentAccountCsv2.hs b/app/Import/Ing/CurrentAccountCsv2.hs deleted file mode 100644 index 0a5f8af..0000000 --- a/app/Import/Ing/CurrentAccountCsv2.hs +++ /dev/null @@ -1,411 +0,0 @@ -{-# LANGUAGE OverloadedLists #-} -{-# LANGUAGE OverloadedStrings #-} - -module Import.Ing.CurrentAccountCsv2 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.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 Import.Ing.Shared - ( DebitCredit (Credit, Debit), - maybeCP, - parseDateM, - parseDecimalM, - parseIbanM, - parseTimestampM, - scsvOptions, - ) -import System.IO (Handle) -import Text.Regex.TDFA ((=~~)) - -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 - { ptxDate :: !Day, - ptxDescription :: !T.Text, - ptxAccount :: !Iban, - ptxCounterparty :: !(Maybe Iban), - ptxTransactionType :: !TransactionType, - ptxDebitCredit :: !DebitCredit, - ptxAmount :: !Decimal, - ptxNotifications :: !T.Text, - ptxResBal :: !Decimal, - ptxTag :: !T.Text - } - deriving (Show) - -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 {ptxDate = expected} = assertValueDate expected - -specificsFromPrim :: TZ -> PrimTx -> Res String TxSpecifics -specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = PaymentTerminalType, ptxDebitCredit = 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]) <- - ptxNotifications 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 $ - PaymentTerminalPayment - { ptpCounterpartyName = ptxDescription ptx, - ptpCardSequenceNo = cardSeqNo, - ptpTimestamp = timestamp, - ptpTransaction = transaction, - ptpTerminal = if T.null gpayTerm then noGpayTerm else gpayTerm, - ptpGooglePay = T.null noGpayTerm - } -specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = PaymentTerminalType, ptxDebitCredit = 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]) <- - ptxNotifications 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 - { ptcCounterpartyName = ptxDescription ptx, - ptcCardSequenceNo = cardSeqNo, - ptcTimestamp = timestamp, - ptcTransaction = transaction, - ptcTerminal = term - } -specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = OnlineBankingType, ptxDebitCredit = 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]) <- - ptxNotifications 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 /= ptxDescription ptx) $ - fail "Expected counterparty name for online banking credit to match primitive description" - when (Just iban /= ptxCounterparty ptx) $ - fail "Expected IBAN for online banking credit to match and primitive counterparty IBAN" - return $ - OnlineBankingCredit - { obcCounterpartyName = name, - obcCounterpartyIban = iban, - obcDescription = desc, - obcTimestamp = timestamp - } -specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = OnlineBankingType, ptxDebitCredit = 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]) <- - ptxNotifications 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 /= ptxDescription ptx) $ - fail "Expected counterparty name for online banking debit to match primitive description" - when (Just iban /= ptxCounterparty ptx) $ - fail "Expected IBAN for online banking debit to match and primitive counterparty IBAN" - return $ - OnlineBankingDebit - { obdCounterpartyIban = iban, - obdCounterpartyName = name, - obdDescription = desc, - obdTimestamp = timestamp - } -specificsFromPrim _ ptx@PrimTx {ptxTransactionType = DirectDebitType, ptxDebitCredit = 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]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) - assertValueDatePtx ptx valDateTxt - iban <- parseIbanM ibanTxt - when (name /= ptxDescription ptx) $ - fail "Expected counterparty name for direct debit to match primitive description" - when (Just iban /= ptxCounterparty ptx) $ - fail "Expected IBAN for direct debit to match and primitive counterparty IBAN" - return $ - RecurrentDirectDebit - { rddCounterpartyName = name, - rddCounterpartyIban = iban, - rddDescription = desc, - rddReference = ref, - rddMandateId = mandateId, - rddCreditorId = creditorId, - rddOtherParty = 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]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) - iban <- parseIbanM ibanTxt - when (name /= ptxDescription ptx) $ - fail "Expected counterparty name for direct debit to match primitive description" - when (Just iban /= ptxCounterparty ptx) $ - fail "Expected IBAN for direct debit to match and primitive counterparty IBAN" - return $ - RecurrentDirectDebit - { rddCounterpartyName = name, - rddCounterpartyIban = iban, - rddDescription = desc, - rddReference = ref, - rddMandateId = mandateId, - rddCreditorId = creditorId, - rddOtherParty = Nothing - } -specificsFromPrim _ ptx@PrimTx {ptxTransactionType = TransferType, ptxDebitCredit = 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]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) - assertValueDatePtx ptx valDateTxt - iban <- parseIbanM ibanTxt - when (name /= ptxDescription ptx) $ - fail "Expected counterparty name for deposit transfer to match primitive description" - when (Just iban /= ptxCounterparty ptx) $ - fail "Expected IBAN for deposit transfer to match and primitive counterparty IBAN" - return $ - DepositTransfer - { dtCounterpartyName = name, - dtCounterpartyIban = iban, - dtDescription = desc, - dtReference = ref - } -specificsFromPrim _ ptx@PrimTx {ptxTransactionType = TransferType, ptxDebitCredit = 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]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) - assertValueDatePtx ptx valDateTxt - return $ RoundingSavingsDeposit {rsdSavingsAccount = savingsAccount} -specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = IdealType, ptxDebitCredit = 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]) <- - ptxNotifications 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 /= ptxDescription ptx) $ - fail "Expected counterparty name for iDEAL payment to match primitive description" - when (Just iban /= ptxCounterparty ptx) $ - fail "Expected IBAN for iDEAL payment to match and primitive counterparty IBAN" - return $ - IdealDebit - { idCounterpartyName = name, - idCounterpartyIban = iban, - idDescription = desc, - idTimestamp = timestamp, - idReference = ref - } -specificsFromPrim _ ptx@PrimTx {ptxTransactionType = BatchPaymentType, ptxDebitCredit = 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]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) - assertValueDatePtx ptx valDateTxt - iban <- parseIbanM ibanTxt - when (name /= ptxDescription ptx) $ - fail "Expected counterparty name for batch payment to match primitive description" - when (Just iban /= ptxCounterparty ptx) $ - fail "Expected IBAN for batch payment to match and primitive counterparty IBAN" - return $ - BatchPayment - { bpCounterpartyName = name, - bpCounterpartyIban = iban, - bpDescription = desc, - bpReference = ref - } -specificsFromPrim _ ptx = - fail $ - "Could not extract data from transaction (" - ++ show (ptxTransactionType ptx) - ++ " / " - ++ show (ptxDebitCredit ptx) - ++ ")" - -txBaseFromPrim :: PrimTx -> TxBase -txBaseFromPrim = - TxBase - <$> ptxDate - <*> ptxAccount - <*> ptxAmount - <*> ptxResBal - <*> ptxTag - -data Tx = Tx TxBase TxSpecifics deriving (Show) - -data TxBase = TxBase - { txbDate :: !Day, - txbAccount :: !Iban, - txbAmount :: !Decimal, - txbResBal :: !Decimal, - txbTag :: !T.Text - } - deriving (Show) - -data TxSpecifics - = PaymentTerminalPayment - { ptpCounterpartyName :: !T.Text, - ptpCardSequenceNo :: !T.Text, - ptpTimestamp :: !UTCTime, - ptpTransaction :: !T.Text, - ptpTerminal :: !T.Text, - ptpGooglePay :: !Bool - } - | PaymentTerminalCashback - { ptcCounterpartyName :: !T.Text, - ptcCardSequenceNo :: !T.Text, - ptcTimestamp :: !UTCTime, - ptcTransaction :: !T.Text, - ptcTerminal :: !T.Text - } - | OnlineBankingCredit - { obcCounterpartyName :: !T.Text, - obcCounterpartyIban :: !Iban, - obcDescription :: !T.Text, - obcTimestamp :: !UTCTime - } - | OnlineBankingDebit - { obdCounterpartyName :: !T.Text, - obdCounterpartyIban :: !Iban, - obdDescription :: T.Text, - obdTimestamp :: !(Maybe UTCTime) - } - | RecurrentDirectDebit - { rddCounterpartyName :: !T.Text, - rddCounterpartyIban :: !Iban, - rddDescription :: !T.Text, - rddReference :: !T.Text, - rddMandateId :: !T.Text, - rddCreditorId :: !T.Text, - rddOtherParty :: !(Maybe T.Text) - } - | RoundingSavingsDeposit - {rsdSavingsAccount :: !T.Text} - | DepositTransfer - { dtCounterpartyName :: !T.Text, - dtCounterpartyIban :: !Iban, - dtDescription :: !T.Text, - dtReference :: !T.Text - } - | IdealDebit - { idCounterpartyName :: !T.Text, - idCounterpartyIban :: !Iban, - idDescription :: !T.Text, - idTimestamp :: !UTCTime, - idReference :: !T.Text - } - | BatchPayment - { bpCounterpartyName :: !T.Text, - bpCounterpartyIban :: !Iban, - bpDescription :: !T.Text, - bpReference :: !T.Text - } - deriving (Show) - -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 -- cgit v1.2.3