From 56273cf3b371312f0e72fc2af95a9dcacc8228b8 Mon Sep 17 00:00:00 2001 From: Rutger Broekhoff Date: Wed, 23 Jul 2025 12:05:08 +0200 Subject: Slaying --- app/Data/Iban.hs | 5 +- app/Data/Ledger.hs | 115 ++++++++++++ app/Data/Ledger/AutoFile.hs | 1 + app/Import/Ing/Convert.hs | 126 +++++++++++++ app/Import/Ing/CurrentAccountCsv.hs | 340 ++++++++++++++++++------------------ app/Main.hs | 142 +-------------- 6 files changed, 415 insertions(+), 314 deletions(-) create mode 100644 app/Data/Ledger.hs create mode 100644 app/Data/Ledger/AutoFile.hs create mode 100644 app/Import/Ing/Convert.hs (limited to 'app') diff --git a/app/Data/Iban.hs b/app/Data/Iban.hs index 412577a..d9566b9 100644 --- a/app/Data/Iban.hs +++ b/app/Data/Iban.hs @@ -1,4 +1,4 @@ -module Data.Iban (Iban, mkIban) where +module Data.Iban (Iban, mkIban, toText) where import Control.Applicative ((<|>)) import Data.Attoparsec.Text as AP @@ -43,3 +43,6 @@ validateIban = AP.parseOnly $ do charsToInteger chars * 1000000 + charsToInteger countryCode * 100 + charsToInteger checkDigits valid countryCode checkDigits chars = ibanToInteger countryCode checkDigits chars `mod` 97 == 1 + +toText :: Iban -> T.Text +toText (Iban t) = t diff --git a/app/Data/Ledger.hs b/app/Data/Ledger.hs new file mode 100644 index 0000000..ceca9da --- /dev/null +++ b/app/Data/Ledger.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Data.Ledger where + +import Data.Constraint.Extras.TH (deriveArgDict) +import Data.Dependent.Map (DMap, fromList, singleton, union, unionWithKey) +import Data.Dependent.Sum ((==>)) +import Data.Functor.Identity +import Data.Functor.Identity (Identity (..)) +import Data.GADT.Compare.TH (deriveGCompare, deriveGEq) +import Data.GADT.Show.TH (deriveGShow) +import Data.Iban +import Data.Map qualified as M +import Data.Text qualified as T +import Data.Time.Calendar +import Data.Time.Clock +import Data.UUID +import GHC.Generics + +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 TxType + = InterestCtx + | OnlineBankingTx + | RecurrentDirectTx + | PaymentTerminalTx + | CashPaymentTx + | AtmTx + | AutoSaveRoundingTx + | BatchTx + | DirectDebitTx + | PeriodicTx + +data IbanTag = AccountTag | CounterpartyIbanTag deriving (Eq, Enum, Ord, Show) + +data UnitTag = FiledTag | GooglePayTag deriving (Eq, Enum, Ord, Show) + +data TextTag = DescTag | UserTag | CounterpartyNameTag | ReferenceTag | MandateIdTag | CreditorIdTag | OtherPartyTag | TransactionTag | TerminalTag | CardSeqNoTag deriving (Eq, Enum, Ord, Show) + +data Label a where + TextLabel :: TextTag -> Label T.Text + IbanLabel :: IbanTag -> Label Iban + UnitLabel :: UnitTag -> Label () + TimestampLabel :: Label UTCTime + +deriveGEq ''Label +deriveGCompare ''Label +deriveGShow ''Label +deriveArgDict ''Label + +type Labels = DMap Label Identity + +data Money = Money Integer deriving (Show) + +infixl 6 +€, -€ + +(+€) :: Money -> Money -> Money +Money x +€ Money y = Money (x + y) + +(-€) :: Money -> Money -> Money +Money x -€ Money y = Money (x - y) + +data Scalar = Amount Money | Rate Integer deriving (Show) + +data AccountId = AccountId [T.Text] deriving (Show) + +data CommodityId = CommodityId UUID deriving (Show) + +data Account = Account + { id :: AccountId, + description :: [T.Text], + commodityId :: CommodityId, + balance :: Money + } + +-- A balance assertion is only valid when all transactions before it have been +-- cleared and the balance of the account agrees with the amount in the +-- assertion. +data BalAssert = BalAssert + { account :: Account, + amount :: Integer, + labels :: Labels + } + +data Tx = Tx + { cleared :: Maybe Day, + commodityId :: CommodityId, -- the commodity w.r.t. which rates are calculated + debit :: M.Map AccountId Scalar, + credit :: M.Map AccountId Scalar, + labels :: Labels + } + deriving (Show, Generic) + +data SeqTx = SeqTx [Integer] Tx + +data LedgerEntry = TxEntry SeqTx | BalAssertEntry BalAssert + +data Ledger = Ledger [LedgerEntry] diff --git a/app/Data/Ledger/AutoFile.hs b/app/Data/Ledger/AutoFile.hs new file mode 100644 index 0000000..15a1b16 --- /dev/null +++ b/app/Data/Ledger/AutoFile.hs @@ -0,0 +1 @@ +module Data.Ledger.AutoFile where diff --git a/app/Import/Ing/Convert.hs b/app/Import/Ing/Convert.hs new file mode 100644 index 0000000..712c8a4 --- /dev/null +++ b/app/Import/Ing/Convert.hs @@ -0,0 +1,126 @@ +module Import.Ing.Convert where + +import Control.Monad (when) +import Data.Decimal +import Data.Dependent.Map +import Data.Dependent.Sum ((==>)) +import Data.Functor.Identity +import Data.Iban qualified as Iban +import Data.Ledger as L +import Data.Map qualified as M +import Data.Text qualified as T +import Import.Ing.CurrentAccountCsv as C +import Import.Ing.SavingsAccountCsv as S + +virtCheckingAccount :: Iban.Iban -> L.AccountId +virtCheckingAccount iban = AccountId ["Unfiled", "Asset", "Current", "Checking", "Iban", Iban.toText iban] + +virtCounterparty :: T.Text -> L.AccountId +virtCounterparty name = AccountId ["Unfiled", "Expenses", "Counterparty", "Name", name] + +toCents :: Decimal -> Either String L.Money +toCents m + | f == 0 = + return (L.Money m') + | otherwise = + Left "Cannot convert to whole cents: amount of money is more specific" + where + (m', f) = properFraction (m * 100) + +condUnitLabel :: UnitTag -> Bool -> L.Labels +condUnitLabel _ False = empty +condUnitLabel t True = singleton (UnitLabel t) (Identity ()) + +fromCurrentAccountTx :: CommodityId -> C.Tx -> Either String L.Tx +fromCurrentAccountTx eucId (C.Tx base spec) = do + let acc = virtCheckingAccount base.account + when (base.amount < 0) $ + Left "Transaction amount may not be lower than zero" + amount <- L.Amount <$> toCents base.amount + case spec of + PaymentTerminalPayment + { counterpartyName, + cardSequenceNo, + timestamp, + transaction, + terminal, + googlePay + } -> + return $ + L.Tx + { cleared = Just base.date, + commodityId = eucId, + credit = M.singleton acc amount, + debit = M.singleton (virtCounterparty counterpartyName) amount, + labels = + fromList + [ IbanLabel AccountTag ==> base.account, + TextLabel CardSeqNoTag ==> cardSequenceNo, + TextLabel TerminalTag ==> terminal, + TextLabel TransactionTag ==> transaction, + TimestampLabel ==> timestamp + ] + `union` condUnitLabel GooglePayTag googlePay + } + PaymentTerminalCashback + { counterpartyName, + cardSequenceNo, + timestamp, + transaction, + terminal + } -> + return $ + L.Tx + { cleared = Just base.date, + commodityId = eucId, + debit = M.singleton acc amount, + credit = M.singleton (virtCounterparty counterpartyName) amount, + labels = + fromList + [ IbanLabel AccountTag ==> base.account, + TextLabel CardSeqNoTag ==> cardSequenceNo, + TextLabel TerminalTag ==> terminal, + TextLabel TransactionTag ==> transaction, + TimestampLabel ==> timestamp + ] + } + OnlineBankingCredit + { counterpartyName, + counterpartyIban, + description, + timestamp + } -> + return $ + L.Tx + { cleared = Just base.date, + commodityId = eucId, + debit = M.singleton acc amount, + credit = M.singleton (virtCounterparty counterpartyName) amount, + labels = + fromList + [ IbanLabel AccountTag ==> base.account, + IbanLabel CounterpartyIbanTag ==> counterpartyIban, + TextLabel DescTag ==> description, + TimestampLabel ==> timestamp + ] + } + OnlineBankingDebit + { counterpartyName, + counterpartyIban, + description, + mtimestamp + } -> + return $ + L.Tx + { cleared = Just base.date, + commodityId = eucId, + debit = M.singleton (virtCounterparty counterpartyName) amount, + credit = M.singleton acc amount, + labels = + fromList + [ IbanLabel AccountTag ==> base.account, + IbanLabel CounterpartyIbanTag ==> counterpartyIban, + TextLabel DescTag ==> description + ] + `union` (maybe empty (singleton TimestampLabel . Identity) mtimestamp) + } diff --git a/app/Import/Ing/CurrentAccountCsv.hs b/app/Import/Ing/CurrentAccountCsv.hs index d17221d..21ca53d 100644 --- a/app/Import/Ing/CurrentAccountCsv.hs +++ b/app/Import/Ing/CurrentAccountCsv.hs @@ -9,6 +9,7 @@ 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 @@ -16,6 +17,7 @@ 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, @@ -28,6 +30,77 @@ import Import.Ing.Shared 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) @@ -72,18 +145,18 @@ 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 + { 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) + deriving (Show, Generic) debitCreditCP :: T.Text -> C.Parser DebitCredit debitCreditCP "Debit" = return Debit @@ -122,265 +195,188 @@ assertValueDate expected t = do fail "Expected transaction date and value date to be the same" assertValueDatePtx :: PrimTx -> T.Text -> Res String () -assertValueDatePtx PrimTx {ptxDate = expected} = assertValueDate expected +assertValueDatePtx PrimTx {date = expected} = assertValueDate expected specificsFromPrim :: TZ -> PrimTx -> Res String TxSpecifics -specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = PaymentTerminalType, ptxDebitCredit = Debit} = do +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]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) + 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 - { ptpCounterpartyName = ptxDescription ptx, - ptpCardSequenceNo = cardSeqNo, - ptpTimestamp = timestamp, - ptpTransaction = transaction, - ptpTerminal = if T.null gpayTerm then noGpayTerm else gpayTerm, - ptpGooglePay = T.null noGpayTerm + { 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 {ptxTransactionType = PaymentTerminalType, ptxDebitCredit = Credit} = do +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]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) + 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 - { ptcCounterpartyName = ptxDescription ptx, - ptcCardSequenceNo = cardSeqNo, - ptcTimestamp = timestamp, - ptcTransaction = transaction, - ptcTerminal = term + { counterpartyName = ptx.description, + cardSequenceNo = cardSeqNo, + timestamp = timestamp, + transaction = transaction, + terminal = term } -specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = OnlineBankingType, ptxDebitCredit = Credit} = do +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]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) + 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 /= ptxDescription ptx) $ + when (name /= ptx.description) $ fail "Expected counterparty name for online banking credit to match primitive description" - when (Just iban /= ptxCounterparty ptx) $ + when (Just iban /= ptx.counterparty) $ fail "Expected IBAN for online banking credit to match and primitive counterparty IBAN" return $ OnlineBankingCredit - { obcCounterpartyName = name, - obcCounterpartyIban = iban, - obcDescription = desc, - obcTimestamp = timestamp + { counterpartyName = name, + counterpartyIban = iban, + description = desc, + timestamp = timestamp } -specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = OnlineBankingType, ptxDebitCredit = Debit} = do +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]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) + 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 /= ptxDescription ptx) $ + when (name /= ptx.description) $ fail "Expected counterparty name for online banking debit to match primitive description" - when (Just iban /= ptxCounterparty ptx) $ + when (Just iban /= ptx.counterparty) $ fail "Expected IBAN for online banking debit to match and primitive counterparty IBAN" return $ OnlineBankingDebit - { obdCounterpartyIban = iban, - obdCounterpartyName = name, - obdDescription = desc, - obdTimestamp = timestamp + { counterpartyIban = iban, + counterpartyName = name, + description = desc, + mtimestamp = timestamp } -specificsFromPrim _ ptx@PrimTx {ptxTransactionType = DirectDebitType, ptxDebitCredit = Debit} = +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]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) + notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) assertValueDatePtx ptx valDateTxt iban <- parseIbanM ibanTxt - when (name /= ptxDescription ptx) $ + when (name /= ptx.description) $ fail "Expected counterparty name for direct debit to match primitive description" - when (Just iban /= ptxCounterparty ptx) $ + when (Just iban /= ptx.counterparty) $ 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 + { 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]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) + notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) iban <- parseIbanM ibanTxt - when (name /= ptxDescription ptx) $ + when (name /= ptx.description) $ fail "Expected counterparty name for direct debit to match primitive description" - when (Just iban /= ptxCounterparty ptx) $ + when (Just iban /= ptx.counterparty) $ 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 + { counterpartyName = name, + counterpartyIban = iban, + description = desc, + reference = ref, + mandateId = mandateId, + creditorId = creditorId, + otherParty = Nothing } -specificsFromPrim _ ptx@PrimTx {ptxTransactionType = TransferType, ptxDebitCredit = Credit} = do +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]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) + notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) assertValueDatePtx ptx valDateTxt iban <- parseIbanM ibanTxt - when (name /= ptxDescription ptx) $ + when (name /= ptx.description) $ fail "Expected counterparty name for deposit transfer to match primitive description" - when (Just iban /= ptxCounterparty ptx) $ + when (Just iban /= ptx.counterparty) $ fail "Expected IBAN for deposit transfer to match and primitive counterparty IBAN" return $ DepositTransfer - { dtCounterpartyName = name, - dtCounterpartyIban = iban, - dtDescription = desc, - dtReference = ref + { counterpartyName = name, + counterpartyIban = iban, + description = desc, + reference = ref } -specificsFromPrim _ ptx@PrimTx {ptxTransactionType = TransferType, ptxDebitCredit = Debit} = do +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]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) + ptx.notifications =~~ 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 + 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]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) + 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 /= ptxDescription ptx) $ + when (name /= ptx.description) $ fail "Expected counterparty name for iDEAL payment to match primitive description" - when (Just iban /= ptxCounterparty ptx) $ + when (Just iban /= ptx.counterparty) $ fail "Expected IBAN for iDEAL payment to match and primitive counterparty IBAN" return $ IdealDebit - { idCounterpartyName = name, - idCounterpartyIban = iban, - idDescription = desc, - idTimestamp = timestamp, - idReference = ref + { counterpartyName = name, + counterpartyIban = iban, + description = desc, + timestamp = timestamp, + reference = ref } -specificsFromPrim _ ptx@PrimTx {ptxTransactionType = BatchPaymentType, ptxDebitCredit = Credit} = do +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]) <- - ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) + notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) assertValueDatePtx ptx valDateTxt iban <- parseIbanM ibanTxt - when (name /= ptxDescription ptx) $ + when (name /= ptx.description) $ fail "Expected counterparty name for batch payment to match primitive description" - when (Just iban /= ptxCounterparty ptx) $ + when (Just iban /= ptx.counterparty) $ fail "Expected IBAN for batch payment to match and primitive counterparty IBAN" return $ BatchPayment - { bpCounterpartyName = name, - bpCounterpartyIban = iban, - bpDescription = desc, - bpReference = ref + { counterpartyName = name, + counterpartyIban = iban, + description = desc, + reference = ref } specificsFromPrim _ ptx = fail $ "Could not extract data from transaction (" - ++ show (ptxTransactionType ptx) + ++ show (transactionType ptx) ++ " / " - ++ show (ptxDebitCredit ptx) + ++ show (debitCredit 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) +txBaseFromPrim = upcast readFile :: Handle -> IO (V.Vector Tx) readFile h = do diff --git a/app/Main.hs b/app/Main.hs index 97a0463..82505bf 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,144 +1,4 @@ -{-# LANGUAGE ImplicitParams #-} -{-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE OverloadedRecordDot #-} -{-# LANGUAGE OverloadedStrings #-} - module Main where -import Control.Monad (void) -import Data.GI.Base -import GI.Adw qualified as Adw -import GI.Adw.Objects.ApplicationWindow -import GI.Gtk qualified as Gtk -import Import.Ing.CurrentAccountCsv qualified -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 Ledger = [LedgerEntry] --- --- data LedgerEntry = TxEntry Tx | BalAssertEntry BalAssert --- --- -- A balance assertion is only valid when all transactions before it have been --- -- cleared and the balance of the account agrees with the amount in the --- -- assertion. --- data BalAssert = BalAssert { --- account :: Account, --- amount :: Decimal, --- tags :: Tags } --- --- data Tx = Tx { --- txClearedAt :: Maybe UTCTime, --- txCommodity :: Commodity, -- the commodity w.r.t. which rates are calculated --- txDebit :: [(Account, Rate, Amount)], --- txCredit :: [(Account, Rate, Amount)] --- -- Description --- -- Type: --- } deriving Show --- --- data Account = Account { --- acName :: [T.Text], --- acBalance :: Amount } - -activate :: Adw.Application -> IO () -activate app = do - button <- - new - Gtk.Button - [ #label := "Click me", - On - #clicked - ( ?self - `set` [ #sensitive := False, - #label := "Thanks for clicking me" - ] - ) - ] - button2 <- - new - Gtk.Button - [ #label := "Click me", - On - #clicked - ( ?self - `set` [ #sensitive := False, - #label := "Thanks for clicking me" - ] - ) - ] - - title <- new Adw.WindowTitle [ #title := "rdcapsis" ] - topBar <- new Adw.HeaderBar - [ #titleWidget := title ] - - sidebarToolbarView <- - new Adw.ToolbarView - [ #content := button ] - - mainToolbarView <- - new Adw.ToolbarView - [] - mainToolbarView.addTopBar topBar - - sidebarNavPage <- new Adw.NavigationPage - [ #title := "Accounts", - #tag := "sidebar", - #child := sidebarToolbarView ] - - mainNavPage <- new Adw.NavigationPage - [ #title := "Content", - #tag := "content", - #child := mainToolbarView ] - - splitView <- new Adw.NavigationSplitView - [ #sidebar := sidebarNavPage, - #content := mainNavPage ] - - window <- - new - Adw.ApplicationWindow - [ #application := app, - #content := splitView, - #widthRequest := 280, - #heightRequest := 200, - #defaultWidth := 800, - #defaultHeight := 800 - ] - - cond <- Adw.breakpointConditionParse "max-width: 400sp" - breakpoint <- new Adw.Breakpoint [ #condition := cond, - On #apply (splitView.setCollapsed True), - On #unapply (splitView.setCollapsed False) ] - window.addBreakpoint breakpoint - - window.present - main :: IO () -main = do - app <- - new - Adw.Application - [ #applicationId := "eu.fautchen.rdcapsis", - On #activate (activate ?self) - ] - void $ app.run Nothing - --- window <- applicationWindowNew +main = putStrLn "Hello!" -- cgit v1.2.3