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/Convert.hs | 257 ---------------------------------------------- 1 file changed, 257 deletions(-) delete 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 deleted file mode 100644 index 5dcda0b..0000000 --- a/app/Import/Ing/Convert.hs +++ /dev/null @@ -1,257 +0,0 @@ -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.Res -import Data.Text qualified as T -import Import.Ing.CurrentAccountCsv as C -import Import.Ing.SavingsAccountCsv as S - -virtCheckingAcc :: L.AccountId -virtCheckingAcc = AccountId ["Unfiled", "Checking"] - -virtSavingsAcc :: L.AccountId -virtSavingsAcc = AccountId ["Unfiled", "Savings"] - -virtCounterparty :: L.AccountId -virtCounterparty = AccountId ["Unfiled", "Counterparty"] - -toCents :: Decimal -> Res String L.Money -toCents m - | f == 0 = - return (L.Money m') - | otherwise = - fail "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 ()) - -lesFromCurrentAcc :: CommodityId -> C.Tx -> Res String [L.Entry] -lesFromCurrentAcc eucId tx@(C.Tx base _) = do - tx' <- txFromCurrentAcc eucId tx - ba <- baFromCurrentAccBase base - return [BalAssertEntry ba, TxEntry tx'] - -baFromCurrentAccBase :: C.TxBase -> Res String L.BalAssert -baFromCurrentAccBase base = do - resBal <- toCents base.resBal - return $ - L.BalAssert - { account = virtCheckingAcc, - amount = resBal, - labels = - fromList [IbanLabel AccountTag ==> base.account] - } - -baFromCurrentAcc :: C.Tx -> Res String L.BalAssert -baFromCurrentAcc (C.Tx base _) = baFromCurrentAccBase base - -txFromCurrentAcc :: CommodityId -> C.Tx -> Res String L.Tx -txFromCurrentAcc eucId (C.Tx base spec) = do - when (base.amount < 0) $ - fail "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 virtCheckingAcc amount, - debit = M.singleton virtCounterparty amount, - labels = - fromList - [ IbanLabel AccountTag ==> base.account, - TextLabel CounterpartyNameTag ==> counterpartyName, - 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 virtCheckingAcc amount, - credit = M.singleton virtCounterparty amount, - labels = - fromList - [ IbanLabel AccountTag ==> base.account, - TextLabel CounterpartyNameTag ==> counterpartyName, - 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 virtCheckingAcc amount, - credit = M.singleton virtCounterparty amount, - labels = - fromList - [ IbanLabel AccountTag ==> base.account, - TextLabel CounterpartyNameTag ==> counterpartyName, - 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 amount, - credit = M.singleton virtCheckingAcc amount, - labels = - fromList - [ IbanLabel AccountTag ==> base.account, - TextLabel CounterpartyNameTag ==> counterpartyName, - IbanLabel CounterpartyIbanTag ==> counterpartyIban, - TextLabel DescTag ==> description - ] - `union` (maybe empty (singleton TimestampLabel . Identity) mtimestamp) - } - RecurrentDirectDebit - { counterpartyName, - counterpartyIban, - description, - reference, - mandateId, - creditorId, - otherParty - } -> - return $ - L.Tx - { cleared = Just base.date, - commodityId = eucId, - credit = M.singleton virtCheckingAcc amount, - debit = M.singleton virtCounterparty amount, - labels = - fromList - [ IbanLabel AccountTag ==> base.account, - IbanLabel CounterpartyIbanTag ==> counterpartyIban, - TextLabel CounterpartyNameTag ==> counterpartyName, - TextLabel DescTag ==> description, - TextLabel ReferenceTag ==> reference, - TextLabel MandateIdTag ==> mandateId, - TextLabel CreditorIdTag ==> creditorId - ] - `union` (maybe empty (singleton (TextLabel OtherPartyTag) . Identity) otherParty) - } - RoundingSavingsDeposit - { savingsAccount - } -> - return $ - L.Tx - { cleared = Just base.date, - commodityId = eucId, - credit = M.singleton virtCheckingAcc amount, - debit = M.singleton virtSavingsAcc amount, - labels = - fromList - [ UnitLabel AutoRoundSavingsTag ==> (), - TextLabel SavingsAccountTag ==> savingsAccount - ] - } - DepositTransfer - { counterpartyName, - counterpartyIban, - description, - reference - } -> - return $ - L.Tx - { cleared = Just base.date, - commodityId = eucId, - debit = M.singleton virtCheckingAcc amount, - credit = M.singleton virtCounterparty amount, - labels = - fromList - [ IbanLabel CounterpartyIbanTag ==> counterpartyIban, - TextLabel CounterpartyNameTag ==> counterpartyName, - TextLabel DescTag ==> description, - TextLabel ReferenceTag ==> reference - ] - } - IdealDebit - { counterpartyName, - counterpartyIban, - description, - timestamp, - reference - } -> - return $ - L.Tx - { cleared = Just base.date, - commodityId = eucId, - debit = M.singleton virtCheckingAcc amount, - credit = M.singleton virtCounterparty amount, - labels = - fromList - [ IbanLabel CounterpartyIbanTag ==> counterpartyIban, - TextLabel CounterpartyNameTag ==> counterpartyName, - TextLabel DescTag ==> description, - TextLabel ReferenceTag ==> reference, - TimestampLabel ==> timestamp - ] - } - BatchPayment - { counterpartyName, - counterpartyIban, - description, - reference - } -> - return $ - L.Tx - { cleared = Just base.date, - commodityId = eucId, - debit = M.singleton virtCheckingAcc amount, - credit = M.singleton virtCounterparty amount, - labels = - fromList - [ IbanLabel CounterpartyIbanTag ==> counterpartyIban, - TextLabel CounterpartyNameTag ==> counterpartyName, - TextLabel DescTag ==> description, - TextLabel ReferenceTag ==> reference - ] - } -- cgit v1.2.3