From 86c8896ee69b068368b4ef9a4c3923285907c328 Mon Sep 17 00:00:00 2001 From: Rutger Broekhoff Date: Tue, 18 Mar 2025 15:29:27 +0100 Subject: Parsing ING statements (POC) --- .gitignore | 3 + app/Data/Iban.hs | 40 ++++ app/Format.hs | 3 + app/Import/Ing/CurrentAccountCsv.hs | 356 ++++++++++++++++++++++++++++++++++++ app/Import/Ing/SavingsAccountCsv.hs | 162 ++++++++++++++++ app/Import/Ing/Shared.hs | 47 +++++ app/Main.hs | 100 ++++++++++ wayligmative.cabal | 34 ++++ 8 files changed, 745 insertions(+) create mode 100644 .gitignore create mode 100644 app/Data/Iban.hs create mode 100644 app/Format.hs create mode 100644 app/Import/Ing/CurrentAccountCsv.hs create mode 100644 app/Import/Ing/SavingsAccountCsv.hs create mode 100644 app/Import/Ing/Shared.hs create mode 100644 app/Main.hs create mode 100644 wayligmative.cabal diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..4bfa210 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +.\#* +\#*\# +*~ diff --git a/app/Data/Iban.hs b/app/Data/Iban.hs new file mode 100644 index 0000000..a42e192 --- /dev/null +++ b/app/Data/Iban.hs @@ -0,0 +1,40 @@ +module Data.Iban (Iban, mkIban) where + +import Control.Applicative ((<|>)) +import Data.Attoparsec.Text as AP +import Data.Char + ( digitToInt, + ord, + toUpper, + ) +import Data.Text qualified as T + +newtype Iban = Iban T.Text deriving (Show, Eq) + +mkIban :: T.Text -> Either String Iban +mkIban t = validateIban t >> return (Iban t) + +validateIban :: T.Text -> Either String () +validateIban t = AP.parseOnly ibanP t + where + ibanP = do + countryCode <- AP.count 2 ibanLetter + checkDigits <- AP.count 2 ibanDigit + chars <- AP.many1 ibanChar + endOfInput + if length chars < 30 + then + if valid countryCode checkDigits chars + then return () + else fail $ "IBAN checksum does not match (" ++ T.unpack t ++ ")" + else fail "IBAN has more than 34 characters" + where + ibanChar = ibanDigit <|> ibanLetter + ibanDigit = toInteger . digitToInt <$> AP.digit + ibanLetter = letterToInt <$> AP.letter + letterToInt c = toInteger (ord (toUpper c) - ord 'A' + 10) + charsToInteger = foldl' (\acc d -> if d >= 10 then acc * 100 + d else acc * 10 + d) 0 + ibanToInteger countryCode checkDigits chars = + charsToInteger chars * 1000000 + charsToInteger countryCode * 100 + charsToInteger checkDigits + valid countryCode checkDigits chars = + ibanToInteger countryCode checkDigits chars `mod` 97 == 1 diff --git a/app/Format.hs b/app/Format.hs new file mode 100644 index 0000000..a779d95 --- /dev/null +++ b/app/Format.hs @@ -0,0 +1,3 @@ +module Format where + +import Text.Parsec diff --git a/app/Import/Ing/CurrentAccountCsv.hs b/app/Import/Ing/CurrentAccountCsv.hs new file mode 100644 index 0000000..bf28730 --- /dev/null +++ b/app/Import/Ing/CurrentAccountCsv.hs @@ -0,0 +1,356 @@ +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} + +module Import.Ing.CurrentAccountCsv where + +import Control.Applicative ((<|>)) +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.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), + dateCP, + decimalCP, + ibanCP, + maybeCP, + scsvOptions, + timestampCP, + ) +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) + 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 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 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 + } + 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) + +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" + +data PartTx = PartTx !Day !TransactionType !DebitCredit + +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 + 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 + 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 + 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 + } +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 + valDate <- valueDateCP valDateTxt + return $ + PaymentTerminalCashbackData + { ptcCardSequenceNo = cardSeqNo, + ptcTimestamp = timestamp, + ptcTransaction = transaction, + ptcTerminal = term, + ptcValueDate = valDate + } +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 + valDate <- valueDateCP valDateTxt + return $ + OnlineBankingCredit + { obcName = name, + obcDescription = desc, + obcIban = iban, + obcTimestamp = timestamp, + obcValueDate = valDate + } +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 + timestamp <- + if T.null timestampTxt + then pure Nothing + else Just <$> timestampCP "%d-%m-%Y %H:%M:%S" amsTz timestampTxt + valDate <- valueDateCP valDateTxt + return $ + OnlineBankingDebit + { obdName = name, + obdDescription = desc, + obdIban = iban, + obdTimestamp = timestamp, + obdValueDate = valDate + } +notificationsCP _ (PartTx date DirectDebit Debit) t = 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]) + iban <- ibanCP ibanTxt + valDate <- valueDateCP valDateTxt + return $ + RecurrentDirectDebitData + { rddName = name, + rddDescription = desc, + rddIban = iban, + rddReference = ref, + rddMandateId = mandateId, + rddCreditorId = creditorId, + rddOtherParty = if T.null otherParty then Nothing else Just otherParty, + rddValueDate = valDate + } + 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 + return $ + RecurrentDirectDebitData + { rddName = name, + rddDescription = desc, + rddIban = iban, + rddReference = ref, + rddMandateId = mandateId, + rddCreditorId = creditorId, + rddOtherParty = Nothing, + rddValueDate = date + } +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 + valDate <- valueDateCP valDateTxt + return $ + IdealDebitData + { idName = name, + idDescription = desc, + idIban = iban, + idTimestamp = timestamp, + idReference = ref, + idValueDate = valDate + } +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 + valDate <- valueDateCP valDateTxt + return $ + BatchPaymentData + { bpName = name, + bpDescription = desc, + bpIban = iban, + bpReference = ref, + bpValueDate = valDate + } +notificationsCP _ (PartTx _ ty cd) _ = fail $ "Unmatched type and debit/credit combination (" ++ show ty ++ ", " ++ show cd ++ ")" + +debitCreditCP :: T.Text -> C.Parser DebitCredit +debitCreditCP "Debit" = return Debit +debitCreditCP "Credit" = return Credit +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" + 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" >>= ibanCP) + <*> (m .: "Counterparty" >>= maybeCP ibanCP) + <*> pure debitCredit + <*> (m .: "Amount (EUR)" >>= decimalCP) + <*> (m .: "Resulting balance" >>= decimalCP) + <*> m .: "Tag" + <*> (m .: "Notifications" >>= notificationsCP amsTz (PartTx date ty debitCredit)) + +readFile :: Handle -> IO (V.Vector PrimTx) +readFile h = do + tz <- loadTZFromDB "Europe/Amsterdam" + contents <- BS.hGetContents h + case C.decodeByNameWithP (parseNamedRecord tz) 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" diff --git a/app/Import/Ing/SavingsAccountCsv.hs b/app/Import/Ing/SavingsAccountCsv.hs new file mode 100644 index 0000000..f6632fc --- /dev/null +++ b/app/Import/Ing/SavingsAccountCsv.hs @@ -0,0 +1,162 @@ +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} + +module Import.Ing.SavingsAccountCsv where + +import Data.ByteString.Lazy qualified as BS +import Data.Csv ((.:)) +import Data.Csv qualified as C +import Data.Decimal (Decimal) +import Data.Iban (Iban, mkIban) +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 System.IO (Handle) +import Text.Regex.TDFA ((=~~)) + +data DebitCredit = Debit | Credit deriving (Show, Eq) + +data MutationType = DepositMutation | WithdrawalMutation | InterestMutation deriving (Show) + +data TxBase = TxBase + { txbDate :: !Day, + txbAccountId :: !T.Text, + txbAccountName :: !T.Text, + txbAmount :: !Decimal, + txbResBal :: !Decimal + } + deriving (Show) + +data TxSpecifics + = Interest + | Withdrawal + { wToCurrentAccountIban :: !Iban, + wDescription :: !T.Text + } + | Deposit + { dFromCurrentAccountIban :: !Iban, + dDescription :: !T.Text + } + | CurrentAccountAutoSaveRounding {caasFromCurrentAccountIban :: !Iban} + deriving (Show) + +data Tx = Tx TxBase TxSpecifics deriving (Show) + +instance MonadFail (Either String) where + fail = Left + +txBaseFromPrim :: PrimTx -> Either String TxBase +txBaseFromPrim ptx@PrimTx {ptxCommodity = "EUR"} = + return $ TxBase (ptxDate ptx) (ptxAccountId ptx) (ptxAccountName ptx) (ptxAmount ptx) (ptxResBal ptx) +txBaseFromPrim ptx = + Left $ "Unexpected commodity '" ++ T.unpack (ptxCommodity ptx) ++ "' (expected EUR)" + +specificsFromPrim :: PrimTx -> Either String TxSpecifics +specificsFromPrim ptx@PrimTx {ptxMutationType = InterestMutation} + | isJust (ptxCounterparty ptx) = Left "Expected no counterparty for interest transaction" + | ptxDebitCredit ptx /= Credit = + Left "Expected interest transaction to be of credit ('Bij') type, got debit ('Af')" + | not (T.null (ptxNotifications ptx)) = + Left "Expected no notifications for interest transaction" + | ptxDescription ptx /= "Rente" = + Left $ "Expected interest transaction to have description 'Rente', got '" ++ T.unpack (ptxDescription ptx) ++ "'" + | otherwise = return Interest +specificsFromPrim ptx@PrimTx {ptxMutationType = WithdrawalMutation} = do + let regex = "Overboeking naar betaalrekening (.*)" :: String + (_, _, _, [ibanTxt]) <- ptxDescription ptx =~~ regex :: Either String (T.Text, T.Text, T.Text, [T.Text]) + iban <- mkIban ibanTxt + case ptxCounterparty ptx of + Nothing -> Left "Expected counterparty for withdrawal transaction" + Just cpIban -> + if cpIban /= iban + then Left "Expected counterparty and IBAN in description to be equal" + else return $ Withdrawal {wToCurrentAccountIban = iban, wDescription = ptxNotifications ptx} +specificsFromPrim ptx@PrimTx {ptxMutationType = DepositMutation} = do + let regex = "(Afronding|Overboeking) van betaalrekening (.*)" :: String + (_, _, _, [ty, ibanTxt]) <- ptxDescription ptx =~~ regex :: Either String (T.Text, T.Text, T.Text, [T.Text]) + iban <- mkIban ibanTxt + case ptxCounterparty ptx of + Nothing -> Left "Expected counterparty for deposit transaction" + Just cpIban -> + if cpIban /= iban + then Left "Expected counterparty and IBAN in description to be equal" + else case ty of + "Afronding" -> + if not (T.null (ptxNotifications ptx)) + then + Left "Expected no notifications for auto-save rounding transaction" + else return $ CurrentAccountAutoSaveRounding {caasFromCurrentAccountIban = iban} + "Overboeking" -> + return $ Deposit {dFromCurrentAccountIban = iban, dDescription = ptxNotifications ptx} + _ -> error "unreachable" + +processPrimTx :: PrimTx -> Either String Tx +processPrimTx ptx = Tx <$> txBaseFromPrim ptx <*> specificsFromPrim ptx + +data PrimTx = PrimTx + { ptxDate :: !Day, + ptxDescription :: !T.Text, + ptxAccountId :: !T.Text, + ptxAccountName :: !T.Text, + ptxCounterparty :: !(Maybe Iban), + ptxDebitCredit :: !DebitCredit, + ptxAmount :: !Decimal, + ptxCommodity :: !T.Text, + ptxMutationType :: !MutationType, + ptxNotifications :: !T.Text, + ptxResBal :: !Decimal + } + deriving (Show) + +debitCreditCP :: T.Text -> C.Parser DebitCredit +debitCreditCP "Af" = return Debit +debitCreditCP "Bij" = return Credit +debitCreditCP t = fail ("Unknown debit/credit value '" ++ T.unpack t ++ "'") + +mutationTypeCP :: T.Text -> C.Parser MutationType +mutationTypeCP "Inleg" = return DepositMutation +mutationTypeCP "Opname" = return WithdrawalMutation +mutationTypeCP "Rente" = return InterestMutation +mutationTypeCP t = fail ("Unknown mutation type '" ++ T.unpack t ++ "'") + +parseNamedRecord :: C.NamedRecord -> C.Parser Tx +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) + +readFile :: Handle -> IO (V.Vector Tx) +readFile h = do + contents <- BS.hGetContents h + case C.decodeByNameWithP parseNamedRecord scsvOptions contents of + Left err -> fail err + Right + ( [ "Datum", + "Omschrijving", + "Rekening", + "Rekening naam", + "Tegenrekening", + "Af Bij", + "Bedrag", + "Valuta", + "Mutatiesoort", + "Mededelingen", + "Saldo na mutatie" + ], + txs + ) -> + return txs + Right _ -> + fail "Headers do not match expected pattern" diff --git a/app/Import/Ing/Shared.hs b/app/Import/Ing/Shared.hs new file mode 100644 index 0000000..c70f225 --- /dev/null +++ b/app/Import/Ing/Shared.hs @@ -0,0 +1,47 @@ +module Import.Ing.Shared where + +import Data.Attoparsec.Text qualified as AP +import Data.Char (digitToInt, ord) +import Data.Csv qualified as C +import Data.Decimal (Decimal, DecimalRaw (Decimal), normalizeDecimal) +import Data.Iban (Iban, mkIban) +import Data.Text qualified as T +import Data.Time.Calendar (Day) +import Data.Time.Clock (UTCTime) +import Data.Time.Format (defaultTimeLocale, parseTimeM) +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 diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..2438203 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,100 @@ +module Main where + +import Brick.AttrMap qualified as A +import Brick.Main qualified as M +import Brick.Types + ( BrickEvent (..), + Widget, + ) +import Brick.Types qualified as T +import Brick.Util (bg, on) +import Brick.Widgets.Center qualified as C +import Brick.Widgets.Core + ( padAll, + str, + ) +import Brick.Widgets.Dialog qualified as D +import Graphics.Vty qualified as V +import Import.Ing.SavingsAccountCsv qualified +import System.IO (IOMode (ReadMode), withFile) +import Text.Pretty.Simple (pPrint) + +-- data AccountType = Asset | Equity | Liability | Expense | Income +-- +-- data TxAction = Inc | Dec +-- +-- txAopp :: TxAction -> TxAction +-- txaOpp Inc = Dec +-- txaOpp Dec = Inc +-- +-- onDebit :: AccountType -> TxAction +-- onDebit Asset = Inc +-- onDebit Equity = Dec +-- onDebit Liability = Dec +-- onDebit Expense = Inc +-- onDebit Income = Dec +-- +-- onCredit :: AccountType -> TxAction +-- onCredit = txaOpp . onDebit +-- +-- data Tx = Tx { txDebit :: [(Account, Decimal)], txCredit :: [(Account, Decimal)] } deriving Show +data Choice = Red | Blue | Green + deriving (Show) + +data Name + = RedButton + | BlueButton + | GreenButton + deriving (Show, Eq, Ord) + +drawUI :: D.Dialog Choice Name -> [Widget Name] +drawUI d = [ui] + where + ui = D.renderDialog d $ C.hCenter $ padAll 1 $ str "This is the dialog body." + +appEvent :: BrickEvent Name e -> T.EventM Name (D.Dialog Choice Name) () +appEvent (VtyEvent ev) = + case ev of + V.EvKey V.KEsc [] -> M.halt + V.EvKey V.KEnter [] -> M.halt + _ -> D.handleDialogEvent ev +appEvent _ = return () + +initialState :: D.Dialog Choice Name +initialState = D.dialog (Just $ str "Title") (Just (RedButton, choices)) 50 + where + choices = + [ ("Red", RedButton, Red), + ("Blue", BlueButton, Blue), + ("Green", GreenButton, Green) + ] + +theMap :: A.AttrMap +theMap = + A.attrMap + V.defAttr + [ (D.dialogAttr, V.white `on` V.blue), + (D.buttonAttr, V.black `on` V.white), + (D.buttonSelectedAttr, bg V.yellow) + ] + +theApp :: M.App (D.Dialog Choice Name) e Name +theApp = + M.App + { M.appDraw = drawUI, + M.appChooseCursor = M.showFirstCursor, + M.appHandleEvent = appEvent, + M.appStartEvent = return (), + M.appAttrMap = const theMap + } + +main :: IO () +main = do + let filename = "/home/rutgerbrf/Code/P/wayligmative/test.csv" + putStrLn $ "Reading " ++ filename + withFile filename ReadMode $ \h -> do + entries <- Import.Ing.SavingsAccountCsv.readFile h + pPrint entries + +-- d <- M.defaultMain theApp initialState +-- putStrLn $ "You chose: " <> show (D.dialogSelection d) diff --git a/wayligmative.cabal b/wayligmative.cabal new file mode 100644 index 0000000..b604e20 --- /dev/null +++ b/wayligmative.cabal @@ -0,0 +1,34 @@ +cabal-version: 3.0 +name: wayligmative +version: 0.1.0.0 +maintainer: rutger@viasalix.nl +author: Rutger Broekhoff +build-type: Simple + +executable wayligmative + main-is: Main.hs + hs-source-dirs: app + other-modules: + Data.Iban + Import.Ing.CurrentAccountCsv + Import.Ing.Shared + Import.Ing.SavingsAccountCsv + + default-language: GHC2024 + ghc-options: -Wall -threaded + build-depends: + base ^>=4.20.0.0, + parsec, + brick, + vty, + cassava, + Decimal, + text, + time, + attoparsec, + containers, + vector, + bytestring, + regex-tdfa, + tz, + pretty-simple -- cgit v1.2.3