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/Data/Res.hs | 4 +- app/Import/Ing/CurrentAccountCsv.hs | 513 +++++++++++++++++++---------------- app/Import/Ing/CurrentAccountCsv2.hs | 411 ---------------------------- app/Main.hs | 3 +- 4 files changed, 287 insertions(+), 644 deletions(-) delete mode 100644 app/Import/Ing/CurrentAccountCsv2.hs (limited to 'app') diff --git a/app/Data/Res.hs b/app/Data/Res.hs index e8c4ca4..3806e5a 100644 --- a/app/Data/Res.hs +++ b/app/Data/Res.hs @@ -19,10 +19,10 @@ instance Monad (Res e) where (Ok v) >>= f = f v (Err e) >>= _ = Err e -instance IsString e => MonadFail (Res e) where +instance (IsString e) => MonadFail (Res e) where fail = Err . fromString -instance IsString e => Alternative (Res e) where +instance (IsString e) => Alternative (Res e) where empty = fail "mzero" m1@(Ok _) <|> _ = m1 (Err _) <|> m2 = m2 diff --git a/app/Import/Ing/CurrentAccountCsv.hs b/app/Import/Ing/CurrentAccountCsv.hs index 1456be1..d17221d 100644 --- a/app/Import/Ing/CurrentAccountCsv.hs +++ b/app/Import/Ing/CurrentAccountCsv.hs @@ -4,12 +4,13 @@ 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.Functor ((<&>)) 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) @@ -28,313 +29,364 @@ import System.IO (Handle) import Text.Regex.TDFA ((=~~)) data TransactionType - = AcceptGiro -- AC (acceptgiro) - | AtmWithdrawal -- GM (geldautomaat, Giromaat) - | BatchPayment -- VZ (verzamelbetaling); 'Batch payment' - | BranchPosting -- FL (filiaalboeking) - | Deposit -- ST (storting) - | DirectDebit -- IC (incasso); 'SEPA direct debit' - | Ideal -- ID (iDEAL); 'iDEAL' - | OnlineBanking -- GT (internetbankieren, Girotel); 'Online Banking' - | OfficeWithdrawal -- PK (opname kantoor, postkantoor) - | PaymentTerminal -- BA (betaalautomaat); 'Payment terminal' - | PeriodicTransfer -- PO (periodieke overschrijving) - | PhoneBanking -- GF (telefonisch bankieren, Girofoon) - | Transfer -- OV (overboeking); 'Transfer' - | Various -- DV (diversen) + = 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 AcceptGiro -parseCode "GM" = return AtmWithdrawal -parseCode "VZ" = return BatchPayment -parseCode "FL" = return BranchPosting -parseCode "ST" = return Deposit -parseCode "IC" = return DirectDebit -parseCode "ID" = return Ideal -parseCode "GT" = return OnlineBanking -parseCode "PK" = return OfficeWithdrawal -parseCode "BA" = return PaymentTerminal -parseCode "PO" = return PeriodicTransfer -parseCode "GF" = return PhoneBanking -parseCode "OV" = return Transfer -parseCode "DV" = return Various +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 DirectDebit -parseType "Batch payment" = return BatchPayment -parseType "Online Banking" = return OnlineBanking -parseType "Payment terminal" = return PaymentTerminal -parseType "Transfer" = return Transfer -parseType "iDEAL" = return Ideal +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 - { ptDate :: !Day, - ptDesc :: !(Maybe T.Text), - ptAccount :: !Iban, - ptCounterparty :: !(Maybe Iban), - ptDebitCredit :: !DebitCredit, - ptAmount :: !Decimal, - ptResBal :: !Decimal, - ptTag :: !T.Text, - ptMoreData :: !MoreData + { 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) -data MoreData - = PaymentTerminalData - { ptCardSequenceNo :: !T.Text, - ptTimestamp :: !UTCTime, - ptTransaction :: !T.Text, - ptTerminal :: !T.Text, - ptValueDate :: !Day, - ptGooglePay :: !Bool - } - | DepositTransferData - { dtName :: !T.Text, - dtDescription :: !T.Text, - dtIban :: !Iban, - dtReference :: !T.Text, - dtValueDate :: !Day - } - | RoundingSavingsDeposit - { rsdSavingsAccount :: !T.Text, - rsdValueDate :: !Day - } - | OnlineBankingCredit - { obcName :: !T.Text, - obcDescription :: !T.Text, - obcIban :: !Iban, - obcTimestamp :: !UTCTime, - obcValueDate :: !Day - } - | OnlineBankingDebit - { obdName :: !T.Text, - obdDescription :: !T.Text, - obdIban :: !Iban, - obdTimestamp :: !(Maybe UTCTime), - obdValueDate :: !Day - } - | RecurrentDirectDebitData - { rddName :: !T.Text, - rddDescription :: !T.Text, - rddIban :: !Iban, - rddReference :: !T.Text, - rddMandateId :: !T.Text, - rddCreditorId :: !T.Text, - rddOtherParty :: !(Maybe T.Text), - rddValueDate :: !Day - } - | IdealDebitData - { idName :: !T.Text, - idDescription :: !T.Text, - idIban :: !Iban, - idTimestamp :: !UTCTime, - idReference :: !T.Text, - idValueDate :: !Day - } - | PaymentTerminalCashbackData - { ptcCardSequenceNo :: !T.Text, - ptcTimestamp :: !UTCTime, - ptcTransaction :: !T.Text, - ptcTerminal :: !T.Text, - ptcValueDate :: !Day - } - | BatchPaymentData - { bpName :: !T.Text, - bpDescription :: !T.Text, - bpIban :: !Iban, - bpReference :: !T.Text, - bpValueDate :: !Day - } - 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 ++ "'") -maybeNotProvided :: T.Text -> Maybe T.Text -maybeNotProvided t = if t == "NOTPROVIDED" then Nothing else Just 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" -valueDateCP :: T.Text -> C.Parser Day -valueDateCP = parseDateM "%d/%m/%Y" +processPrimTx :: TZ -> PrimTx -> Res String Tx +processPrimTx amsTz ptx = Tx (txBaseFromPrim ptx) <$> specificsFromPrim amsTz ptx -data PartTx = PartTx !Day !TransactionType !DebitCredit +parseValueDate :: T.Text -> Res String Day +parseValueDate = parseDateM "%d/%m/%Y" -notificationsCP :: TZ -> PartTx -> T.Text -> C.Parser MoreData -notificationsCP _ (PartTx _ Transfer Credit) t = 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]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) - iban <- parseIbanM ibanTxt - valDate <- valueDateCP valDateTxt - return $ - DepositTransferData - { dtName = name, - dtDescription = desc, - dtIban = iban, - dtReference = ref, - dtValueDate = valDate - } -notificationsCP _ (PartTx _ Transfer Debit) t = do - let regex = "^To Oranje spaarrekening ([A-Z0-9]+) Afronding Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String - (_, _, _, [savingsAccount, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) - valDate <- valueDateCP valDateTxt - return $ - RoundingSavingsDeposit - { rsdSavingsAccount = savingsAccount, - rsdValueDate = valDate - } -notificationsCP amsTz (PartTx _ PaymentTerminal Debit) t = do +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]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) + (_, _, _, [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 - valDate <- valueDateCP valDateTxt return $ - PaymentTerminalData - { ptCardSequenceNo = cardSeqNo, - ptTimestamp = timestamp, - ptTransaction = transaction, - ptTerminal = if T.null gpayTerm then noGpayTerm else gpayTerm, - ptValueDate = valDate, - ptGooglePay = T.null noGpayTerm + PaymentTerminalPayment + { ptpCounterpartyName = ptxDescription ptx, + ptpCardSequenceNo = cardSeqNo, + ptpTimestamp = timestamp, + ptpTransaction = transaction, + ptpTerminal = if T.null gpayTerm then noGpayTerm else gpayTerm, + ptpGooglePay = T.null noGpayTerm } -notificationsCP amsTz (PartTx _ PaymentTerminal Credit) t = do +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]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) + (_, _, _, [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 - valDate <- valueDateCP valDateTxt return $ - PaymentTerminalCashbackData - { ptcCardSequenceNo = cardSeqNo, + PaymentTerminalCashback + { ptcCounterpartyName = ptxDescription ptx, + ptcCardSequenceNo = cardSeqNo, ptcTimestamp = timestamp, ptcTransaction = transaction, - ptcTerminal = term, - ptcValueDate = valDate + ptcTerminal = term } -notificationsCP amsTz (PartTx _ OnlineBanking Credit) t = do +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]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) + (_, _, _, [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 - valDate <- valueDateCP valDateTxt + 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 - { obcName = name, + { obcCounterpartyName = name, + obcCounterpartyIban = iban, obcDescription = desc, - obcIban = iban, - obcTimestamp = timestamp, - obcValueDate = valDate + obcTimestamp = timestamp } -notificationsCP amsTz (PartTx _ OnlineBanking Debit) t = do +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]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) + (_, _, _, [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 - valDate <- valueDateCP valDateTxt + 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 - { obdName = name, + { obdCounterpartyIban = iban, + obdCounterpartyName = name, obdDescription = desc, - obdIban = iban, - obdTimestamp = timestamp, - obdValueDate = valDate + obdTimestamp = timestamp } -notificationsCP _ (PartTx date DirectDebit Debit) t = normalRecurrentDirectDebit <|> ingInsurancePayment +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]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) + (_, _, _, [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 - valDate <- valueDateCP valDateTxt + 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 $ - RecurrentDirectDebitData - { rddName = name, + RecurrentDirectDebit + { rddCounterpartyName = name, + rddCounterpartyIban = iban, rddDescription = desc, - rddIban = iban, rddReference = ref, rddMandateId = mandateId, rddCreditorId = creditorId, - rddOtherParty = if T.null otherParty then Nothing else Just otherParty, - rddValueDate = valDate + 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]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) + (_, _, _, [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 $ - RecurrentDirectDebitData - { rddName = name, + RecurrentDirectDebit + { rddCounterpartyName = name, + rddCounterpartyIban = iban, rddDescription = desc, - rddIban = iban, rddReference = ref, rddMandateId = mandateId, rddCreditorId = creditorId, - rddOtherParty = Nothing, - rddValueDate = date + rddOtherParty = Nothing } -notificationsCP amsTz (PartTx _ Ideal Debit) t = 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]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) +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 - valDate <- valueDateCP valDateTxt + 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 $ - IdealDebitData - { idName = name, + IdealDebit + { idCounterpartyName = name, + idCounterpartyIban = iban, idDescription = desc, - idIban = iban, idTimestamp = timestamp, - idReference = ref, - idValueDate = valDate + idReference = ref } -notificationsCP _ (PartTx _ BatchPayment Credit) t = do +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]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) + (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <- + ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) + assertValueDatePtx ptx valDateTxt iban <- parseIbanM ibanTxt - valDate <- valueDateCP valDateTxt + 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 $ - BatchPaymentData - { bpName = name, + BatchPayment + { bpCounterpartyName = name, + bpCounterpartyIban = iban, bpDescription = desc, - bpIban = iban, - bpReference = ref, - bpValueDate = valDate + bpReference = ref } -notificationsCP _ (PartTx _ ty cd) _ = fail $ "Unmatched type and debit/credit combination (" ++ show ty ++ ", " ++ show cd ++ ")" +specificsFromPrim _ ptx = + fail $ + "Could not extract data from transaction (" + ++ show (ptxTransactionType ptx) + ++ " / " + ++ show (ptxDebitCredit ptx) + ++ ")" -debitCreditCP :: T.Text -> C.Parser DebitCredit -debitCreditCP "Debit" = return Debit -debitCreditCP "Credit" = return Credit -debitCreditCP t = fail ("Unknown debit/credit value '" ++ T.unpack t ++ "'") +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) -parseNamedRecord :: TZ -> C.NamedRecord -> C.Parser PrimTx -parseNamedRecord amsTz m = do - date <- m .: "Date" >>= parseDateM "%0Y%m%d" - debitCredit <- m .: "Debit/credit" >>= debitCreditCP - codeText <- m .: "Code" - tyText <- m .: "Transaction type" - tyFromCode <- parseCode codeText - ty <- parseType tyText - if ty /= tyFromCode - then - fail $ "Code '" ++ T.unpack codeText ++ "' and transaction type '" ++ T.unpack tyText ++ "' do not agree" - else - PrimTx date - <$> (m .: "Name / Description" <&> maybeNotProvided) - <*> (m .: "Account" >>= parseIbanM) - <*> (m .: "Counterparty" >>= maybeCP parseIbanM) - <*> pure debitCredit - <*> (m .: "Amount (EUR)" >>= parseDecimalM) - <*> (m .: "Resulting balance" >>= parseDecimalM) - <*> m .: "Tag" - <*> (m .: "Notifications" >>= notificationsCP amsTz (PartTx date ty debitCredit)) +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 PrimTx) +readFile :: Handle -> IO (V.Vector Tx) readFile h = do tz <- loadTZFromDB "Europe/Amsterdam" contents <- BS.hGetContents h - case C.decodeByNameWithP (parseNamedRecord tz) scsvOptions contents of + primTxs <- case C.decodeByNameWith scsvOptions contents of Left err -> fail err Right ( [ "Date", @@ -354,3 +406,6 @@ readFile h = do 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 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 diff --git a/app/Main.hs b/app/Main.hs index f5140f2..7b4551a 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -16,7 +16,6 @@ import Brick.Widgets.Core import Brick.Widgets.Dialog qualified as D import Graphics.Vty qualified as V import Import.Ing.CurrentAccountCsv qualified -import Import.Ing.CurrentAccountCsv2 qualified import Import.Ing.SavingsAccountCsv qualified import System.IO (IOMode (ReadMode), withFile) import Text.Pretty.Simple (pPrint) @@ -95,7 +94,7 @@ main = do let filename = "/home/rutgerbrf/Code/P/wayligmative/test3.csv" putStrLn $ "Reading " ++ filename withFile filename ReadMode $ \h -> do - entries <- Import.Ing.CurrentAccountCsv2.readFile h + entries <- Import.Ing.CurrentAccountCsv.readFile h pPrint entries -- d <- M.defaultMain theApp initialState -- cgit v1.2.3