From 5493329b2eed7e151f4a323c108caad2253b08bb Mon Sep 17 00:00:00 2001 From: Rutger Broekhoff Date: Sat, 22 Mar 2025 14:52:35 +0100 Subject: Refactor parser for current account statement --- app/Import/Ing/CurrentAccountCsv.hs | 44 ++-- app/Import/Ing/CurrentAccountCsv2.hs | 411 +++++++++++++++++++++++++++++++++++ app/Import/Ing/SavingsAccountCsv.hs | 36 +-- app/Import/Ing/Shared.hs | 49 ++--- 4 files changed, 475 insertions(+), 65 deletions(-) create mode 100644 app/Import/Ing/CurrentAccountCsv2.hs (limited to 'app/Import/Ing') diff --git a/app/Import/Ing/CurrentAccountCsv.hs b/app/Import/Ing/CurrentAccountCsv.hs index bf28730..1456be1 100644 --- a/app/Import/Ing/CurrentAccountCsv.hs +++ b/app/Import/Ing/CurrentAccountCsv.hs @@ -17,12 +17,12 @@ import Data.Time.Zones (TZ, loadTZFromDB) import Data.Vector qualified as V import Import.Ing.Shared ( DebitCredit (Credit, Debit), - dateCP, - decimalCP, - ibanCP, maybeCP, + parseDateM, + parseDecimalM, + parseIbanM, + parseTimestampM, scsvOptions, - timestampCP, ) import System.IO (Handle) import Text.Regex.TDFA ((=~~)) @@ -155,7 +155,7 @@ maybeNotProvided :: T.Text -> Maybe T.Text maybeNotProvided t = if t == "NOTPROVIDED" then Nothing else Just t valueDateCP :: T.Text -> C.Parser Day -valueDateCP = dateCP "%d/%m/%Y" +valueDateCP = parseDateM "%d/%m/%Y" data PartTx = PartTx !Day !TransactionType !DebitCredit @@ -163,7 +163,7 @@ 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 <- ibanCP ibanTxt + iban <- parseIbanM ibanTxt valDate <- valueDateCP valDateTxt return $ DepositTransferData @@ -185,7 +185,7 @@ notificationsCP _ (PartTx _ Transfer Debit) t = do notificationsCP amsTz (PartTx _ PaymentTerminal Debit) t = 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]) - timestamp <- timestampCP "%d/%m/%Y %H:%M" amsTz timestampTxt + timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt valDate <- valueDateCP valDateTxt return $ PaymentTerminalData @@ -199,7 +199,7 @@ notificationsCP amsTz (PartTx _ PaymentTerminal Debit) t = do notificationsCP amsTz (PartTx _ PaymentTerminal Credit) t = 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]) - timestamp <- timestampCP "%d/%m/%Y %H:%M" amsTz timestampTxt + timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt valDate <- valueDateCP valDateTxt return $ PaymentTerminalCashbackData @@ -212,8 +212,8 @@ notificationsCP amsTz (PartTx _ PaymentTerminal Credit) t = do notificationsCP amsTz (PartTx _ OnlineBanking Credit) t = 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]) - iban <- ibanCP ibanTxt - timestamp <- timestampCP "%d-%m-%Y %H:%M:%S" amsTz timestampTxt + iban <- parseIbanM ibanTxt + timestamp <- parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt valDate <- valueDateCP valDateTxt return $ OnlineBankingCredit @@ -226,11 +226,11 @@ notificationsCP amsTz (PartTx _ OnlineBanking Credit) t = do notificationsCP amsTz (PartTx _ OnlineBanking Debit) t = 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]) - iban <- ibanCP ibanTxt + iban <- parseIbanM ibanTxt timestamp <- if T.null timestampTxt then pure Nothing - else Just <$> timestampCP "%d-%m-%Y %H:%M:%S" amsTz timestampTxt + else Just <$> parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt valDate <- valueDateCP valDateTxt return $ OnlineBankingDebit @@ -245,7 +245,7 @@ notificationsCP _ (PartTx date DirectDebit Debit) t = normalRecurrentDirectDebit 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]) - iban <- ibanCP ibanTxt + iban <- parseIbanM ibanTxt valDate <- valueDateCP valDateTxt return $ RecurrentDirectDebitData @@ -261,7 +261,7 @@ notificationsCP _ (PartTx date DirectDebit Debit) t = normalRecurrentDirectDebit 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]) - iban <- ibanCP ibanTxt + iban <- parseIbanM ibanTxt return $ RecurrentDirectDebitData { rddName = name, @@ -276,8 +276,8 @@ notificationsCP _ (PartTx date DirectDebit Debit) t = normalRecurrentDirectDebit 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]) - iban <- ibanCP ibanTxt - timestamp <- timestampCP "%d-%m-%Y %H:%M" amsTz timestampTxt + iban <- parseIbanM ibanTxt + timestamp <- parseTimestampM "%d-%m-%Y %H:%M" amsTz timestampTxt valDate <- valueDateCP valDateTxt return $ IdealDebitData @@ -291,7 +291,7 @@ notificationsCP amsTz (PartTx _ Ideal Debit) t = do notificationsCP _ (PartTx _ BatchPayment 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 <- ibanCP ibanTxt + iban <- parseIbanM ibanTxt valDate <- valueDateCP valDateTxt return $ BatchPaymentData @@ -310,7 +310,7 @@ debitCreditCP t = fail ("Unknown debit/credit value '" ++ T.unpack t ++ "'") parseNamedRecord :: TZ -> C.NamedRecord -> C.Parser PrimTx parseNamedRecord amsTz m = do - date <- m .: "Date" >>= dateCP "%0Y%m%d" + date <- m .: "Date" >>= parseDateM "%0Y%m%d" debitCredit <- m .: "Debit/credit" >>= debitCreditCP codeText <- m .: "Code" tyText <- m .: "Transaction type" @@ -322,11 +322,11 @@ parseNamedRecord amsTz m = do else PrimTx date <$> (m .: "Name / Description" <&> maybeNotProvided) - <*> (m .: "Account" >>= ibanCP) - <*> (m .: "Counterparty" >>= maybeCP ibanCP) + <*> (m .: "Account" >>= parseIbanM) + <*> (m .: "Counterparty" >>= maybeCP parseIbanM) <*> pure debitCredit - <*> (m .: "Amount (EUR)" >>= decimalCP) - <*> (m .: "Resulting balance" >>= decimalCP) + <*> (m .: "Amount (EUR)" >>= parseDecimalM) + <*> (m .: "Resulting balance" >>= parseDecimalM) <*> m .: "Tag" <*> (m .: "Notifications" >>= notificationsCP amsTz (PartTx date ty debitCredit)) diff --git a/app/Import/Ing/CurrentAccountCsv2.hs b/app/Import/Ing/CurrentAccountCsv2.hs new file mode 100644 index 0000000..0a5f8af --- /dev/null +++ b/app/Import/Ing/CurrentAccountCsv2.hs @@ -0,0 +1,411 @@ +{-# 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/Import/Ing/SavingsAccountCsv.hs b/app/Import/Ing/SavingsAccountCsv.hs index 3f2e5e6..16b5f92 100644 --- a/app/Import/Ing/SavingsAccountCsv.hs +++ b/app/Import/Ing/SavingsAccountCsv.hs @@ -12,7 +12,7 @@ import Data.Maybe (isJust) import Data.Text qualified as T import Data.Time.Calendar (Day) import Data.Vector qualified as V -import Import.Ing.Shared (dateCP, decimalCP, eitherToCP, ibanCP, maybeCP, scsvOptions) +import Import.Ing.Shared (maybeCP, parseDateM, parseDecimalM, parseIbanM, scsvOptions) import System.IO (Handle) import Text.Regex.TDFA ((=~~)) @@ -49,7 +49,7 @@ instance MonadFail (Either String) where txBaseFromPrim :: PrimTx -> Either String TxBase txBaseFromPrim ptx@PrimTx {ptxCommodity = "EUR"} = - return $ TxBase (ptxDate ptx) (ptxAccountId ptx) (ptxAccountName ptx) (ptxAmount ptx) (ptxResBal ptx) + return $ TxBase <$> ptxDate <*> ptxAccountId <*> ptxAccountName <*> ptxAmount <*> ptxResBal $ ptx txBaseFromPrim ptx = Left $ "Unexpected commodity '" ++ T.unpack (ptxCommodity ptx) ++ "' (expected EUR)" @@ -121,26 +121,25 @@ mutationTypeCP "Opname" = return WithdrawalMutation mutationTypeCP "Rente" = return InterestMutation mutationTypeCP t = fail ("Unknown mutation type '" ++ T.unpack t ++ "'") -instance C.FromNamedRecord Tx where +instance C.FromNamedRecord PrimTx where parseNamedRecord m = - eitherToCP . processPrimTx - =<< PrimTx - <$> (m .: "Datum" >>= dateCP "%Y-%m-%d") - <*> m .: "Omschrijving" - <*> m .: "Rekening" - <*> m .: "Rekening naam" - <*> (m .: "Tegenrekening" >>= maybeCP ibanCP) - <*> (m .: "Af Bij" >>= debitCreditCP) - <*> (m .: "Bedrag" >>= decimalCP) - <*> m .: "Valuta" - <*> (m .: "Mutatiesoort" >>= mutationTypeCP) - <*> m .: "Mededelingen" - <*> (m .: "Saldo na mutatie" >>= decimalCP) + PrimTx + <$> (m .: "Datum" >>= parseDateM "%Y-%m-%d") + <*> m .: "Omschrijving" + <*> m .: "Rekening" + <*> m .: "Rekening naam" + <*> (m .: "Tegenrekening" >>= maybeCP parseIbanM) + <*> (m .: "Af Bij" >>= debitCreditCP) + <*> (m .: "Bedrag" >>= parseDecimalM) + <*> m .: "Valuta" + <*> (m .: "Mutatiesoort" >>= mutationTypeCP) + <*> m .: "Mededelingen" + <*> (m .: "Saldo na mutatie" >>= parseDecimalM) readFile :: Handle -> IO (V.Vector Tx) readFile h = do contents <- BS.hGetContents h - case C.decodeByNameWith scsvOptions contents of + primTxs <- case C.decodeByNameWith scsvOptions contents of Left err -> fail err Right ( [ "Datum", @@ -160,3 +159,6 @@ readFile h = do return txs Right _ -> fail "Headers do not match expected pattern" + case V.mapM processPrimTx primTxs of + Left err -> fail err + Right txs -> return txs diff --git a/app/Import/Ing/Shared.hs b/app/Import/Ing/Shared.hs index c70f225..b5d1703 100644 --- a/app/Import/Ing/Shared.hs +++ b/app/Import/Ing/Shared.hs @@ -13,35 +13,32 @@ import Data.Time.Zones (TZ, localTimeToUTCTZ) data DebitCredit = Debit | Credit deriving (Show) -readDecimal :: T.Text -> Either String Decimal -readDecimal = AP.parseOnly $ do - decPart <- AP.decimal - _ <- AP.char ',' - f1 <- AP.digit - f2 <- AP.digit - AP.endOfInput - let fracPart = fromIntegral $ digitToInt f1 * 10 + digitToInt f2 - return $ normalizeDecimal (Decimal 2 (decPart * 100 + fracPart)) - scsvOptions :: C.DecodeOptions scsvOptions = C.defaultDecodeOptions {C.decDelimiter = fromIntegral (ord ';')} -eitherToCP :: Either String a -> C.Parser a -eitherToCP = either fail return - -decimalCP :: T.Text -> C.Parser Decimal -decimalCP = eitherToCP . readDecimal - -dateCP :: String -> T.Text -> C.Parser Day -dateCP fmt = parseTimeM False defaultTimeLocale fmt . T.unpack - maybeCP :: (T.Text -> C.Parser a) -> T.Text -> C.Parser (Maybe a) maybeCP p t = if T.null t then return Nothing else Just <$> p t -ibanCP :: T.Text -> C.Parser Iban -ibanCP = eitherToCP . mkIban - -timestampCP :: String -> TZ -> T.Text -> C.Parser UTCTime -timestampCP fmt amsTz t = do - localTime <- parseTimeM False defaultTimeLocale fmt (T.unpack t) - return $ localTimeToUTCTZ amsTz localTime +parseDecimalM :: (MonadFail m) => T.Text -> m Decimal +parseDecimalM = + either fail return + . AP.parseOnly + ( do + decPart <- AP.decimal + _ <- AP.char ',' + f1 <- AP.digit + f2 <- AP.digit + AP.endOfInput + let fracPart = fromIntegral $ digitToInt f1 * 10 + digitToInt f2 + return $ normalizeDecimal (Decimal 2 (decPart * 100 + fracPart)) + ) + +parseIbanM :: (MonadFail m) => T.Text -> m Iban +parseIbanM = either fail return . mkIban + +parseDateM :: (MonadFail m) => String -> T.Text -> m Day +parseDateM fmt = parseTimeM False defaultTimeLocale fmt . T.unpack + +parseTimestampM :: (MonadFail m) => String -> TZ -> T.Text -> m UTCTime +parseTimestampM fmt amsTz t = do + localTimeToUTCTZ amsTz <$> parseTimeM False defaultTimeLocale fmt (T.unpack t) -- cgit v1.2.3