From 56273cf3b371312f0e72fc2af95a9dcacc8228b8 Mon Sep 17 00:00:00 2001 From: Rutger Broekhoff Date: Wed, 23 Jul 2025 12:05:08 +0200 Subject: Slaying --- app/Import/Ing/Convert.hs | 126 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 126 insertions(+) create mode 100644 app/Import/Ing/Convert.hs (limited to 'app/Import/Ing/Convert.hs') 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) + } -- cgit v1.2.3