summaryrefslogtreecommitdiffstats
path: root/app
diff options
context:
space:
mode:
authorRutger Broekhoff2025-07-23 12:05:08 +0200
committerRutger Broekhoff2025-07-23 12:05:08 +0200
commit56273cf3b371312f0e72fc2af95a9dcacc8228b8 (patch)
treeb4249523cab145fa32e2fdfb826cb592dcfdc127 /app
parenta40d93a36f0dd9f493757d793321f38a58cbb21b (diff)
downloadrdcapsis-56273cf3b371312f0e72fc2af95a9dcacc8228b8.tar.gz
rdcapsis-56273cf3b371312f0e72fc2af95a9dcacc8228b8.zip
Slaying
Diffstat (limited to 'app')
-rw-r--r--app/Data/Iban.hs5
-rw-r--r--app/Data/Ledger.hs115
-rw-r--r--app/Data/Ledger/AutoFile.hs1
-rw-r--r--app/Import/Ing/Convert.hs126
-rw-r--r--app/Import/Ing/CurrentAccountCsv.hs340
-rw-r--r--app/Main.hs142
6 files changed, 415 insertions, 314 deletions
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 @@
1module Data.Iban (Iban, mkIban) where 1module Data.Iban (Iban, mkIban, toText) where
2 2
3import Control.Applicative ((<|>)) 3import Control.Applicative ((<|>))
4import Data.Attoparsec.Text as AP 4import Data.Attoparsec.Text as AP
@@ -43,3 +43,6 @@ validateIban = AP.parseOnly $ do
43 charsToInteger chars * 1000000 + charsToInteger countryCode * 100 + charsToInteger checkDigits 43 charsToInteger chars * 1000000 + charsToInteger countryCode * 100 + charsToInteger checkDigits
44 valid countryCode checkDigits chars = 44 valid countryCode checkDigits chars =
45 ibanToInteger countryCode checkDigits chars `mod` 97 == 1 45 ibanToInteger countryCode checkDigits chars `mod` 97 == 1
46
47toText :: Iban -> T.Text
48toText (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 @@
1{-# LANGUAGE TemplateHaskell #-}
2{-# LANGUAGE TypeFamilies #-}
3
4module Data.Ledger where
5
6import Data.Constraint.Extras.TH (deriveArgDict)
7import Data.Dependent.Map (DMap, fromList, singleton, union, unionWithKey)
8import Data.Dependent.Sum ((==>))
9import Data.Functor.Identity
10import Data.Functor.Identity (Identity (..))
11import Data.GADT.Compare.TH (deriveGCompare, deriveGEq)
12import Data.GADT.Show.TH (deriveGShow)
13import Data.Iban
14import Data.Map qualified as M
15import Data.Text qualified as T
16import Data.Time.Calendar
17import Data.Time.Clock
18import Data.UUID
19import GHC.Generics
20
21data AccountType = Asset | Equity | Liability | Expense | Income
22
23data TxAction = Inc | Dec
24
25txaOpp :: TxAction -> TxAction
26txaOpp Inc = Dec
27txaOpp Dec = Inc
28
29onDebit :: AccountType -> TxAction
30onDebit Asset = Inc
31onDebit Equity = Dec
32onDebit Liability = Dec
33onDebit Expense = Inc
34onDebit Income = Dec
35
36onCredit :: AccountType -> TxAction
37onCredit = txaOpp . onDebit
38
39data TxType
40 = InterestCtx
41 | OnlineBankingTx
42 | RecurrentDirectTx
43 | PaymentTerminalTx
44 | CashPaymentTx
45 | AtmTx
46 | AutoSaveRoundingTx
47 | BatchTx
48 | DirectDebitTx
49 | PeriodicTx
50
51data IbanTag = AccountTag | CounterpartyIbanTag deriving (Eq, Enum, Ord, Show)
52
53data UnitTag = FiledTag | GooglePayTag deriving (Eq, Enum, Ord, Show)
54
55data TextTag = DescTag | UserTag | CounterpartyNameTag | ReferenceTag | MandateIdTag | CreditorIdTag | OtherPartyTag | TransactionTag | TerminalTag | CardSeqNoTag deriving (Eq, Enum, Ord, Show)
56
57data Label a where
58 TextLabel :: TextTag -> Label T.Text
59 IbanLabel :: IbanTag -> Label Iban
60 UnitLabel :: UnitTag -> Label ()
61 TimestampLabel :: Label UTCTime
62
63deriveGEq ''Label
64deriveGCompare ''Label
65deriveGShow ''Label
66deriveArgDict ''Label
67
68type Labels = DMap Label Identity
69
70data Money = Money Integer deriving (Show)
71
72infixl 6 +€, -€
73
74(+€) :: Money -> Money -> Money
75Money x +€ Money y = Money (x + y)
76
77(-€) :: Money -> Money -> Money
78Money x -€ Money y = Money (x - y)
79
80data Scalar = Amount Money | Rate Integer deriving (Show)
81
82data AccountId = AccountId [T.Text] deriving (Show)
83
84data CommodityId = CommodityId UUID deriving (Show)
85
86data Account = Account
87 { id :: AccountId,
88 description :: [T.Text],
89 commodityId :: CommodityId,
90 balance :: Money
91 }
92
93-- A balance assertion is only valid when all transactions before it have been
94-- cleared and the balance of the account agrees with the amount in the
95-- assertion.
96data BalAssert = BalAssert
97 { account :: Account,
98 amount :: Integer,
99 labels :: Labels
100 }
101
102data Tx = Tx
103 { cleared :: Maybe Day,
104 commodityId :: CommodityId, -- the commodity w.r.t. which rates are calculated
105 debit :: M.Map AccountId Scalar,
106 credit :: M.Map AccountId Scalar,
107 labels :: Labels
108 }
109 deriving (Show, Generic)
110
111data SeqTx = SeqTx [Integer] Tx
112
113data LedgerEntry = TxEntry SeqTx | BalAssertEntry BalAssert
114
115data 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 @@
1module Import.Ing.Convert where
2
3import Control.Monad (when)
4import Data.Decimal
5import Data.Dependent.Map
6import Data.Dependent.Sum ((==>))
7import Data.Functor.Identity
8import Data.Iban qualified as Iban
9import Data.Ledger as L
10import Data.Map qualified as M
11import Data.Text qualified as T
12import Import.Ing.CurrentAccountCsv as C
13import Import.Ing.SavingsAccountCsv as S
14
15virtCheckingAccount :: Iban.Iban -> L.AccountId
16virtCheckingAccount iban = AccountId ["Unfiled", "Asset", "Current", "Checking", "Iban", Iban.toText iban]
17
18virtCounterparty :: T.Text -> L.AccountId
19virtCounterparty name = AccountId ["Unfiled", "Expenses", "Counterparty", "Name", name]
20
21toCents :: Decimal -> Either String L.Money
22toCents m
23 | f == 0 =
24 return (L.Money m')
25 | otherwise =
26 Left "Cannot convert to whole cents: amount of money is more specific"
27 where
28 (m', f) = properFraction (m * 100)
29
30condUnitLabel :: UnitTag -> Bool -> L.Labels
31condUnitLabel _ False = empty
32condUnitLabel t True = singleton (UnitLabel t) (Identity ())
33
34fromCurrentAccountTx :: CommodityId -> C.Tx -> Either String L.Tx
35fromCurrentAccountTx eucId (C.Tx base spec) = do
36 let acc = virtCheckingAccount base.account
37 when (base.amount < 0) $
38 Left "Transaction amount may not be lower than zero"
39 amount <- L.Amount <$> toCents base.amount
40 case spec of
41 PaymentTerminalPayment
42 { counterpartyName,
43 cardSequenceNo,
44 timestamp,
45 transaction,
46 terminal,
47 googlePay
48 } ->
49 return $
50 L.Tx
51 { cleared = Just base.date,
52 commodityId = eucId,
53 credit = M.singleton acc amount,
54 debit = M.singleton (virtCounterparty counterpartyName) amount,
55 labels =
56 fromList
57 [ IbanLabel AccountTag ==> base.account,
58 TextLabel CardSeqNoTag ==> cardSequenceNo,
59 TextLabel TerminalTag ==> terminal,
60 TextLabel TransactionTag ==> transaction,
61 TimestampLabel ==> timestamp
62 ]
63 `union` condUnitLabel GooglePayTag googlePay
64 }
65 PaymentTerminalCashback
66 { counterpartyName,
67 cardSequenceNo,
68 timestamp,
69 transaction,
70 terminal
71 } ->
72 return $
73 L.Tx
74 { cleared = Just base.date,
75 commodityId = eucId,
76 debit = M.singleton acc amount,
77 credit = M.singleton (virtCounterparty counterpartyName) amount,
78 labels =
79 fromList
80 [ IbanLabel AccountTag ==> base.account,
81 TextLabel CardSeqNoTag ==> cardSequenceNo,
82 TextLabel TerminalTag ==> terminal,
83 TextLabel TransactionTag ==> transaction,
84 TimestampLabel ==> timestamp
85 ]
86 }
87 OnlineBankingCredit
88 { counterpartyName,
89 counterpartyIban,
90 description,
91 timestamp
92 } ->
93 return $
94 L.Tx
95 { cleared = Just base.date,
96 commodityId = eucId,
97 debit = M.singleton acc amount,
98 credit = M.singleton (virtCounterparty counterpartyName) amount,
99 labels =
100 fromList
101 [ IbanLabel AccountTag ==> base.account,
102 IbanLabel CounterpartyIbanTag ==> counterpartyIban,
103 TextLabel DescTag ==> description,
104 TimestampLabel ==> timestamp
105 ]
106 }
107 OnlineBankingDebit
108 { counterpartyName,
109 counterpartyIban,
110 description,
111 mtimestamp
112 } ->
113 return $
114 L.Tx
115 { cleared = Just base.date,
116 commodityId = eucId,
117 debit = M.singleton (virtCounterparty counterpartyName) amount,
118 credit = M.singleton acc amount,
119 labels =
120 fromList
121 [ IbanLabel AccountTag ==> base.account,
122 IbanLabel CounterpartyIbanTag ==> counterpartyIban,
123 TextLabel DescTag ==> description
124 ]
125 `union` (maybe empty (singleton TimestampLabel . Identity) mtimestamp)
126 }
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
9import Data.Csv ((.:)) 9import Data.Csv ((.:))
10import Data.Csv qualified as C 10import Data.Csv qualified as C
11import Data.Decimal (Decimal) 11import Data.Decimal (Decimal)
12import Data.Generics.Product.Subtype (upcast)
12import Data.Iban (Iban) 13import Data.Iban (Iban)
13import Data.Res (Res (Err, Ok)) 14import Data.Res (Res (Err, Ok))
14import Data.Text qualified as T 15import Data.Text qualified as T
@@ -16,6 +17,7 @@ import Data.Time.Calendar (Day)
16import Data.Time.Clock (UTCTime) 17import Data.Time.Clock (UTCTime)
17import Data.Time.Zones (TZ, loadTZFromDB) 18import Data.Time.Zones (TZ, loadTZFromDB)
18import Data.Vector qualified as V 19import Data.Vector qualified as V
20import GHC.Generics
19import Import.Ing.Shared 21import Import.Ing.Shared
20 ( DebitCredit (Credit, Debit), 22 ( DebitCredit (Credit, Debit),
21 maybeCP, 23 maybeCP,
@@ -28,6 +30,77 @@ import Import.Ing.Shared
28import System.IO (Handle) 30import System.IO (Handle)
29import Text.Regex.TDFA ((=~~)) 31import Text.Regex.TDFA ((=~~))
30 32
33data Tx = Tx TxBase TxSpecifics deriving (Show)
34
35data TxBase = TxBase
36 { date :: !Day,
37 account :: !Iban,
38 amount :: !Decimal,
39 resBal :: !Decimal,
40 tag :: !T.Text
41 }
42 deriving (Show, Generic)
43
44data TxSpecifics
45 = PaymentTerminalPayment
46 { counterpartyName :: !T.Text,
47 cardSequenceNo :: !T.Text,
48 timestamp :: !UTCTime,
49 transaction :: !T.Text,
50 terminal :: !T.Text,
51 googlePay :: !Bool
52 }
53 | PaymentTerminalCashback
54 { counterpartyName :: !T.Text,
55 cardSequenceNo :: !T.Text,
56 timestamp :: !UTCTime,
57 transaction :: !T.Text,
58 terminal :: !T.Text
59 }
60 | OnlineBankingCredit
61 { counterpartyName :: !T.Text,
62 counterpartyIban :: !Iban,
63 description :: !T.Text,
64 timestamp :: !UTCTime
65 }
66 | OnlineBankingDebit
67 { counterpartyName :: !T.Text,
68 counterpartyIban :: !Iban,
69 description :: T.Text,
70 mtimestamp :: !(Maybe UTCTime)
71 }
72 | RecurrentDirectDebit
73 { counterpartyName :: !T.Text,
74 counterpartyIban :: !Iban,
75 description :: !T.Text,
76 reference :: !T.Text,
77 mandateId :: !T.Text,
78 creditorId :: !T.Text,
79 otherParty :: !(Maybe T.Text)
80 }
81 | RoundingSavingsDeposit
82 {savingsAccount :: !T.Text}
83 | DepositTransfer
84 { counterpartyName :: !T.Text,
85 counterpartyIban :: !Iban,
86 description :: !T.Text,
87 reference :: !T.Text
88 }
89 | IdealDebit
90 { counterpartyName :: !T.Text,
91 counterpartyIban :: !Iban,
92 description :: !T.Text,
93 timestamp :: !UTCTime,
94 reference :: !T.Text
95 }
96 | BatchPayment
97 { counterpartyName :: !T.Text,
98 counterpartyIban :: !Iban,
99 description :: !T.Text,
100 reference :: !T.Text
101 }
102 deriving (Show, Generic)
103
31data TransactionType 104data TransactionType
32 = AcceptGiroType -- AC (acceptgiro) 105 = AcceptGiroType -- AC (acceptgiro)
33 | AtmWithdrawalType -- GM (geldautomaat, Giromaat) 106 | AtmWithdrawalType -- GM (geldautomaat, Giromaat)
@@ -72,18 +145,18 @@ parseType "iDEAL" = return IdealType
72parseType t = fail $ "Unknown transaction type '" ++ T.unpack t ++ "'" 145parseType t = fail $ "Unknown transaction type '" ++ T.unpack t ++ "'"
73 146
74data PrimTx = PrimTx 147data PrimTx = PrimTx
75 { ptxDate :: !Day, 148 { date :: !Day,
76 ptxDescription :: !T.Text, 149 description :: !T.Text,
77 ptxAccount :: !Iban, 150 account :: !Iban,
78 ptxCounterparty :: !(Maybe Iban), 151 counterparty :: !(Maybe Iban),
79 ptxTransactionType :: !TransactionType, 152 transactionType :: !TransactionType,
80 ptxDebitCredit :: !DebitCredit, 153 debitCredit :: !DebitCredit,
81 ptxAmount :: !Decimal, 154 amount :: !Decimal,
82 ptxNotifications :: !T.Text, 155 notifications :: !T.Text,
83 ptxResBal :: !Decimal, 156 resBal :: !Decimal,
84 ptxTag :: !T.Text 157 tag :: !T.Text
85 } 158 }
86 deriving (Show) 159 deriving (Show, Generic)
87 160
88debitCreditCP :: T.Text -> C.Parser DebitCredit 161debitCreditCP :: T.Text -> C.Parser DebitCredit
89debitCreditCP "Debit" = return Debit 162debitCreditCP "Debit" = return Debit
@@ -122,265 +195,188 @@ assertValueDate expected t = do
122 fail "Expected transaction date and value date to be the same" 195 fail "Expected transaction date and value date to be the same"
123 196
124assertValueDatePtx :: PrimTx -> T.Text -> Res String () 197assertValueDatePtx :: PrimTx -> T.Text -> Res String ()
125assertValueDatePtx PrimTx {ptxDate = expected} = assertValueDate expected 198assertValueDatePtx PrimTx {date = expected} = assertValueDate expected
126 199
127specificsFromPrim :: TZ -> PrimTx -> Res String TxSpecifics 200specificsFromPrim :: TZ -> PrimTx -> Res String TxSpecifics
128specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = PaymentTerminalType, ptxDebitCredit = Debit} = do 201specificsFromPrim amsTz ptx@PrimTx {transactionType = PaymentTerminalType, debitCredit = Debit} = do
129 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 202 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
130 (_, _, _, [cardSeqNo, timestampTxt, transaction, _, gpayTerm, noGpayTerm, valDateTxt]) <- 203 (_, _, _, [cardSeqNo, timestampTxt, transaction, _, gpayTerm, noGpayTerm, valDateTxt]) <-
131 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) 204 ptx.notifications =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
132 assertValueDatePtx ptx valDateTxt 205 assertValueDatePtx ptx valDateTxt
133 timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt 206 timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt
134 return $ 207 return $
135 PaymentTerminalPayment 208 PaymentTerminalPayment
136 { ptpCounterpartyName = ptxDescription ptx, 209 { counterpartyName = ptx.description,
137 ptpCardSequenceNo = cardSeqNo, 210 cardSequenceNo = cardSeqNo,
138 ptpTimestamp = timestamp, 211 timestamp = timestamp,
139 ptpTransaction = transaction, 212 transaction = transaction,
140 ptpTerminal = if T.null gpayTerm then noGpayTerm else gpayTerm, 213 terminal = if T.null gpayTerm then noGpayTerm else gpayTerm,
141 ptpGooglePay = T.null noGpayTerm 214 googlePay = T.null noGpayTerm
142 } 215 }
143specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = PaymentTerminalType, ptxDebitCredit = Credit} = do 216specificsFromPrim amsTz ptx@PrimTx {transactionType = PaymentTerminalType, debitCredit = Credit} = do
144 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 217 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
145 (_, _, _, [cardSeqNo, timestampTxt, transaction, term, valDateTxt]) <- 218 (_, _, _, [cardSeqNo, timestampTxt, transaction, term, valDateTxt]) <-
146 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) 219 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
147 assertValueDatePtx ptx valDateTxt 220 assertValueDatePtx ptx valDateTxt
148 timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt 221 timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt
149 return $ 222 return $
150 PaymentTerminalCashback 223 PaymentTerminalCashback
151 { ptcCounterpartyName = ptxDescription ptx, 224 { counterpartyName = ptx.description,
152 ptcCardSequenceNo = cardSeqNo, 225 cardSequenceNo = cardSeqNo,
153 ptcTimestamp = timestamp, 226 timestamp = timestamp,
154 ptcTransaction = transaction, 227 transaction = transaction,
155 ptcTerminal = term 228 terminal = term
156 } 229 }
157specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = OnlineBankingType, ptxDebitCredit = Credit} = do 230specificsFromPrim amsTz ptx@PrimTx {transactionType = OnlineBankingType, debitCredit = Credit} = do
158 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 231 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
159 (_, _, _, [name, desc, ibanTxt, timestampTxt, valDateTxt]) <- 232 (_, _, _, [name, desc, ibanTxt, timestampTxt, valDateTxt]) <-
160 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) 233 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
161 assertValueDatePtx ptx valDateTxt 234 assertValueDatePtx ptx valDateTxt
162 iban <- parseIbanM ibanTxt 235 iban <- parseIbanM ibanTxt
163 timestamp <- parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt 236 timestamp <- parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt
164 when (name /= ptxDescription ptx) $ 237 when (name /= ptx.description) $
165 fail "Expected counterparty name for online banking credit to match primitive description" 238 fail "Expected counterparty name for online banking credit to match primitive description"
166 when (Just iban /= ptxCounterparty ptx) $ 239 when (Just iban /= ptx.counterparty) $
167 fail "Expected IBAN for online banking credit to match and primitive counterparty IBAN" 240 fail "Expected IBAN for online banking credit to match and primitive counterparty IBAN"
168 return $ 241 return $
169 OnlineBankingCredit 242 OnlineBankingCredit
170 { obcCounterpartyName = name, 243 { counterpartyName = name,
171 obcCounterpartyIban = iban, 244 counterpartyIban = iban,
172 obcDescription = desc, 245 description = desc,
173 obcTimestamp = timestamp 246 timestamp = timestamp
174 } 247 }
175specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = OnlineBankingType, ptxDebitCredit = Debit} = do 248specificsFromPrim amsTz ptx@PrimTx {transactionType = OnlineBankingType, debitCredit = Debit} = do
176 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 249 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
177 (_, _, _, [name, desc, ibanTxt, _, timestampTxt, valDateTxt]) <- 250 (_, _, _, [name, desc, ibanTxt, _, timestampTxt, valDateTxt]) <-
178 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) 251 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
179 assertValueDatePtx ptx valDateTxt 252 assertValueDatePtx ptx valDateTxt
180 iban <- parseIbanM ibanTxt 253 iban <- parseIbanM ibanTxt
181 timestamp <- 254 timestamp <-
182 if T.null timestampTxt 255 if T.null timestampTxt
183 then pure Nothing 256 then pure Nothing
184 else Just <$> parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt 257 else Just <$> parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt
185 when (name /= ptxDescription ptx) $ 258 when (name /= ptx.description) $
186 fail "Expected counterparty name for online banking debit to match primitive description" 259 fail "Expected counterparty name for online banking debit to match primitive description"
187 when (Just iban /= ptxCounterparty ptx) $ 260 when (Just iban /= ptx.counterparty) $
188 fail "Expected IBAN for online banking debit to match and primitive counterparty IBAN" 261 fail "Expected IBAN for online banking debit to match and primitive counterparty IBAN"
189 return $ 262 return $
190 OnlineBankingDebit 263 OnlineBankingDebit
191 { obdCounterpartyIban = iban, 264 { counterpartyIban = iban,
192 obdCounterpartyName = name, 265 counterpartyName = name,
193 obdDescription = desc, 266 description = desc,
194 obdTimestamp = timestamp 267 mtimestamp = timestamp
195 } 268 }
196specificsFromPrim _ ptx@PrimTx {ptxTransactionType = DirectDebitType, ptxDebitCredit = Debit} = 269specificsFromPrim _ ptx@PrimTx {transactionType = DirectDebitType, debitCredit = Debit} =
197 normalRecurrentDirectDebit <|> ingInsurancePayment 270 normalRecurrentDirectDebit <|> ingInsurancePayment
198 where 271 where
199 normalRecurrentDirectDebit = do 272 normalRecurrentDirectDebit = do
200 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 273 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
201 (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId, _, otherParty, valDateTxt]) <- 274 (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId, _, otherParty, valDateTxt]) <-
202 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) 275 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
203 assertValueDatePtx ptx valDateTxt 276 assertValueDatePtx ptx valDateTxt
204 iban <- parseIbanM ibanTxt 277 iban <- parseIbanM ibanTxt
205 when (name /= ptxDescription ptx) $ 278 when (name /= ptx.description) $
206 fail "Expected counterparty name for direct debit to match primitive description" 279 fail "Expected counterparty name for direct debit to match primitive description"
207 when (Just iban /= ptxCounterparty ptx) $ 280 when (Just iban /= ptx.counterparty) $
208 fail "Expected IBAN for direct debit to match and primitive counterparty IBAN" 281 fail "Expected IBAN for direct debit to match and primitive counterparty IBAN"
209 return $ 282 return $
210 RecurrentDirectDebit 283 RecurrentDirectDebit
211 { rddCounterpartyName = name, 284 { counterpartyName = name,
212 rddCounterpartyIban = iban, 285 counterpartyIban = iban,
213 rddDescription = desc, 286 description = desc,
214 rddReference = ref, 287 reference = ref,
215 rddMandateId = mandateId, 288 mandateId = mandateId,
216 rddCreditorId = creditorId, 289 creditorId = creditorId,
217 rddOtherParty = if T.null otherParty then Nothing else Just otherParty 290 otherParty = if T.null otherParty then Nothing else Just otherParty
218 } 291 }
219 ingInsurancePayment = do 292 ingInsurancePayment = do
220 let regex = "^Name: (.* ING Verzekeren) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit$" :: String 293 let regex = "^Name: (.* ING Verzekeren) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit$" :: String
221 (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId]) <- 294 (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId]) <-
222 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) 295 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
223 iban <- parseIbanM ibanTxt 296 iban <- parseIbanM ibanTxt
224 when (name /= ptxDescription ptx) $ 297 when (name /= ptx.description) $
225 fail "Expected counterparty name for direct debit to match primitive description" 298 fail "Expected counterparty name for direct debit to match primitive description"
226 when (Just iban /= ptxCounterparty ptx) $ 299 when (Just iban /= ptx.counterparty) $
227 fail "Expected IBAN for direct debit to match and primitive counterparty IBAN" 300 fail "Expected IBAN for direct debit to match and primitive counterparty IBAN"
228 return $ 301 return $
229 RecurrentDirectDebit 302 RecurrentDirectDebit
230 { rddCounterpartyName = name, 303 { counterpartyName = name,
231 rddCounterpartyIban = iban, 304 counterpartyIban = iban,
232 rddDescription = desc, 305 description = desc,
233 rddReference = ref, 306 reference = ref,
234 rddMandateId = mandateId, 307 mandateId = mandateId,
235 rddCreditorId = creditorId, 308 creditorId = creditorId,
236 rddOtherParty = Nothing 309 otherParty = Nothing
237 } 310 }
238specificsFromPrim _ ptx@PrimTx {ptxTransactionType = TransferType, ptxDebitCredit = Credit} = do 311specificsFromPrim _ ptx@PrimTx {transactionType = TransferType, debitCredit = Credit} = do
239 let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String 312 let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
240 (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <- 313 (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <-
241 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) 314 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
242 assertValueDatePtx ptx valDateTxt 315 assertValueDatePtx ptx valDateTxt
243 iban <- parseIbanM ibanTxt 316 iban <- parseIbanM ibanTxt
244 when (name /= ptxDescription ptx) $ 317 when (name /= ptx.description) $
245 fail "Expected counterparty name for deposit transfer to match primitive description" 318 fail "Expected counterparty name for deposit transfer to match primitive description"
246 when (Just iban /= ptxCounterparty ptx) $ 319 when (Just iban /= ptx.counterparty) $
247 fail "Expected IBAN for deposit transfer to match and primitive counterparty IBAN" 320 fail "Expected IBAN for deposit transfer to match and primitive counterparty IBAN"
248 return $ 321 return $
249 DepositTransfer 322 DepositTransfer
250 { dtCounterpartyName = name, 323 { counterpartyName = name,
251 dtCounterpartyIban = iban, 324 counterpartyIban = iban,
252 dtDescription = desc, 325 description = desc,
253 dtReference = ref 326 reference = ref
254 } 327 }
255specificsFromPrim _ ptx@PrimTx {ptxTransactionType = TransferType, ptxDebitCredit = Debit} = do 328specificsFromPrim _ ptx@PrimTx {transactionType = TransferType, debitCredit = Debit} = do
256 let regex = "^To Oranje spaarrekening ([A-Z0-9]+) Afronding Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String 329 let regex = "^To Oranje spaarrekening ([A-Z0-9]+) Afronding Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
257 (_, _, _, [savingsAccount, valDateTxt]) <- 330 (_, _, _, [savingsAccount, valDateTxt]) <-
258 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) 331 ptx.notifications =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
259 assertValueDatePtx ptx valDateTxt 332 assertValueDatePtx ptx valDateTxt
260 return $ RoundingSavingsDeposit {rsdSavingsAccount = savingsAccount} 333 return $ RoundingSavingsDeposit {savingsAccount = savingsAccount}
261specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = IdealType, ptxDebitCredit = Debit} = do 334specificsFromPrim amsTz ptx@PrimTx {transactionType = IdealType, debitCredit = Debit} = do
262 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 335 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
263 (_, _, _, [name, desc, ibanTxt, timestampTxt, ref, valDateTxt]) <- 336 (_, _, _, [name, desc, ibanTxt, timestampTxt, ref, valDateTxt]) <-
264 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) 337 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
265 assertValueDatePtx ptx valDateTxt 338 assertValueDatePtx ptx valDateTxt
266 timestamp <- parseTimestampM "%d-%m-%Y %H:%M" amsTz timestampTxt 339 timestamp <- parseTimestampM "%d-%m-%Y %H:%M" amsTz timestampTxt
267 iban <- parseIbanM ibanTxt 340 iban <- parseIbanM ibanTxt
268 when (name /= ptxDescription ptx) $ 341 when (name /= ptx.description) $
269 fail "Expected counterparty name for iDEAL payment to match primitive description" 342 fail "Expected counterparty name for iDEAL payment to match primitive description"
270 when (Just iban /= ptxCounterparty ptx) $ 343 when (Just iban /= ptx.counterparty) $
271 fail "Expected IBAN for iDEAL payment to match and primitive counterparty IBAN" 344 fail "Expected IBAN for iDEAL payment to match and primitive counterparty IBAN"
272 return $ 345 return $
273 IdealDebit 346 IdealDebit
274 { idCounterpartyName = name, 347 { counterpartyName = name,
275 idCounterpartyIban = iban, 348 counterpartyIban = iban,
276 idDescription = desc, 349 description = desc,
277 idTimestamp = timestamp, 350 timestamp = timestamp,
278 idReference = ref 351 reference = ref
279 } 352 }
280specificsFromPrim _ ptx@PrimTx {ptxTransactionType = BatchPaymentType, ptxDebitCredit = Credit} = do 353specificsFromPrim _ ptx@PrimTx {transactionType = BatchPaymentType, debitCredit = Credit} = do
281 let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String 354 let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
282 (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <- 355 (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <-
283 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text]) 356 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
284 assertValueDatePtx ptx valDateTxt 357 assertValueDatePtx ptx valDateTxt
285 iban <- parseIbanM ibanTxt 358 iban <- parseIbanM ibanTxt
286 when (name /= ptxDescription ptx) $ 359 when (name /= ptx.description) $
287 fail "Expected counterparty name for batch payment to match primitive description" 360 fail "Expected counterparty name for batch payment to match primitive description"
288 when (Just iban /= ptxCounterparty ptx) $ 361 when (Just iban /= ptx.counterparty) $
289 fail "Expected IBAN for batch payment to match and primitive counterparty IBAN" 362 fail "Expected IBAN for batch payment to match and primitive counterparty IBAN"
290 return $ 363 return $
291 BatchPayment 364 BatchPayment
292 { bpCounterpartyName = name, 365 { counterpartyName = name,
293 bpCounterpartyIban = iban, 366 counterpartyIban = iban,
294 bpDescription = desc, 367 description = desc,
295 bpReference = ref 368 reference = ref
296 } 369 }
297specificsFromPrim _ ptx = 370specificsFromPrim _ ptx =
298 fail $ 371 fail $
299 "Could not extract data from transaction (" 372 "Could not extract data from transaction ("
300 ++ show (ptxTransactionType ptx) 373 ++ show (transactionType ptx)
301 ++ " / " 374 ++ " / "
302 ++ show (ptxDebitCredit ptx) 375 ++ show (debitCredit ptx)
303 ++ ")" 376 ++ ")"
304 377
305txBaseFromPrim :: PrimTx -> TxBase 378txBaseFromPrim :: PrimTx -> TxBase
306txBaseFromPrim = 379txBaseFromPrim = upcast
307 TxBase
308 <$> ptxDate
309 <*> ptxAccount
310 <*> ptxAmount
311 <*> ptxResBal
312 <*> ptxTag
313
314data Tx = Tx TxBase TxSpecifics deriving (Show)
315
316data TxBase = TxBase
317 { txbDate :: !Day,
318 txbAccount :: !Iban,
319 txbAmount :: !Decimal,
320 txbResBal :: !Decimal,
321 txbTag :: !T.Text
322 }
323 deriving (Show)
324
325data TxSpecifics
326 = PaymentTerminalPayment
327 { ptpCounterpartyName :: !T.Text,
328 ptpCardSequenceNo :: !T.Text,
329 ptpTimestamp :: !UTCTime,
330 ptpTransaction :: !T.Text,
331 ptpTerminal :: !T.Text,
332 ptpGooglePay :: !Bool
333 }
334 | PaymentTerminalCashback
335 { ptcCounterpartyName :: !T.Text,
336 ptcCardSequenceNo :: !T.Text,
337 ptcTimestamp :: !UTCTime,
338 ptcTransaction :: !T.Text,
339 ptcTerminal :: !T.Text
340 }
341 | OnlineBankingCredit
342 { obcCounterpartyName :: !T.Text,
343 obcCounterpartyIban :: !Iban,
344 obcDescription :: !T.Text,
345 obcTimestamp :: !UTCTime
346 }
347 | OnlineBankingDebit
348 { obdCounterpartyName :: !T.Text,
349 obdCounterpartyIban :: !Iban,
350 obdDescription :: T.Text,
351 obdTimestamp :: !(Maybe UTCTime)
352 }
353 | RecurrentDirectDebit
354 { rddCounterpartyName :: !T.Text,
355 rddCounterpartyIban :: !Iban,
356 rddDescription :: !T.Text,
357 rddReference :: !T.Text,
358 rddMandateId :: !T.Text,
359 rddCreditorId :: !T.Text,
360 rddOtherParty :: !(Maybe T.Text)
361 }
362 | RoundingSavingsDeposit
363 {rsdSavingsAccount :: !T.Text}
364 | DepositTransfer
365 { dtCounterpartyName :: !T.Text,
366 dtCounterpartyIban :: !Iban,
367 dtDescription :: !T.Text,
368 dtReference :: !T.Text
369 }
370 | IdealDebit
371 { idCounterpartyName :: !T.Text,
372 idCounterpartyIban :: !Iban,
373 idDescription :: !T.Text,
374 idTimestamp :: !UTCTime,
375 idReference :: !T.Text
376 }
377 | BatchPayment
378 { bpCounterpartyName :: !T.Text,
379 bpCounterpartyIban :: !Iban,
380 bpDescription :: !T.Text,
381 bpReference :: !T.Text
382 }
383 deriving (Show)
384 380
385readFile :: Handle -> IO (V.Vector Tx) 381readFile :: Handle -> IO (V.Vector Tx)
386readFile h = do 382readFile 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 @@
1{-# LANGUAGE ImplicitParams #-}
2{-# LANGUAGE OverloadedLabels #-}
3{-# LANGUAGE OverloadedRecordDot #-}
4{-# LANGUAGE OverloadedStrings #-}
5
6module Main where 1module Main where
7 2
8import Control.Monad (void)
9import Data.GI.Base
10import GI.Adw qualified as Adw
11import GI.Adw.Objects.ApplicationWindow
12import GI.Gtk qualified as Gtk
13import Import.Ing.CurrentAccountCsv qualified
14import Import.Ing.SavingsAccountCsv qualified
15import System.IO (IOMode (ReadMode), withFile)
16import Text.Pretty.Simple (pPrint)
17
18-- data AccountType = Asset | Equity | Liability | Expense | Income
19--
20-- data TxAction = Inc | Dec
21--
22-- txAopp :: TxAction -> TxAction
23-- txaOpp Inc = Dec
24-- txaOpp Dec = Inc
25--
26-- onDebit :: AccountType -> TxAction
27-- onDebit Asset = Inc
28-- onDebit Equity = Dec
29-- onDebit Liability = Dec
30-- onDebit Expense = Inc
31-- onDebit Income = Dec
32--
33-- onCredit :: AccountType -> TxAction
34-- onCredit = txaOpp . onDebit
35--
36-- data Ledger = [LedgerEntry]
37--
38-- data LedgerEntry = TxEntry Tx | BalAssertEntry BalAssert
39--
40-- -- A balance assertion is only valid when all transactions before it have been
41-- -- cleared and the balance of the account agrees with the amount in the
42-- -- assertion.
43-- data BalAssert = BalAssert {
44-- account :: Account,
45-- amount :: Decimal,
46-- tags :: Tags }
47--
48-- data Tx = Tx {
49-- txClearedAt :: Maybe UTCTime,
50-- txCommodity :: Commodity, -- the commodity w.r.t. which rates are calculated
51-- txDebit :: [(Account, Rate, Amount)],
52-- txCredit :: [(Account, Rate, Amount)]
53-- -- Description
54-- -- Type:
55-- } deriving Show
56--
57-- data Account = Account {
58-- acName :: [T.Text],
59-- acBalance :: Amount }
60
61activate :: Adw.Application -> IO ()
62activate app = do
63 button <-
64 new
65 Gtk.Button
66 [ #label := "Click me",
67 On
68 #clicked
69 ( ?self
70 `set` [ #sensitive := False,
71 #label := "Thanks for clicking me"
72 ]
73 )
74 ]
75 button2 <-
76 new
77 Gtk.Button
78 [ #label := "Click me",
79 On
80 #clicked
81 ( ?self
82 `set` [ #sensitive := False,
83 #label := "Thanks for clicking me"
84 ]
85 )
86 ]
87
88 title <- new Adw.WindowTitle [ #title := "rdcapsis" ]
89 topBar <- new Adw.HeaderBar
90 [ #titleWidget := title ]
91
92 sidebarToolbarView <-
93 new Adw.ToolbarView
94 [ #content := button ]
95
96 mainToolbarView <-
97 new Adw.ToolbarView
98 []
99 mainToolbarView.addTopBar topBar
100
101 sidebarNavPage <- new Adw.NavigationPage
102 [ #title := "Accounts",
103 #tag := "sidebar",
104 #child := sidebarToolbarView ]
105
106 mainNavPage <- new Adw.NavigationPage
107 [ #title := "Content",
108 #tag := "content",
109 #child := mainToolbarView ]
110
111 splitView <- new Adw.NavigationSplitView
112 [ #sidebar := sidebarNavPage,
113 #content := mainNavPage ]
114
115 window <-
116 new
117 Adw.ApplicationWindow
118 [ #application := app,
119 #content := splitView,
120 #widthRequest := 280,
121 #heightRequest := 200,
122 #defaultWidth := 800,
123 #defaultHeight := 800
124 ]
125
126 cond <- Adw.breakpointConditionParse "max-width: 400sp"
127 breakpoint <- new Adw.Breakpoint [ #condition := cond,
128 On #apply (splitView.setCollapsed True),
129 On #unapply (splitView.setCollapsed False) ]
130 window.addBreakpoint breakpoint
131
132 window.present
133
134main :: IO () 3main :: IO ()
135main = do 4main = putStrLn "Hello!"
136 app <-
137 new
138 Adw.Application
139 [ #applicationId := "eu.fautchen.rdcapsis",
140 On #activate (activate ?self)
141 ]
142 void $ app.run Nothing
143
144-- window <- applicationWindowNew