summaryrefslogtreecommitdiffstats
path: root/app/Import/Ing
diff options
context:
space:
mode:
authorRutger Broekhoff2025-08-25 19:48:19 +0200
committerRutger Broekhoff2025-08-25 19:48:19 +0200
commit95d50b25c990e8c945ce2507b16ff3c8b039d286 (patch)
treec1ff4c7f9601c6980eed1a7235ba336c5c6f6106 /app/Import/Ing
parent29b26dcbc1404925bbf12cddd66f7fcd3c57cfe7 (diff)
downloadrdcapsis-95d50b25c990e8c945ce2507b16ff3c8b039d286.tar.gz
rdcapsis-95d50b25c990e8c945ce2507b16ff3c8b039d286.zip
OCaml
Diffstat (limited to 'app/Import/Ing')
-rw-r--r--app/Import/Ing/Convert.hs257
-rw-r--r--app/Import/Ing/CurrentAccountCsv.hs407
-rw-r--r--app/Import/Ing/SavingsAccountCsv.hs164
-rw-r--r--app/Import/Ing/Shared.hs44
4 files changed, 0 insertions, 872 deletions
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 @@
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.Res
12import Data.Text qualified as T
13import Import.Ing.CurrentAccountCsv as C
14import Import.Ing.SavingsAccountCsv as S
15
16virtCheckingAcc :: L.AccountId
17virtCheckingAcc = AccountId ["Unfiled", "Checking"]
18
19virtSavingsAcc :: L.AccountId
20virtSavingsAcc = AccountId ["Unfiled", "Savings"]
21
22virtCounterparty :: L.AccountId
23virtCounterparty = AccountId ["Unfiled", "Counterparty"]
24
25toCents :: Decimal -> Res String L.Money
26toCents m
27 | f == 0 =
28 return (L.Money m')
29 | otherwise =
30 fail "Cannot convert to whole cents: amount of money is more specific"
31 where
32 (m', f) = properFraction (m * 100)
33
34condUnitLabel :: UnitTag -> Bool -> L.Labels
35condUnitLabel _ False = empty
36condUnitLabel t True = singleton (UnitLabel t) (Identity ())
37
38lesFromCurrentAcc :: CommodityId -> C.Tx -> Res String [L.Entry]
39lesFromCurrentAcc eucId tx@(C.Tx base _) = do
40 tx' <- txFromCurrentAcc eucId tx
41 ba <- baFromCurrentAccBase base
42 return [BalAssertEntry ba, TxEntry tx']
43
44baFromCurrentAccBase :: C.TxBase -> Res String L.BalAssert
45baFromCurrentAccBase base = do
46 resBal <- toCents base.resBal
47 return $
48 L.BalAssert
49 { account = virtCheckingAcc,
50 amount = resBal,
51 labels =
52 fromList [IbanLabel AccountTag ==> base.account]
53 }
54
55baFromCurrentAcc :: C.Tx -> Res String L.BalAssert
56baFromCurrentAcc (C.Tx base _) = baFromCurrentAccBase base
57
58txFromCurrentAcc :: CommodityId -> C.Tx -> Res String L.Tx
59txFromCurrentAcc eucId (C.Tx base spec) = do
60 when (base.amount < 0) $
61 fail "Transaction amount may not be lower than zero"
62 amount <- L.Amount <$> toCents base.amount
63 case spec of
64 PaymentTerminalPayment
65 { counterpartyName,
66 cardSequenceNo,
67 timestamp,
68 transaction,
69 terminal,
70 googlePay
71 } ->
72 return $
73 L.Tx
74 { cleared = Just base.date,
75 commodityId = eucId,
76 credit = M.singleton virtCheckingAcc amount,
77 debit = M.singleton virtCounterparty amount,
78 labels =
79 fromList
80 [ IbanLabel AccountTag ==> base.account,
81 TextLabel CounterpartyNameTag ==> counterpartyName,
82 TextLabel CardSeqNoTag ==> cardSequenceNo,
83 TextLabel TerminalTag ==> terminal,
84 TextLabel TransactionTag ==> transaction,
85 TimestampLabel ==> timestamp
86 ]
87 `union` condUnitLabel GooglePayTag googlePay
88 }
89 PaymentTerminalCashback
90 { counterpartyName,
91 cardSequenceNo,
92 timestamp,
93 transaction,
94 terminal
95 } ->
96 return $
97 L.Tx
98 { cleared = Just base.date,
99 commodityId = eucId,
100 debit = M.singleton virtCheckingAcc amount,
101 credit = M.singleton virtCounterparty amount,
102 labels =
103 fromList
104 [ IbanLabel AccountTag ==> base.account,
105 TextLabel CounterpartyNameTag ==> counterpartyName,
106 TextLabel CardSeqNoTag ==> cardSequenceNo,
107 TextLabel TerminalTag ==> terminal,
108 TextLabel TransactionTag ==> transaction,
109 TimestampLabel ==> timestamp
110 ]
111 }
112 OnlineBankingCredit
113 { counterpartyName,
114 counterpartyIban,
115 description,
116 timestamp
117 } ->
118 return $
119 L.Tx
120 { cleared = Just base.date,
121 commodityId = eucId,
122 debit = M.singleton virtCheckingAcc amount,
123 credit = M.singleton virtCounterparty amount,
124 labels =
125 fromList
126 [ IbanLabel AccountTag ==> base.account,
127 TextLabel CounterpartyNameTag ==> counterpartyName,
128 IbanLabel CounterpartyIbanTag ==> counterpartyIban,
129 TextLabel DescTag ==> description,
130 TimestampLabel ==> timestamp
131 ]
132 }
133 OnlineBankingDebit
134 { counterpartyName,
135 counterpartyIban,
136 description,
137 mtimestamp
138 } ->
139 return $
140 L.Tx
141 { cleared = Just base.date,
142 commodityId = eucId,
143 debit = M.singleton virtCounterparty amount,
144 credit = M.singleton virtCheckingAcc amount,
145 labels =
146 fromList
147 [ IbanLabel AccountTag ==> base.account,
148 TextLabel CounterpartyNameTag ==> counterpartyName,
149 IbanLabel CounterpartyIbanTag ==> counterpartyIban,
150 TextLabel DescTag ==> description
151 ]
152 `union` (maybe empty (singleton TimestampLabel . Identity) mtimestamp)
153 }
154 RecurrentDirectDebit
155 { counterpartyName,
156 counterpartyIban,
157 description,
158 reference,
159 mandateId,
160 creditorId,
161 otherParty
162 } ->
163 return $
164 L.Tx
165 { cleared = Just base.date,
166 commodityId = eucId,
167 credit = M.singleton virtCheckingAcc amount,
168 debit = M.singleton virtCounterparty amount,
169 labels =
170 fromList
171 [ IbanLabel AccountTag ==> base.account,
172 IbanLabel CounterpartyIbanTag ==> counterpartyIban,
173 TextLabel CounterpartyNameTag ==> counterpartyName,
174 TextLabel DescTag ==> description,
175 TextLabel ReferenceTag ==> reference,
176 TextLabel MandateIdTag ==> mandateId,
177 TextLabel CreditorIdTag ==> creditorId
178 ]
179 `union` (maybe empty (singleton (TextLabel OtherPartyTag) . Identity) otherParty)
180 }
181 RoundingSavingsDeposit
182 { savingsAccount
183 } ->
184 return $
185 L.Tx
186 { cleared = Just base.date,
187 commodityId = eucId,
188 credit = M.singleton virtCheckingAcc amount,
189 debit = M.singleton virtSavingsAcc amount,
190 labels =
191 fromList
192 [ UnitLabel AutoRoundSavingsTag ==> (),
193 TextLabel SavingsAccountTag ==> savingsAccount
194 ]
195 }
196 DepositTransfer
197 { counterpartyName,
198 counterpartyIban,
199 description,
200 reference
201 } ->
202 return $
203 L.Tx
204 { cleared = Just base.date,
205 commodityId = eucId,
206 debit = M.singleton virtCheckingAcc amount,
207 credit = M.singleton virtCounterparty amount,
208 labels =
209 fromList
210 [ IbanLabel CounterpartyIbanTag ==> counterpartyIban,
211 TextLabel CounterpartyNameTag ==> counterpartyName,
212 TextLabel DescTag ==> description,
213 TextLabel ReferenceTag ==> reference
214 ]
215 }
216 IdealDebit
217 { counterpartyName,
218 counterpartyIban,
219 description,
220 timestamp,
221 reference
222 } ->
223 return $
224 L.Tx
225 { cleared = Just base.date,
226 commodityId = eucId,
227 debit = M.singleton virtCheckingAcc amount,
228 credit = M.singleton virtCounterparty amount,
229 labels =
230 fromList
231 [ IbanLabel CounterpartyIbanTag ==> counterpartyIban,
232 TextLabel CounterpartyNameTag ==> counterpartyName,
233 TextLabel DescTag ==> description,
234 TextLabel ReferenceTag ==> reference,
235 TimestampLabel ==> timestamp
236 ]
237 }
238 BatchPayment
239 { counterpartyName,
240 counterpartyIban,
241 description,
242 reference
243 } ->
244 return $
245 L.Tx
246 { cleared = Just base.date,
247 commodityId = eucId,
248 debit = M.singleton virtCheckingAcc amount,
249 credit = M.singleton virtCounterparty amount,
250 labels =
251 fromList
252 [ IbanLabel CounterpartyIbanTag ==> counterpartyIban,
253 TextLabel CounterpartyNameTag ==> counterpartyName,
254 TextLabel DescTag ==> description,
255 TextLabel ReferenceTag ==> reference
256 ]
257 }
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 @@
1{-# LANGUAGE OverloadedLists #-}
2{-# LANGUAGE OverloadedStrings #-}
3
4module Import.Ing.CurrentAccountCsv where
5
6import Control.Applicative ((<|>))
7import Control.Monad (when)
8import Data.ByteString.Lazy qualified as BS
9import Data.Csv ((.:))
10import Data.Csv qualified as C
11import Data.Decimal (Decimal)
12import Data.Generics.Product.Subtype (upcast)
13import Data.Iban (Iban)
14import Data.Res (Res (Err, Ok))
15import Data.Text qualified as T
16import Data.Time.Calendar (Day)
17import Data.Time.Clock (UTCTime)
18import Data.Time.Zones (TZ, loadTZFromDB)
19import Data.Vector qualified as V
20import GHC.Generics
21import Import.Ing.Shared
22 ( DebitCredit (Credit, Debit),
23 maybeCP,
24 parseDateM,
25 parseDecimalM,
26 parseIbanM,
27 parseTimestampM,
28 scsvOptions,
29 )
30import System.IO (Handle)
31import Text.Regex.TDFA ((=~~))
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
104data TransactionType
105 = AcceptGiroType -- AC (acceptgiro)
106 | AtmWithdrawalType -- GM (geldautomaat, Giromaat)
107 | BatchPaymentType -- VZ (verzamelbetaling); 'Batch payment'
108 | BranchPostingType -- FL (filiaalboeking)
109 | DepositType -- ST (storting)
110 | DirectDebitType -- IC (incasso); 'SEPA direct debit'
111 | IdealType -- ID (iDEAL); 'iDEAL'
112 | OnlineBankingType -- GT (internetbankieren, Girotel); 'Online Banking'
113 | OfficeWithdrawalType -- PK (opname kantoor, postkantoor)
114 | PaymentTerminalType -- BA (betaalautomaat); 'Payment terminal'
115 | PeriodicTransferType -- PO (periodieke overschrijving)
116 | PhoneBankingType -- GF (telefonisch bankieren, Girofoon)
117 | TransferType -- OV (overboeking); 'Transfer'
118 | VariousType -- DV (diversen)
119 deriving (Eq, Show)
120
121parseCode :: T.Text -> C.Parser TransactionType
122parseCode "AC" = return AcceptGiroType
123parseCode "GM" = return AtmWithdrawalType
124parseCode "VZ" = return BatchPaymentType
125parseCode "FL" = return BranchPostingType
126parseCode "ST" = return DepositType
127parseCode "IC" = return DirectDebitType
128parseCode "ID" = return IdealType
129parseCode "GT" = return OnlineBankingType
130parseCode "PK" = return OfficeWithdrawalType
131parseCode "BA" = return PaymentTerminalType
132parseCode "PO" = return PeriodicTransferType
133parseCode "GF" = return PhoneBankingType
134parseCode "OV" = return TransferType
135parseCode "DV" = return VariousType
136parseCode t = fail $ "Unknown transaction code '" ++ T.unpack t ++ "'"
137
138parseType :: T.Text -> C.Parser TransactionType
139parseType "SEPA direct debit" = return DirectDebitType
140parseType "Batch payment" = return BatchPaymentType
141parseType "Online Banking" = return OnlineBankingType
142parseType "Payment terminal" = return PaymentTerminalType
143parseType "Transfer" = return TransferType
144parseType "iDEAL" = return IdealType
145parseType t = fail $ "Unknown transaction type '" ++ T.unpack t ++ "'"
146
147data PrimTx = PrimTx
148 { date :: !Day,
149 description :: !T.Text,
150 account :: !Iban,
151 counterparty :: !(Maybe Iban),
152 transactionType :: !TransactionType,
153 debitCredit :: !DebitCredit,
154 amount :: !Decimal,
155 notifications :: !T.Text,
156 resBal :: !Decimal,
157 tag :: !T.Text
158 }
159 deriving (Show, Generic)
160
161debitCreditCP :: T.Text -> C.Parser DebitCredit
162debitCreditCP "Debit" = return Debit
163debitCreditCP "Credit" = return Credit
164debitCreditCP t = fail ("Unknown debit/credit value '" ++ T.unpack t ++ "'")
165
166instance C.FromNamedRecord PrimTx where
167 parseNamedRecord m = do
168 code <- m .: "Code" >>= parseCode
169 txType <- m .: "Transaction type" >>= parseType
170 if code /= txType
171 then fail "Expected code and transaction type to agree"
172 else
173 PrimTx
174 <$> (m .: "Date" >>= parseDateM "%0Y%m%d")
175 <*> m .: "Name / Description"
176 <*> (m .: "Account" >>= parseIbanM)
177 <*> (m .: "Counterparty" >>= maybeCP parseIbanM)
178 <*> return txType
179 <*> (m .: "Debit/credit" >>= debitCreditCP)
180 <*> (m .: "Amount (EUR)" >>= parseDecimalM)
181 <*> m .: "Notifications"
182 <*> (m .: "Resulting balance" >>= parseDecimalM)
183 <*> m .: "Tag"
184
185processPrimTx :: TZ -> PrimTx -> Res String Tx
186processPrimTx amsTz ptx = Tx (txBaseFromPrim ptx) <$> specificsFromPrim amsTz ptx
187
188parseValueDate :: T.Text -> Res String Day
189parseValueDate = parseDateM "%d/%m/%Y"
190
191assertValueDate :: Day -> T.Text -> Res String ()
192assertValueDate expected t = do
193 valDate <- parseDateM "%d/%m/%Y" t
194 when (valDate /= expected) $
195 fail "Expected transaction date and value date to be the same"
196
197assertValueDatePtx :: PrimTx -> T.Text -> Res String ()
198assertValueDatePtx PrimTx {date = expected} = assertValueDate expected
199
200specificsFromPrim :: TZ -> PrimTx -> Res String TxSpecifics
201specificsFromPrim amsTz ptx@PrimTx {transactionType = PaymentTerminalType, debitCredit = Debit} = do
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
203 (_, _, _, [cardSeqNo, timestampTxt, transaction, _, gpayTerm, noGpayTerm, valDateTxt]) <-
204 ptx.notifications =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
205 assertValueDatePtx ptx valDateTxt
206 timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt
207 return $
208 PaymentTerminalPayment
209 { counterpartyName = ptx.description,
210 cardSequenceNo = cardSeqNo,
211 timestamp = timestamp,
212 transaction = transaction,
213 terminal = if T.null gpayTerm then noGpayTerm else gpayTerm,
214 googlePay = T.null noGpayTerm
215 }
216specificsFromPrim amsTz ptx@PrimTx {transactionType = PaymentTerminalType, debitCredit = Credit} = do
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
218 (_, _, _, [cardSeqNo, timestampTxt, transaction, term, valDateTxt]) <-
219 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
220 assertValueDatePtx ptx valDateTxt
221 timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt
222 return $
223 PaymentTerminalCashback
224 { counterpartyName = ptx.description,
225 cardSequenceNo = cardSeqNo,
226 timestamp = timestamp,
227 transaction = transaction,
228 terminal = term
229 }
230specificsFromPrim amsTz ptx@PrimTx {transactionType = OnlineBankingType, debitCredit = Credit} = do
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
232 (_, _, _, [name, desc, ibanTxt, timestampTxt, valDateTxt]) <-
233 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
234 assertValueDatePtx ptx valDateTxt
235 iban <- parseIbanM ibanTxt
236 timestamp <- parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt
237 when (name /= ptx.description) $
238 fail "Expected counterparty name for online banking credit to match primitive description"
239 when (Just iban /= ptx.counterparty) $
240 fail "Expected IBAN for online banking credit to match and primitive counterparty IBAN"
241 return $
242 OnlineBankingCredit
243 { counterpartyName = name,
244 counterpartyIban = iban,
245 description = desc,
246 timestamp = timestamp
247 }
248specificsFromPrim amsTz ptx@PrimTx {transactionType = OnlineBankingType, debitCredit = Debit} = do
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
250 (_, _, _, [name, desc, ibanTxt, _, timestampTxt, valDateTxt]) <-
251 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
252 assertValueDatePtx ptx valDateTxt
253 iban <- parseIbanM ibanTxt
254 timestamp <-
255 if T.null timestampTxt
256 then pure Nothing
257 else Just <$> parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt
258 when (name /= ptx.description) $
259 fail "Expected counterparty name for online banking debit to match primitive description"
260 when (Just iban /= ptx.counterparty) $
261 fail "Expected IBAN for online banking debit to match and primitive counterparty IBAN"
262 return $
263 OnlineBankingDebit
264 { counterpartyIban = iban,
265 counterpartyName = name,
266 description = desc,
267 mtimestamp = timestamp
268 }
269specificsFromPrim _ ptx@PrimTx {transactionType = DirectDebitType, debitCredit = Debit} =
270 normalRecurrentDirectDebit <|> ingInsurancePayment
271 where
272 normalRecurrentDirectDebit = do
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
274 (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId, _, otherParty, valDateTxt]) <-
275 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
276 assertValueDatePtx ptx valDateTxt
277 iban <- parseIbanM ibanTxt
278 when (name /= ptx.description) $
279 fail "Expected counterparty name for direct debit to match primitive description"
280 when (Just iban /= ptx.counterparty) $
281 fail "Expected IBAN for direct debit to match and primitive counterparty IBAN"
282 return $
283 RecurrentDirectDebit
284 { counterpartyName = name,
285 counterpartyIban = iban,
286 description = desc,
287 reference = ref,
288 mandateId = mandateId,
289 creditorId = creditorId,
290 otherParty = if T.null otherParty then Nothing else Just otherParty
291 }
292 ingInsurancePayment = do
293 let regex = "^Name: (.* ING Verzekeren) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit$" :: String
294 (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId]) <-
295 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
296 iban <- parseIbanM ibanTxt
297 when (name /= ptx.description) $
298 fail "Expected counterparty name for direct debit to match primitive description"
299 when (Just iban /= ptx.counterparty) $
300 fail "Expected IBAN for direct debit to match and primitive counterparty IBAN"
301 return $
302 RecurrentDirectDebit
303 { counterpartyName = name,
304 counterpartyIban = iban,
305 description = desc,
306 reference = ref,
307 mandateId = mandateId,
308 creditorId = creditorId,
309 otherParty = Nothing
310 }
311specificsFromPrim _ ptx@PrimTx {transactionType = TransferType, debitCredit = Credit} = do
312 let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
313 (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <-
314 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
315 assertValueDatePtx ptx valDateTxt
316 iban <- parseIbanM ibanTxt
317 when (name /= ptx.description) $
318 fail "Expected counterparty name for deposit transfer to match primitive description"
319 when (Just iban /= ptx.counterparty) $
320 fail "Expected IBAN for deposit transfer to match and primitive counterparty IBAN"
321 return $
322 DepositTransfer
323 { counterpartyName = name,
324 counterpartyIban = iban,
325 description = desc,
326 reference = ref
327 }
328specificsFromPrim _ ptx@PrimTx {transactionType = TransferType, debitCredit = Debit} = do
329 let regex = "^To Oranje spaarrekening ([A-Z0-9]+) Afronding Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
330 (_, _, _, [savingsAccount, valDateTxt]) <-
331 ptx.notifications =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
332 assertValueDatePtx ptx valDateTxt
333 return $ RoundingSavingsDeposit {savingsAccount = savingsAccount}
334specificsFromPrim amsTz ptx@PrimTx {transactionType = IdealType, debitCredit = Debit} = do
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
336 (_, _, _, [name, desc, ibanTxt, timestampTxt, ref, valDateTxt]) <-
337 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
338 assertValueDatePtx ptx valDateTxt
339 timestamp <- parseTimestampM "%d-%m-%Y %H:%M" amsTz timestampTxt
340 iban <- parseIbanM ibanTxt
341 when (name /= ptx.description) $
342 fail "Expected counterparty name for iDEAL payment to match primitive description"
343 when (Just iban /= ptx.counterparty) $
344 fail "Expected IBAN for iDEAL payment to match and primitive counterparty IBAN"
345 return $
346 IdealDebit
347 { counterpartyName = name,
348 counterpartyIban = iban,
349 description = desc,
350 timestamp = timestamp,
351 reference = ref
352 }
353specificsFromPrim _ ptx@PrimTx {transactionType = BatchPaymentType, debitCredit = Credit} = do
354 let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
355 (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <-
356 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
357 assertValueDatePtx ptx valDateTxt
358 iban <- parseIbanM ibanTxt
359 when (name /= ptx.description) $
360 fail "Expected counterparty name for batch payment to match primitive description"
361 when (Just iban /= ptx.counterparty) $
362 fail "Expected IBAN for batch payment to match and primitive counterparty IBAN"
363 return $
364 BatchPayment
365 { counterpartyName = name,
366 counterpartyIban = iban,
367 description = desc,
368 reference = ref
369 }
370specificsFromPrim _ ptx =
371 fail $
372 "Could not extract data from transaction ("
373 ++ show (transactionType ptx)
374 ++ " / "
375 ++ show (debitCredit ptx)
376 ++ ")"
377
378txBaseFromPrim :: PrimTx -> TxBase
379txBaseFromPrim = upcast
380
381readFile :: Handle -> IO (V.Vector Tx)
382readFile h = do
383 tz <- loadTZFromDB "Europe/Amsterdam"
384 contents <- BS.hGetContents h
385 primTxs <- case C.decodeByNameWith scsvOptions contents of
386 Left err -> fail err
387 Right
388 ( [ "Date",
389 "Name / Description",
390 "Account",
391 "Counterparty",
392 "Code",
393 "Debit/credit",
394 "Amount (EUR)",
395 "Transaction type",
396 "Notifications",
397 "Resulting balance",
398 "Tag"
399 ],
400 txs
401 ) ->
402 return txs
403 Right _ ->
404 fail "Headers do not match expected pattern"
405 case V.mapM (processPrimTx tz) primTxs of
406 Err err -> fail err
407 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 @@
1{-# LANGUAGE OverloadedLists #-}
2{-# LANGUAGE OverloadedStrings #-}
3
4module Import.Ing.SavingsAccountCsv where
5
6import Data.ByteString.Lazy qualified as BS
7import Data.Csv ((.:))
8import Data.Csv qualified as C
9import Data.Decimal (Decimal)
10import Data.Iban (Iban, mkIban)
11import Data.Maybe (isJust)
12import Data.Text qualified as T
13import Data.Time.Calendar (Day)
14import Data.Vector qualified as V
15import Import.Ing.Shared (maybeCP, parseDateM, parseDecimalM, parseIbanM, scsvOptions)
16import System.IO (Handle)
17import Text.Regex.TDFA ((=~~))
18
19data DebitCredit = Debit | Credit deriving (Show, Eq)
20
21data MutationType = DepositMutation | WithdrawalMutation | InterestMutation deriving (Show)
22
23data TxBase = TxBase
24 { txbDate :: !Day,
25 txbAccountId :: !T.Text,
26 txbAccountName :: !T.Text,
27 txbAmount :: !Decimal,
28 txbResBal :: !Decimal
29 }
30 deriving (Show)
31
32data TxSpecifics
33 = Interest
34 | Withdrawal
35 { wToCurrentAccountIban :: !Iban,
36 wDescription :: !T.Text
37 }
38 | Deposit
39 { dFromCurrentAccountIban :: !Iban,
40 dDescription :: !T.Text
41 }
42 | CurrentAccountAutoSaveRounding {caasFromCurrentAccountIban :: !Iban}
43 deriving (Show)
44
45data Tx = Tx TxBase TxSpecifics deriving (Show)
46
47instance MonadFail (Either String) where
48 fail = Left
49
50txBaseFromPrim :: PrimTx -> Either String TxBase
51txBaseFromPrim ptx@PrimTx {ptxCommodity = "EUR"} =
52 return $ TxBase <$> ptxDate <*> ptxAccountId <*> ptxAccountName <*> ptxAmount <*> ptxResBal $ ptx
53txBaseFromPrim ptx =
54 Left $ "Unexpected commodity '" ++ T.unpack (ptxCommodity ptx) ++ "' (expected EUR)"
55
56specificsFromPrim :: PrimTx -> Either String TxSpecifics
57specificsFromPrim ptx@PrimTx {ptxMutationType = InterestMutation}
58 | isJust (ptxCounterparty ptx) = Left "Expected no counterparty for interest transaction"
59 | ptxDebitCredit ptx /= Credit =
60 Left "Expected interest transaction to be of credit ('Bij') type, got debit ('Af')"
61 | not (T.null (ptxNotifications ptx)) =
62 Left "Expected no notifications for interest transaction"
63 | ptxDescription ptx /= "Rente" =
64 Left $ "Expected interest transaction to have description 'Rente', got '" ++ T.unpack (ptxDescription ptx) ++ "'"
65 | otherwise = return Interest
66specificsFromPrim ptx@PrimTx {ptxMutationType = WithdrawalMutation} = do
67 let regex = "Overboeking naar betaalrekening (.*)" :: String
68 (_, _, _, [ibanTxt]) <- ptxDescription ptx =~~ regex :: Either String (T.Text, T.Text, T.Text, [T.Text])
69 iban <- mkIban ibanTxt
70 case ptxCounterparty ptx of
71 Nothing -> Left "Expected counterparty for withdrawal transaction"
72 Just cpIban ->
73 if cpIban /= iban
74 then Left "Expected counterparty and IBAN in description to be equal"
75 else return $ Withdrawal {wToCurrentAccountIban = iban, wDescription = ptxNotifications ptx}
76specificsFromPrim ptx@PrimTx {ptxMutationType = DepositMutation} = do
77 let regex = "(Afronding|Overboeking) van betaalrekening (.*)" :: String
78 (_, _, _, [ty, ibanTxt]) <- ptxDescription ptx =~~ regex :: Either String (T.Text, T.Text, T.Text, [T.Text])
79 iban <- mkIban ibanTxt
80 case ptxCounterparty ptx of
81 Nothing -> Left "Expected counterparty for deposit transaction"
82 Just cpIban ->
83 if cpIban /= iban
84 then Left "Expected counterparty and IBAN in description to be equal"
85 else case ty of
86 "Afronding" ->
87 if not (T.null (ptxNotifications ptx))
88 then
89 Left "Expected no notifications for auto-save rounding transaction"
90 else return $ CurrentAccountAutoSaveRounding {caasFromCurrentAccountIban = iban}
91 "Overboeking" ->
92 return $ Deposit {dFromCurrentAccountIban = iban, dDescription = ptxNotifications ptx}
93 _ -> error "unreachable"
94
95processPrimTx :: PrimTx -> Either String Tx
96processPrimTx ptx = Tx <$> txBaseFromPrim ptx <*> specificsFromPrim ptx
97
98data PrimTx = PrimTx
99 { ptxDate :: !Day,
100 ptxDescription :: !T.Text,
101 ptxAccountId :: !T.Text,
102 ptxAccountName :: !T.Text,
103 ptxCounterparty :: !(Maybe Iban),
104 ptxDebitCredit :: !DebitCredit,
105 ptxAmount :: !Decimal,
106 ptxCommodity :: !T.Text,
107 ptxMutationType :: !MutationType,
108 ptxNotifications :: !T.Text,
109 ptxResBal :: !Decimal
110 }
111 deriving (Show)
112
113debitCreditCP :: T.Text -> C.Parser DebitCredit
114debitCreditCP "Af" = return Debit
115debitCreditCP "Bij" = return Credit
116debitCreditCP t = fail ("Unknown debit/credit value '" ++ T.unpack t ++ "'")
117
118mutationTypeCP :: T.Text -> C.Parser MutationType
119mutationTypeCP "Inleg" = return DepositMutation
120mutationTypeCP "Opname" = return WithdrawalMutation
121mutationTypeCP "Rente" = return InterestMutation
122mutationTypeCP t = fail ("Unknown mutation type '" ++ T.unpack t ++ "'")
123
124instance C.FromNamedRecord PrimTx where
125 parseNamedRecord m =
126 PrimTx
127 <$> (m .: "Datum" >>= parseDateM "%Y-%m-%d")
128 <*> m .: "Omschrijving"
129 <*> m .: "Rekening"
130 <*> m .: "Rekening naam"
131 <*> (m .: "Tegenrekening" >>= maybeCP parseIbanM)
132 <*> (m .: "Af Bij" >>= debitCreditCP)
133 <*> (m .: "Bedrag" >>= parseDecimalM)
134 <*> m .: "Valuta"
135 <*> (m .: "Mutatiesoort" >>= mutationTypeCP)
136 <*> m .: "Mededelingen"
137 <*> (m .: "Saldo na mutatie" >>= parseDecimalM)
138
139readFile :: Handle -> IO (V.Vector Tx)
140readFile h = do
141 contents <- BS.hGetContents h
142 primTxs <- case C.decodeByNameWith scsvOptions contents of
143 Left err -> fail err
144 Right
145 ( [ "Datum",
146 "Omschrijving",
147 "Rekening",
148 "Rekening naam",
149 "Tegenrekening",
150 "Af Bij",
151 "Bedrag",
152 "Valuta",
153 "Mutatiesoort",
154 "Mededelingen",
155 "Saldo na mutatie"
156 ],
157 txs
158 ) ->
159 return txs
160 Right _ ->
161 fail "Headers do not match expected pattern"
162 case V.mapM processPrimTx primTxs of
163 Left err -> fail err
164 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 @@
1module Import.Ing.Shared where
2
3import Data.Attoparsec.Text qualified as AP
4import Data.Char (digitToInt, ord)
5import Data.Csv qualified as C
6import Data.Decimal (Decimal, DecimalRaw (Decimal), normalizeDecimal)
7import Data.Iban (Iban, mkIban)
8import Data.Text qualified as T
9import Data.Time.Calendar (Day)
10import Data.Time.Clock (UTCTime)
11import Data.Time.Format (defaultTimeLocale, parseTimeM)
12import Data.Time.Zones (TZ, localTimeToUTCTZ)
13
14data DebitCredit = Debit | Credit deriving (Show)
15
16scsvOptions :: C.DecodeOptions
17scsvOptions = C.defaultDecodeOptions {C.decDelimiter = fromIntegral (ord ';')}
18
19maybeCP :: (T.Text -> C.Parser a) -> T.Text -> C.Parser (Maybe a)
20maybeCP p t = if T.null t then return Nothing else Just <$> p t
21
22parseDecimalM :: (MonadFail m) => T.Text -> m Decimal
23parseDecimalM =
24 either fail return
25 . AP.parseOnly
26 ( do
27 decPart <- AP.decimal
28 _ <- AP.char ','
29 f1 <- AP.digit
30 f2 <- AP.digit
31 AP.endOfInput
32 let fracPart = fromIntegral $ digitToInt f1 * 10 + digitToInt f2
33 return $ normalizeDecimal (Decimal 2 (decPart * 100 + fracPart))
34 )
35
36parseIbanM :: (MonadFail m) => T.Text -> m Iban
37parseIbanM = either fail return . mkIban
38
39parseDateM :: (MonadFail m) => String -> T.Text -> m Day
40parseDateM fmt = parseTimeM False defaultTimeLocale fmt . T.unpack
41
42parseTimestampM :: (MonadFail m) => String -> TZ -> T.Text -> m UTCTime
43parseTimestampM fmt amsTz t = do
44 localTimeToUTCTZ amsTz <$> parseTimeM False defaultTimeLocale fmt (T.unpack t)
generated by cgit v1.2.3 (git 2.49.0) at 2025-12-25 04:44:56 +0000