From 95d50b25c990e8c945ce2507b16ff3c8b039d286 Mon Sep 17 00:00:00 2001 From: Rutger Broekhoff Date: Mon, 25 Aug 2025 19:48:19 +0200 Subject: OCaml --- app/Data/Iban.hs | 48 ----- app/Data/Ledger.hs | 115 ---------- app/Data/Ledger/AutoFile.hs | 1 - app/Data/Res.hs | 31 --- app/Format.hs | 3 - app/Import/Ing/Convert.hs | 257 ----------------------- app/Import/Ing/CurrentAccountCsv.hs | 407 ------------------------------------ app/Import/Ing/SavingsAccountCsv.hs | 164 --------------- app/Import/Ing/Shared.hs | 44 ---- app/Main.hs | 4 - 10 files changed, 1074 deletions(-) delete mode 100644 app/Data/Iban.hs delete mode 100644 app/Data/Ledger.hs delete mode 100644 app/Data/Ledger/AutoFile.hs delete mode 100644 app/Data/Res.hs delete mode 100644 app/Format.hs delete mode 100644 app/Import/Ing/Convert.hs delete mode 100644 app/Import/Ing/CurrentAccountCsv.hs delete mode 100644 app/Import/Ing/SavingsAccountCsv.hs delete mode 100644 app/Import/Ing/Shared.hs delete mode 100644 app/Main.hs (limited to 'app') diff --git a/app/Data/Iban.hs b/app/Data/Iban.hs deleted file mode 100644 index d9566b9..0000000 --- a/app/Data/Iban.hs +++ /dev/null @@ -1,48 +0,0 @@ -module Data.Iban (Iban, mkIban, toText) where - -import Control.Applicative ((<|>)) -import Data.Attoparsec.Text as AP -import Data.Char - ( digitToInt, - isAscii, - isDigit, - 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 = AP.parseOnly $ do - countryCode <- AP.count 2 AP.letter - checkDigits <- AP.count 2 AP.digit - chars <- AP.many1 (AP.letter <|> AP.digit) - endOfInput - if length chars < 30 - then - if valid countryCode checkDigits chars - then return () - else fail $ "IBAN checksum does not match (" ++ countryCode ++ checkDigits ++ chars ++ ")" - else fail "IBAN has more than 34 characters" - where - letterToInt c = ord (toUpper c) - ord 'A' + 10 - charsToInteger = - foldl' - ( \acc -> \case - d - | isDigit d -> acc * 10 + toInteger (digitToInt d) - | isAscii d -> acc * 100 + toInteger (letterToInt d) - | otherwise -> error "unreachable" - ) - 0 - ibanToInteger countryCode checkDigits chars = - 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 deleted file mode 100644 index 4aa5137..0000000 --- a/app/Data/Ledger.hs +++ /dev/null @@ -1,115 +0,0 @@ -{-# 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 | AutoRoundSavingsTag deriving (Eq, Enum, Ord, Show) - -data TextTag = DescTag | UserTag | CounterpartyNameTag | ReferenceTag | MandateIdTag | CreditorIdTag | OtherPartyTag | TransactionTag | TerminalTag | CardSeqNoTag | SavingsAccountTag 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 :: AccountId, - amount :: Money, - 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 Entry = TxEntry Tx | BalAssertEntry BalAssert - -data Ledger = Ledger [Entry] diff --git a/app/Data/Ledger/AutoFile.hs b/app/Data/Ledger/AutoFile.hs deleted file mode 100644 index 15a1b16..0000000 --- a/app/Data/Ledger/AutoFile.hs +++ /dev/null @@ -1 +0,0 @@ -module Data.Ledger.AutoFile where diff --git a/app/Data/Res.hs b/app/Data/Res.hs deleted file mode 100644 index 3806e5a..0000000 --- a/app/Data/Res.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Data.Res where - -import Control.Applicative -import Data.String (IsString (fromString)) - -data Res e r = Ok r | Err e - -instance Functor (Res e) where - fmap f (Ok v) = Ok (f v) - fmap _ (Err e) = Err e - -instance Applicative (Res e) where - pure = Ok - (Ok f) <*> (Ok v) = Ok (f v) - (Err e) <*> _ = Err e - _ <*> (Err e) = Err e - -instance Monad (Res e) where - (Ok v) >>= f = f v - (Err e) >>= _ = Err e - -instance (IsString e) => MonadFail (Res e) where - fail = Err . fromString - -instance (IsString e) => Alternative (Res e) where - empty = fail "mzero" - m1@(Ok _) <|> _ = m1 - (Err _) <|> m2 = m2 - -liftEither :: Either e r -> Res e r -liftEither = either Err Ok diff --git a/app/Format.hs b/app/Format.hs deleted file mode 100644 index a779d95..0000000 --- a/app/Format.hs +++ /dev/null @@ -1,3 +0,0 @@ -module Format where - -import Text.Parsec 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 - ] - } 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 diff --git a/app/Import/Ing/SavingsAccountCsv.hs b/app/Import/Ing/SavingsAccountCsv.hs deleted file mode 100644 index 16b5f92..0000000 --- a/app/Import/Ing/SavingsAccountCsv.hs +++ /dev/null @@ -1,164 +0,0 @@ -{-# 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 (maybeCP, parseDateM, parseDecimalM, parseIbanM, 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 <*> ptxAccountId <*> ptxAccountName <*> ptxAmount <*> 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 ++ "'") - -instance C.FromNamedRecord PrimTx where - parseNamedRecord m = - PrimTx - <$> (m .: "Datum" >>= parseDateM "%Y-%m-%d") - <*> m .: "Omschrijving" - <*> m .: "Rekening" - <*> m .: "Rekening naam" - <*> (m .: "Tegenrekening" >>= maybeCP parseIbanM) - <*> (m .: "Af Bij" >>= debitCreditCP) - <*> (m .: "Bedrag" >>= parseDecimalM) - <*> m .: "Valuta" - <*> (m .: "Mutatiesoort" >>= mutationTypeCP) - <*> m .: "Mededelingen" - <*> (m .: "Saldo na mutatie" >>= parseDecimalM) - -readFile :: Handle -> IO (V.Vector Tx) -readFile h = do - contents <- BS.hGetContents h - primTxs <- case C.decodeByNameWith 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" - case V.mapM processPrimTx primTxs of - Left err -> fail err - Right txs -> return txs diff --git a/app/Import/Ing/Shared.hs b/app/Import/Ing/Shared.hs deleted file mode 100644 index b5d1703..0000000 --- a/app/Import/Ing/Shared.hs +++ /dev/null @@ -1,44 +0,0 @@ -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) - -scsvOptions :: C.DecodeOptions -scsvOptions = C.defaultDecodeOptions {C.decDelimiter = fromIntegral (ord ';')} - -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 - -parseDecimalM :: (MonadFail m) => T.Text -> m Decimal -parseDecimalM = - either fail return - . 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)) - ) - -parseIbanM :: (MonadFail m) => T.Text -> m Iban -parseIbanM = either fail return . mkIban - -parseDateM :: (MonadFail m) => String -> T.Text -> m Day -parseDateM fmt = parseTimeM False defaultTimeLocale fmt . T.unpack - -parseTimestampM :: (MonadFail m) => String -> TZ -> T.Text -> m UTCTime -parseTimestampM fmt amsTz t = do - localTimeToUTCTZ amsTz <$> parseTimeM False defaultTimeLocale fmt (T.unpack t) diff --git a/app/Main.hs b/app/Main.hs deleted file mode 100644 index 82505bf..0000000 --- a/app/Main.hs +++ /dev/null @@ -1,4 +0,0 @@ -module Main where - -main :: IO () -main = putStrLn "Hello!" -- cgit v1.2.3