From 95d50b25c990e8c945ce2507b16ff3c8b039d286 Mon Sep 17 00:00:00 2001 From: Rutger Broekhoff Date: Mon, 25 Aug 2025 19:48:19 +0200 Subject: OCaml --- app/Import/Ing/CurrentAccountCsv.hs | 407 ------------------------------------ 1 file changed, 407 deletions(-) delete mode 100644 app/Import/Ing/CurrentAccountCsv.hs (limited to 'app/Import/Ing/CurrentAccountCsv.hs') 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 -- cgit v1.2.3