summaryrefslogtreecommitdiffstats
path: root/app
diff options
context:
space:
mode:
authorRutger Broekhoff2025-03-22 14:53:56 +0100
committerRutger Broekhoff2025-03-22 14:53:56 +0100
commit6b27332df29a294167fe4f5b91e2fa0a8f96c665 (patch)
tree924a7aaa9ca290f257c73221f13dd0b539d34363 /app
parent5493329b2eed7e151f4a323c108caad2253b08bb (diff)
downloadrdcapsis-6b27332df29a294167fe4f5b91e2fa0a8f96c665.tar.gz
rdcapsis-6b27332df29a294167fe4f5b91e2fa0a8f96c665.zip
Get rid of older current account statement parser
Diffstat (limited to 'app')
-rw-r--r--app/Data/Res.hs4
-rw-r--r--app/Import/Ing/CurrentAccountCsv.hs513
-rw-r--r--app/Import/Ing/CurrentAccountCsv2.hs411
-rw-r--r--app/Main.hs3
4 files changed, 287 insertions, 644 deletions
diff --git a/app/Data/Res.hs b/app/Data/Res.hs
index e8c4ca4..3806e5a 100644
--- a/app/Data/Res.hs
+++ b/app/Data/Res.hs
@@ -19,10 +19,10 @@ instance Monad (Res e) where
19 (Ok v) >>= f = f v 19 (Ok v) >>= f = f v
20 (Err e) >>= _ = Err e 20 (Err e) >>= _ = Err e
21 21
22instance IsString e => MonadFail (Res e) where 22instance (IsString e) => MonadFail (Res e) where
23 fail = Err . fromString 23 fail = Err . fromString
24 24
25instance IsString e => Alternative (Res e) where 25instance (IsString e) => Alternative (Res e) where
26 empty = fail "mzero" 26 empty = fail "mzero"
27 m1@(Ok _) <|> _ = m1 27 m1@(Ok _) <|> _ = m1
28 (Err _) <|> m2 = m2 28 (Err _) <|> m2 = m2
diff --git a/app/Import/Ing/CurrentAccountCsv.hs b/app/Import/Ing/CurrentAccountCsv.hs
index 1456be1..d17221d 100644
--- a/app/Import/Ing/CurrentAccountCsv.hs
+++ b/app/Import/Ing/CurrentAccountCsv.hs
@@ -4,12 +4,13 @@
4module Import.Ing.CurrentAccountCsv where 4module Import.Ing.CurrentAccountCsv where
5 5
6import Control.Applicative ((<|>)) 6import Control.Applicative ((<|>))
7import Control.Monad (when)
7import Data.ByteString.Lazy qualified as BS 8import Data.ByteString.Lazy qualified as BS
8import Data.Csv ((.:)) 9import Data.Csv ((.:))
9import Data.Csv qualified as C 10import Data.Csv qualified as C
10import Data.Decimal (Decimal) 11import Data.Decimal (Decimal)
11import Data.Functor ((<&>))
12import Data.Iban (Iban) 12import Data.Iban (Iban)
13import Data.Res (Res (Err, Ok))
13import Data.Text qualified as T 14import Data.Text qualified as T
14import Data.Time.Calendar (Day) 15import Data.Time.Calendar (Day)
15import Data.Time.Clock (UTCTime) 16import Data.Time.Clock (UTCTime)
@@ -28,313 +29,364 @@ import System.IO (Handle)
28import Text.Regex.TDFA ((=~~)) 29import Text.Regex.TDFA ((=~~))
29 30
30data TransactionType 31data TransactionType
31 = AcceptGiro -- AC (acceptgiro) 32 = AcceptGiroType -- AC (acceptgiro)
32 | AtmWithdrawal -- GM (geldautomaat, Giromaat) 33 | AtmWithdrawalType -- GM (geldautomaat, Giromaat)
33 | BatchPayment -- VZ (verzamelbetaling); 'Batch payment' 34 | BatchPaymentType -- VZ (verzamelbetaling); 'Batch payment'
34 | BranchPosting -- FL (filiaalboeking) 35 | BranchPostingType -- FL (filiaalboeking)
35 | Deposit -- ST (storting) 36 | DepositType -- ST (storting)
36 | DirectDebit -- IC (incasso); 'SEPA direct debit' 37 | DirectDebitType -- IC (incasso); 'SEPA direct debit'
37 | Ideal -- ID (iDEAL); 'iDEAL' 38 | IdealType -- ID (iDEAL); 'iDEAL'
38 | OnlineBanking -- GT (internetbankieren, Girotel); 'Online Banking' 39 | OnlineBankingType -- GT (internetbankieren, Girotel); 'Online Banking'
39 | OfficeWithdrawal -- PK (opname kantoor, postkantoor) 40 | OfficeWithdrawalType -- PK (opname kantoor, postkantoor)
40 | PaymentTerminal -- BA (betaalautomaat); 'Payment terminal' 41 | PaymentTerminalType -- BA (betaalautomaat); 'Payment terminal'
41 | PeriodicTransfer -- PO (periodieke overschrijving) 42 | PeriodicTransferType -- PO (periodieke overschrijving)
42 | PhoneBanking -- GF (telefonisch bankieren, Girofoon) 43 | PhoneBankingType -- GF (telefonisch bankieren, Girofoon)
43 | Transfer -- OV (overboeking); 'Transfer' 44 | TransferType -- OV (overboeking); 'Transfer'
44 | Various -- DV (diversen) 45 | VariousType -- DV (diversen)
45 deriving (Eq, Show) 46 deriving (Eq, Show)
46 47
47parseCode :: T.Text -> C.Parser TransactionType 48parseCode :: T.Text -> C.Parser TransactionType
48parseCode "AC" = return AcceptGiro 49parseCode "AC" = return AcceptGiroType
49parseCode "GM" = return AtmWithdrawal 50parseCode "GM" = return AtmWithdrawalType
50parseCode "VZ" = return BatchPayment 51parseCode "VZ" = return BatchPaymentType
51parseCode "FL" = return BranchPosting 52parseCode "FL" = return BranchPostingType
52parseCode "ST" = return Deposit 53parseCode "ST" = return DepositType
53parseCode "IC" = return DirectDebit 54parseCode "IC" = return DirectDebitType
54parseCode "ID" = return Ideal 55parseCode "ID" = return IdealType
55parseCode "GT" = return OnlineBanking 56parseCode "GT" = return OnlineBankingType
56parseCode "PK" = return OfficeWithdrawal 57parseCode "PK" = return OfficeWithdrawalType
57parseCode "BA" = return PaymentTerminal 58parseCode "BA" = return PaymentTerminalType
58parseCode "PO" = return PeriodicTransfer 59parseCode "PO" = return PeriodicTransferType
59parseCode "GF" = return PhoneBanking 60parseCode "GF" = return PhoneBankingType
60parseCode "OV" = return Transfer 61parseCode "OV" = return TransferType
61parseCode "DV" = return Various 62parseCode "DV" = return VariousType
62parseCode t = fail $ "Unknown transaction code '" ++ T.unpack t ++ "'" 63parseCode t = fail $ "Unknown transaction code '" ++ T.unpack t ++ "'"
63 64
64parseType :: T.Text -> C.Parser TransactionType 65parseType :: T.Text -> C.Parser TransactionType
65parseType "SEPA direct debit" = return DirectDebit 66parseType "SEPA direct debit" = return DirectDebitType
66parseType "Batch payment" = return BatchPayment 67parseType "Batch payment" = return BatchPaymentType
67parseType "Online Banking" = return OnlineBanking 68parseType "Online Banking" = return OnlineBankingType
68parseType "Payment terminal" = return PaymentTerminal 69parseType "Payment terminal" = return PaymentTerminalType
69parseType "Transfer" = return Transfer 70parseType "Transfer" = return TransferType
70parseType "iDEAL" = return Ideal 71parseType "iDEAL" = return IdealType
71parseType t = fail $ "Unknown transaction type '" ++ T.unpack t ++ "'" 72parseType t = fail $ "Unknown transaction type '" ++ T.unpack t ++ "'"
72 73
73data PrimTx = PrimTx 74data PrimTx = PrimTx
74 { ptDate :: !Day, 75 { ptxDate :: !Day,
75 ptDesc :: !(Maybe T.Text), 76 ptxDescription :: !T.Text,
76 ptAccount :: !Iban, 77 ptxAccount :: !Iban,
77 ptCounterparty :: !(Maybe Iban), 78 ptxCounterparty :: !(Maybe Iban),
78 ptDebitCredit :: !DebitCredit, 79 ptxTransactionType :: !TransactionType,
79 ptAmount :: !Decimal, 80 ptxDebitCredit :: !DebitCredit,
80 ptResBal :: !Decimal, 81 ptxAmount :: !Decimal,
81 ptTag :: !T.Text, 82 ptxNotifications :: !T.Text,
82 ptMoreData :: !MoreData 83 ptxResBal :: !Decimal,
84 ptxTag :: !T.Text
83 } 85 }
84 deriving (Show) 86 deriving (Show)
85 87
86data MoreData 88debitCreditCP :: T.Text -> C.Parser DebitCredit
87 = PaymentTerminalData 89debitCreditCP "Debit" = return Debit
88 { ptCardSequenceNo :: !T.Text, 90debitCreditCP "Credit" = return Credit
89 ptTimestamp :: !UTCTime, 91debitCreditCP t = fail ("Unknown debit/credit value '" ++ T.unpack t ++ "'")
90 ptTransaction :: !T.Text,
91 ptTerminal :: !T.Text,
92 ptValueDate :: !Day,
93 ptGooglePay :: !Bool
94 }
95 | DepositTransferData
96 { dtName :: !T.Text,
97 dtDescription :: !T.Text,
98 dtIban :: !Iban,
99 dtReference :: !T.Text,
100 dtValueDate :: !Day
101 }
102 | RoundingSavingsDeposit
103 { rsdSavingsAccount :: !T.Text,
104 rsdValueDate :: !Day
105 }
106 | OnlineBankingCredit
107 { obcName :: !T.Text,
108 obcDescription :: !T.Text,
109 obcIban :: !Iban,
110 obcTimestamp :: !UTCTime,
111 obcValueDate :: !Day
112 }
113 | OnlineBankingDebit
114 { obdName :: !T.Text,
115 obdDescription :: !T.Text,
116 obdIban :: !Iban,
117 obdTimestamp :: !(Maybe UTCTime),
118 obdValueDate :: !Day
119 }
120 | RecurrentDirectDebitData
121 { rddName :: !T.Text,
122 rddDescription :: !T.Text,
123 rddIban :: !Iban,
124 rddReference :: !T.Text,
125 rddMandateId :: !T.Text,
126 rddCreditorId :: !T.Text,
127 rddOtherParty :: !(Maybe T.Text),
128 rddValueDate :: !Day
129 }
130 | IdealDebitData
131 { idName :: !T.Text,
132 idDescription :: !T.Text,
133 idIban :: !Iban,
134 idTimestamp :: !UTCTime,
135 idReference :: !T.Text,
136 idValueDate :: !Day
137 }
138 | PaymentTerminalCashbackData
139 { ptcCardSequenceNo :: !T.Text,
140 ptcTimestamp :: !UTCTime,
141 ptcTransaction :: !T.Text,
142 ptcTerminal :: !T.Text,
143 ptcValueDate :: !Day
144 }
145 | BatchPaymentData
146 { bpName :: !T.Text,
147 bpDescription :: !T.Text,
148 bpIban :: !Iban,
149 bpReference :: !T.Text,
150 bpValueDate :: !Day
151 }
152 deriving (Show)
153 92
154maybeNotProvided :: T.Text -> Maybe T.Text 93instance C.FromNamedRecord PrimTx where
155maybeNotProvided t = if t == "NOTPROVIDED" then Nothing else Just t 94 parseNamedRecord m = do
95 code <- m .: "Code" >>= parseCode
96 txType <- m .: "Transaction type" >>= parseType
97 if code /= txType
98 then fail "Expected code and transaction type to agree"
99 else
100 PrimTx
101 <$> (m .: "Date" >>= parseDateM "%0Y%m%d")
102 <*> m .: "Name / Description"
103 <*> (m .: "Account" >>= parseIbanM)
104 <*> (m .: "Counterparty" >>= maybeCP parseIbanM)
105 <*> return txType
106 <*> (m .: "Debit/credit" >>= debitCreditCP)
107 <*> (m .: "Amount (EUR)" >>= parseDecimalM)
108 <*> m .: "Notifications"
109 <*> (m .: "Resulting balance" >>= parseDecimalM)
110 <*> m .: "Tag"
156 111
157valueDateCP :: T.Text -> C.Parser Day 112processPrimTx :: TZ -> PrimTx -> Res String Tx
158valueDateCP = parseDateM "%d/%m/%Y" 113processPrimTx amsTz ptx = Tx (txBaseFromPrim ptx) <$> specificsFromPrim amsTz ptx
159 114
160data PartTx = PartTx !Day !TransactionType !DebitCredit 115parseValueDate :: T.Text -> Res String Day
116parseValueDate = parseDateM "%d/%m/%Y"
161 117
162notificationsCP :: TZ -> PartTx -> T.Text -> C.Parser MoreData 118assertValueDate :: Day -> T.Text -> Res String ()
163notificationsCP _ (PartTx _ Transfer Credit) t = do 119assertValueDate expected t = do
164 let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String 120 valDate <- parseDateM "%d/%m/%Y" t
165 (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) 121 when (valDate /= expected) $
166 iban <- parseIbanM ibanTxt 122 fail "Expected transaction date and value date to be the same"
167 valDate <- valueDateCP valDateTxt 123
168 return $ 124assertValueDatePtx :: PrimTx -> T.Text -> Res String ()
169 DepositTransferData 125assertValueDatePtx PrimTx {ptxDate = expected} = assertValueDate expected
170 { dtName = name, 126
171 dtDescription = desc, 127specificsFromPrim :: TZ -> PrimTx -> Res String TxSpecifics
172 dtIban = iban, 128specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = PaymentTerminalType, ptxDebitCredit = Debit} = do
173 dtReference = ref,
174 dtValueDate = valDate
175 }
176notificationsCP _ (PartTx _ Transfer Debit) t = do
177 let regex = "^To Oranje spaarrekening ([A-Z0-9]+) Afronding Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
178 (_, _, _, [savingsAccount, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text])
179 valDate <- valueDateCP valDateTxt
180 return $
181 RoundingSavingsDeposit
182 { rsdSavingsAccount = savingsAccount,
183 rsdValueDate = valDate
184 }
185notificationsCP amsTz (PartTx _ PaymentTerminal Debit) t = do
186 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 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
187 (_, _, _, [cardSeqNo, timestampTxt, transaction, _, gpayTerm, noGpayTerm, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) 130 (_, _, _, [cardSeqNo, timestampTxt, transaction, _, gpayTerm, noGpayTerm, valDateTxt]) <-
131 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
132 assertValueDatePtx ptx valDateTxt
188 timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt 133 timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt
189 valDate <- valueDateCP valDateTxt
190 return $ 134 return $
191 PaymentTerminalData 135 PaymentTerminalPayment
192 { ptCardSequenceNo = cardSeqNo, 136 { ptpCounterpartyName = ptxDescription ptx,
193 ptTimestamp = timestamp, 137 ptpCardSequenceNo = cardSeqNo,
194 ptTransaction = transaction, 138 ptpTimestamp = timestamp,
195 ptTerminal = if T.null gpayTerm then noGpayTerm else gpayTerm, 139 ptpTransaction = transaction,
196 ptValueDate = valDate, 140 ptpTerminal = if T.null gpayTerm then noGpayTerm else gpayTerm,
197 ptGooglePay = T.null noGpayTerm 141 ptpGooglePay = T.null noGpayTerm
198 } 142 }
199notificationsCP amsTz (PartTx _ PaymentTerminal Credit) t = do 143specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = PaymentTerminalType, ptxDebitCredit = Credit} = do
200 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 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
201 (_, _, _, [cardSeqNo, timestampTxt, transaction, term, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) 145 (_, _, _, [cardSeqNo, timestampTxt, transaction, term, valDateTxt]) <-
146 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
147 assertValueDatePtx ptx valDateTxt
202 timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt 148 timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt
203 valDate <- valueDateCP valDateTxt
204 return $ 149 return $
205 PaymentTerminalCashbackData 150 PaymentTerminalCashback
206 { ptcCardSequenceNo = cardSeqNo, 151 { ptcCounterpartyName = ptxDescription ptx,
152 ptcCardSequenceNo = cardSeqNo,
207 ptcTimestamp = timestamp, 153 ptcTimestamp = timestamp,
208 ptcTransaction = transaction, 154 ptcTransaction = transaction,
209 ptcTerminal = term, 155 ptcTerminal = term
210 ptcValueDate = valDate
211 } 156 }
212notificationsCP amsTz (PartTx _ OnlineBanking Credit) t = do 157specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = OnlineBankingType, ptxDebitCredit = Credit} = do
213 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 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
214 (_, _, _, [name, desc, ibanTxt, timestampTxt, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) 159 (_, _, _, [name, desc, ibanTxt, timestampTxt, valDateTxt]) <-
160 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
161 assertValueDatePtx ptx valDateTxt
215 iban <- parseIbanM ibanTxt 162 iban <- parseIbanM ibanTxt
216 timestamp <- parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt 163 timestamp <- parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt
217 valDate <- valueDateCP valDateTxt 164 when (name /= ptxDescription ptx) $
165 fail "Expected counterparty name for online banking credit to match primitive description"
166 when (Just iban /= ptxCounterparty ptx) $
167 fail "Expected IBAN for online banking credit to match and primitive counterparty IBAN"
218 return $ 168 return $
219 OnlineBankingCredit 169 OnlineBankingCredit
220 { obcName = name, 170 { obcCounterpartyName = name,
171 obcCounterpartyIban = iban,
221 obcDescription = desc, 172 obcDescription = desc,
222 obcIban = iban, 173 obcTimestamp = timestamp
223 obcTimestamp = timestamp,
224 obcValueDate = valDate
225 } 174 }
226notificationsCP amsTz (PartTx _ OnlineBanking Debit) t = do 175specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = OnlineBankingType, ptxDebitCredit = Debit} = do
227 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 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
228 (_, _, _, [name, desc, ibanTxt, _, timestampTxt, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) 177 (_, _, _, [name, desc, ibanTxt, _, timestampTxt, valDateTxt]) <-
178 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
179 assertValueDatePtx ptx valDateTxt
229 iban <- parseIbanM ibanTxt 180 iban <- parseIbanM ibanTxt
230 timestamp <- 181 timestamp <-
231 if T.null timestampTxt 182 if T.null timestampTxt
232 then pure Nothing 183 then pure Nothing
233 else Just <$> parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt 184 else Just <$> parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt
234 valDate <- valueDateCP valDateTxt 185 when (name /= ptxDescription ptx) $
186 fail "Expected counterparty name for online banking debit to match primitive description"
187 when (Just iban /= ptxCounterparty ptx) $
188 fail "Expected IBAN for online banking debit to match and primitive counterparty IBAN"
235 return $ 189 return $
236 OnlineBankingDebit 190 OnlineBankingDebit
237 { obdName = name, 191 { obdCounterpartyIban = iban,
192 obdCounterpartyName = name,
238 obdDescription = desc, 193 obdDescription = desc,
239 obdIban = iban, 194 obdTimestamp = timestamp
240 obdTimestamp = timestamp,
241 obdValueDate = valDate
242 } 195 }
243notificationsCP _ (PartTx date DirectDebit Debit) t = normalRecurrentDirectDebit <|> ingInsurancePayment 196specificsFromPrim _ ptx@PrimTx {ptxTransactionType = DirectDebitType, ptxDebitCredit = Debit} =
197 normalRecurrentDirectDebit <|> ingInsurancePayment
244 where 198 where
245 normalRecurrentDirectDebit = do 199 normalRecurrentDirectDebit = do
246 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 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
247 (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId, _, otherParty, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) 201 (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId, _, otherParty, valDateTxt]) <-
202 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
203 assertValueDatePtx ptx valDateTxt
248 iban <- parseIbanM ibanTxt 204 iban <- parseIbanM ibanTxt
249 valDate <- valueDateCP valDateTxt 205 when (name /= ptxDescription ptx) $
206 fail "Expected counterparty name for direct debit to match primitive description"
207 when (Just iban /= ptxCounterparty ptx) $
208 fail "Expected IBAN for direct debit to match and primitive counterparty IBAN"
250 return $ 209 return $
251 RecurrentDirectDebitData 210 RecurrentDirectDebit
252 { rddName = name, 211 { rddCounterpartyName = name,
212 rddCounterpartyIban = iban,
253 rddDescription = desc, 213 rddDescription = desc,
254 rddIban = iban,
255 rddReference = ref, 214 rddReference = ref,
256 rddMandateId = mandateId, 215 rddMandateId = mandateId,
257 rddCreditorId = creditorId, 216 rddCreditorId = creditorId,
258 rddOtherParty = if T.null otherParty then Nothing else Just otherParty, 217 rddOtherParty = if T.null otherParty then Nothing else Just otherParty
259 rddValueDate = valDate
260 } 218 }
261 ingInsurancePayment = do 219 ingInsurancePayment = do
262 let regex = "^Name: (.* ING Verzekeren) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit$" :: String 220 let regex = "^Name: (.* ING Verzekeren) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit$" :: String
263 (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) 221 (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId]) <-
222 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
264 iban <- parseIbanM ibanTxt 223 iban <- parseIbanM ibanTxt
224 when (name /= ptxDescription ptx) $
225 fail "Expected counterparty name for direct debit to match primitive description"
226 when (Just iban /= ptxCounterparty ptx) $
227 fail "Expected IBAN for direct debit to match and primitive counterparty IBAN"
265 return $ 228 return $
266 RecurrentDirectDebitData 229 RecurrentDirectDebit
267 { rddName = name, 230 { rddCounterpartyName = name,
231 rddCounterpartyIban = iban,
268 rddDescription = desc, 232 rddDescription = desc,
269 rddIban = iban,
270 rddReference = ref, 233 rddReference = ref,
271 rddMandateId = mandateId, 234 rddMandateId = mandateId,
272 rddCreditorId = creditorId, 235 rddCreditorId = creditorId,
273 rddOtherParty = Nothing, 236 rddOtherParty = Nothing
274 rddValueDate = date
275 } 237 }
276notificationsCP amsTz (PartTx _ Ideal Debit) t = do 238specificsFromPrim _ ptx@PrimTx {ptxTransactionType = TransferType, ptxDebitCredit = Credit} = do
277 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 239 let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
278 (_, _, _, [name, desc, ibanTxt, timestampTxt, ref, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) 240 (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <-
241 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
242 assertValueDatePtx ptx valDateTxt
279 iban <- parseIbanM ibanTxt 243 iban <- parseIbanM ibanTxt
244 when (name /= ptxDescription ptx) $
245 fail "Expected counterparty name for deposit transfer to match primitive description"
246 when (Just iban /= ptxCounterparty ptx) $
247 fail "Expected IBAN for deposit transfer to match and primitive counterparty IBAN"
248 return $
249 DepositTransfer
250 { dtCounterpartyName = name,
251 dtCounterpartyIban = iban,
252 dtDescription = desc,
253 dtReference = ref
254 }
255specificsFromPrim _ ptx@PrimTx {ptxTransactionType = TransferType, ptxDebitCredit = Debit} = do
256 let regex = "^To Oranje spaarrekening ([A-Z0-9]+) Afronding Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
257 (_, _, _, [savingsAccount, valDateTxt]) <-
258 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
259 assertValueDatePtx ptx valDateTxt
260 return $ RoundingSavingsDeposit {rsdSavingsAccount = savingsAccount}
261specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = IdealType, ptxDebitCredit = 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
263 (_, _, _, [name, desc, ibanTxt, timestampTxt, ref, valDateTxt]) <-
264 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
265 assertValueDatePtx ptx valDateTxt
280 timestamp <- parseTimestampM "%d-%m-%Y %H:%M" amsTz timestampTxt 266 timestamp <- parseTimestampM "%d-%m-%Y %H:%M" amsTz timestampTxt
281 valDate <- valueDateCP valDateTxt 267 iban <- parseIbanM ibanTxt
268 when (name /= ptxDescription ptx) $
269 fail "Expected counterparty name for iDEAL payment to match primitive description"
270 when (Just iban /= ptxCounterparty ptx) $
271 fail "Expected IBAN for iDEAL payment to match and primitive counterparty IBAN"
282 return $ 272 return $
283 IdealDebitData 273 IdealDebit
284 { idName = name, 274 { idCounterpartyName = name,
275 idCounterpartyIban = iban,
285 idDescription = desc, 276 idDescription = desc,
286 idIban = iban,
287 idTimestamp = timestamp, 277 idTimestamp = timestamp,
288 idReference = ref, 278 idReference = ref
289 idValueDate = valDate
290 } 279 }
291notificationsCP _ (PartTx _ BatchPayment Credit) t = do 280specificsFromPrim _ ptx@PrimTx {ptxTransactionType = BatchPaymentType, ptxDebitCredit = Credit} = do
292 let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String 281 let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
293 (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) 282 (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <-
283 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
284 assertValueDatePtx ptx valDateTxt
294 iban <- parseIbanM ibanTxt 285 iban <- parseIbanM ibanTxt
295 valDate <- valueDateCP valDateTxt 286 when (name /= ptxDescription ptx) $
287 fail "Expected counterparty name for batch payment to match primitive description"
288 when (Just iban /= ptxCounterparty ptx) $
289 fail "Expected IBAN for batch payment to match and primitive counterparty IBAN"
296 return $ 290 return $
297 BatchPaymentData 291 BatchPayment
298 { bpName = name, 292 { bpCounterpartyName = name,
293 bpCounterpartyIban = iban,
299 bpDescription = desc, 294 bpDescription = desc,
300 bpIban = iban, 295 bpReference = ref
301 bpReference = ref,
302 bpValueDate = valDate
303 } 296 }
304notificationsCP _ (PartTx _ ty cd) _ = fail $ "Unmatched type and debit/credit combination (" ++ show ty ++ ", " ++ show cd ++ ")" 297specificsFromPrim _ ptx =
298 fail $
299 "Could not extract data from transaction ("
300 ++ show (ptxTransactionType ptx)
301 ++ " / "
302 ++ show (ptxDebitCredit ptx)
303 ++ ")"
305 304
306debitCreditCP :: T.Text -> C.Parser DebitCredit 305txBaseFromPrim :: PrimTx -> TxBase
307debitCreditCP "Debit" = return Debit 306txBaseFromPrim =
308debitCreditCP "Credit" = return Credit 307 TxBase
309debitCreditCP t = fail ("Unknown debit/credit value '" ++ T.unpack t ++ "'") 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)
310 324
311parseNamedRecord :: TZ -> C.NamedRecord -> C.Parser PrimTx 325data TxSpecifics
312parseNamedRecord amsTz m = do 326 = PaymentTerminalPayment
313 date <- m .: "Date" >>= parseDateM "%0Y%m%d" 327 { ptpCounterpartyName :: !T.Text,
314 debitCredit <- m .: "Debit/credit" >>= debitCreditCP 328 ptpCardSequenceNo :: !T.Text,
315 codeText <- m .: "Code" 329 ptpTimestamp :: !UTCTime,
316 tyText <- m .: "Transaction type" 330 ptpTransaction :: !T.Text,
317 tyFromCode <- parseCode codeText 331 ptpTerminal :: !T.Text,
318 ty <- parseType tyText 332 ptpGooglePay :: !Bool
319 if ty /= tyFromCode 333 }
320 then 334 | PaymentTerminalCashback
321 fail $ "Code '" ++ T.unpack codeText ++ "' and transaction type '" ++ T.unpack tyText ++ "' do not agree" 335 { ptcCounterpartyName :: !T.Text,
322 else 336 ptcCardSequenceNo :: !T.Text,
323 PrimTx date 337 ptcTimestamp :: !UTCTime,
324 <$> (m .: "Name / Description" <&> maybeNotProvided) 338 ptcTransaction :: !T.Text,
325 <*> (m .: "Account" >>= parseIbanM) 339 ptcTerminal :: !T.Text
326 <*> (m .: "Counterparty" >>= maybeCP parseIbanM) 340 }
327 <*> pure debitCredit 341 | OnlineBankingCredit
328 <*> (m .: "Amount (EUR)" >>= parseDecimalM) 342 { obcCounterpartyName :: !T.Text,
329 <*> (m .: "Resulting balance" >>= parseDecimalM) 343 obcCounterpartyIban :: !Iban,
330 <*> m .: "Tag" 344 obcDescription :: !T.Text,
331 <*> (m .: "Notifications" >>= notificationsCP amsTz (PartTx date ty debitCredit)) 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)
332 384
333readFile :: Handle -> IO (V.Vector PrimTx) 385readFile :: Handle -> IO (V.Vector Tx)
334readFile h = do 386readFile h = do
335 tz <- loadTZFromDB "Europe/Amsterdam" 387 tz <- loadTZFromDB "Europe/Amsterdam"
336 contents <- BS.hGetContents h 388 contents <- BS.hGetContents h
337 case C.decodeByNameWithP (parseNamedRecord tz) scsvOptions contents of 389 primTxs <- case C.decodeByNameWith scsvOptions contents of
338 Left err -> fail err 390 Left err -> fail err
339 Right 391 Right
340 ( [ "Date", 392 ( [ "Date",
@@ -354,3 +406,6 @@ readFile h = do
354 return txs 406 return txs
355 Right _ -> 407 Right _ ->
356 fail "Headers do not match expected pattern" 408 fail "Headers do not match expected pattern"
409 case V.mapM (processPrimTx tz) primTxs of
410 Err err -> fail err
411 Ok txs -> return txs
diff --git a/app/Import/Ing/CurrentAccountCsv2.hs b/app/Import/Ing/CurrentAccountCsv2.hs
deleted file mode 100644
index 0a5f8af..0000000
--- a/app/Import/Ing/CurrentAccountCsv2.hs
+++ /dev/null
@@ -1,411 +0,0 @@
1{-# LANGUAGE OverloadedLists #-}
2{-# LANGUAGE OverloadedStrings #-}
3
4module Import.Ing.CurrentAccountCsv2 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.Iban (Iban)
13import Data.Res (Res (Err, Ok))
14import Data.Text qualified as T
15import Data.Time.Calendar (Day)
16import Data.Time.Clock (UTCTime)
17import Data.Time.Zones (TZ, loadTZFromDB)
18import Data.Vector qualified as V
19import Import.Ing.Shared
20 ( DebitCredit (Credit, Debit),
21 maybeCP,
22 parseDateM,
23 parseDecimalM,
24 parseIbanM,
25 parseTimestampM,
26 scsvOptions,
27 )
28import System.IO (Handle)
29import Text.Regex.TDFA ((=~~))
30
31data TransactionType
32 = AcceptGiroType -- AC (acceptgiro)
33 | AtmWithdrawalType -- GM (geldautomaat, Giromaat)
34 | BatchPaymentType -- VZ (verzamelbetaling); 'Batch payment'
35 | BranchPostingType -- FL (filiaalboeking)
36 | DepositType -- ST (storting)
37 | DirectDebitType -- IC (incasso); 'SEPA direct debit'
38 | IdealType -- ID (iDEAL); 'iDEAL'
39 | OnlineBankingType -- GT (internetbankieren, Girotel); 'Online Banking'
40 | OfficeWithdrawalType -- PK (opname kantoor, postkantoor)
41 | PaymentTerminalType -- BA (betaalautomaat); 'Payment terminal'
42 | PeriodicTransferType -- PO (periodieke overschrijving)
43 | PhoneBankingType -- GF (telefonisch bankieren, Girofoon)
44 | TransferType -- OV (overboeking); 'Transfer'
45 | VariousType -- DV (diversen)
46 deriving (Eq, Show)
47
48parseCode :: T.Text -> C.Parser TransactionType
49parseCode "AC" = return AcceptGiroType
50parseCode "GM" = return AtmWithdrawalType
51parseCode "VZ" = return BatchPaymentType
52parseCode "FL" = return BranchPostingType
53parseCode "ST" = return DepositType
54parseCode "IC" = return DirectDebitType
55parseCode "ID" = return IdealType
56parseCode "GT" = return OnlineBankingType
57parseCode "PK" = return OfficeWithdrawalType
58parseCode "BA" = return PaymentTerminalType
59parseCode "PO" = return PeriodicTransferType
60parseCode "GF" = return PhoneBankingType
61parseCode "OV" = return TransferType
62parseCode "DV" = return VariousType
63parseCode t = fail $ "Unknown transaction code '" ++ T.unpack t ++ "'"
64
65parseType :: T.Text -> C.Parser TransactionType
66parseType "SEPA direct debit" = return DirectDebitType
67parseType "Batch payment" = return BatchPaymentType
68parseType "Online Banking" = return OnlineBankingType
69parseType "Payment terminal" = return PaymentTerminalType
70parseType "Transfer" = return TransferType
71parseType "iDEAL" = return IdealType
72parseType t = fail $ "Unknown transaction type '" ++ T.unpack t ++ "'"
73
74data PrimTx = PrimTx
75 { ptxDate :: !Day,
76 ptxDescription :: !T.Text,
77 ptxAccount :: !Iban,
78 ptxCounterparty :: !(Maybe Iban),
79 ptxTransactionType :: !TransactionType,
80 ptxDebitCredit :: !DebitCredit,
81 ptxAmount :: !Decimal,
82 ptxNotifications :: !T.Text,
83 ptxResBal :: !Decimal,
84 ptxTag :: !T.Text
85 }
86 deriving (Show)
87
88debitCreditCP :: T.Text -> C.Parser DebitCredit
89debitCreditCP "Debit" = return Debit
90debitCreditCP "Credit" = return Credit
91debitCreditCP t = fail ("Unknown debit/credit value '" ++ T.unpack t ++ "'")
92
93instance C.FromNamedRecord PrimTx where
94 parseNamedRecord m = do
95 code <- m .: "Code" >>= parseCode
96 txType <- m .: "Transaction type" >>= parseType
97 if code /= txType
98 then fail "Expected code and transaction type to agree"
99 else
100 PrimTx
101 <$> (m .: "Date" >>= parseDateM "%0Y%m%d")
102 <*> m .: "Name / Description"
103 <*> (m .: "Account" >>= parseIbanM)
104 <*> (m .: "Counterparty" >>= maybeCP parseIbanM)
105 <*> return txType
106 <*> (m .: "Debit/credit" >>= debitCreditCP)
107 <*> (m .: "Amount (EUR)" >>= parseDecimalM)
108 <*> m .: "Notifications"
109 <*> (m .: "Resulting balance" >>= parseDecimalM)
110 <*> m .: "Tag"
111
112processPrimTx :: TZ -> PrimTx -> Res String Tx
113processPrimTx amsTz ptx = Tx (txBaseFromPrim ptx) <$> specificsFromPrim amsTz ptx
114
115parseValueDate :: T.Text -> Res String Day
116parseValueDate = parseDateM "%d/%m/%Y"
117
118assertValueDate :: Day -> T.Text -> Res String ()
119assertValueDate expected t = do
120 valDate <- parseDateM "%d/%m/%Y" t
121 when (valDate /= expected) $
122 fail "Expected transaction date and value date to be the same"
123
124assertValueDatePtx :: PrimTx -> T.Text -> Res String ()
125assertValueDatePtx PrimTx {ptxDate = expected} = assertValueDate expected
126
127specificsFromPrim :: TZ -> PrimTx -> Res String TxSpecifics
128specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = PaymentTerminalType, ptxDebitCredit = 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
130 (_, _, _, [cardSeqNo, timestampTxt, transaction, _, gpayTerm, noGpayTerm, valDateTxt]) <-
131 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
132 assertValueDatePtx ptx valDateTxt
133 timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt
134 return $
135 PaymentTerminalPayment
136 { ptpCounterpartyName = ptxDescription ptx,
137 ptpCardSequenceNo = cardSeqNo,
138 ptpTimestamp = timestamp,
139 ptpTransaction = transaction,
140 ptpTerminal = if T.null gpayTerm then noGpayTerm else gpayTerm,
141 ptpGooglePay = T.null noGpayTerm
142 }
143specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = PaymentTerminalType, ptxDebitCredit = 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
145 (_, _, _, [cardSeqNo, timestampTxt, transaction, term, valDateTxt]) <-
146 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
147 assertValueDatePtx ptx valDateTxt
148 timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt
149 return $
150 PaymentTerminalCashback
151 { ptcCounterpartyName = ptxDescription ptx,
152 ptcCardSequenceNo = cardSeqNo,
153 ptcTimestamp = timestamp,
154 ptcTransaction = transaction,
155 ptcTerminal = term
156 }
157specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = OnlineBankingType, ptxDebitCredit = 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
159 (_, _, _, [name, desc, ibanTxt, timestampTxt, valDateTxt]) <-
160 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
161 assertValueDatePtx ptx valDateTxt
162 iban <- parseIbanM ibanTxt
163 timestamp <- parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt
164 when (name /= ptxDescription ptx) $
165 fail "Expected counterparty name for online banking credit to match primitive description"
166 when (Just iban /= ptxCounterparty ptx) $
167 fail "Expected IBAN for online banking credit to match and primitive counterparty IBAN"
168 return $
169 OnlineBankingCredit
170 { obcCounterpartyName = name,
171 obcCounterpartyIban = iban,
172 obcDescription = desc,
173 obcTimestamp = timestamp
174 }
175specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = OnlineBankingType, ptxDebitCredit = 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
177 (_, _, _, [name, desc, ibanTxt, _, timestampTxt, valDateTxt]) <-
178 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
179 assertValueDatePtx ptx valDateTxt
180 iban <- parseIbanM ibanTxt
181 timestamp <-
182 if T.null timestampTxt
183 then pure Nothing
184 else Just <$> parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt
185 when (name /= ptxDescription ptx) $
186 fail "Expected counterparty name for online banking debit to match primitive description"
187 when (Just iban /= ptxCounterparty ptx) $
188 fail "Expected IBAN for online banking debit to match and primitive counterparty IBAN"
189 return $
190 OnlineBankingDebit
191 { obdCounterpartyIban = iban,
192 obdCounterpartyName = name,
193 obdDescription = desc,
194 obdTimestamp = timestamp
195 }
196specificsFromPrim _ ptx@PrimTx {ptxTransactionType = DirectDebitType, ptxDebitCredit = Debit} =
197 normalRecurrentDirectDebit <|> ingInsurancePayment
198 where
199 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
201 (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId, _, otherParty, valDateTxt]) <-
202 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
203 assertValueDatePtx ptx valDateTxt
204 iban <- parseIbanM ibanTxt
205 when (name /= ptxDescription ptx) $
206 fail "Expected counterparty name for direct debit to match primitive description"
207 when (Just iban /= ptxCounterparty ptx) $
208 fail "Expected IBAN for direct debit to match and primitive counterparty IBAN"
209 return $
210 RecurrentDirectDebit
211 { rddCounterpartyName = name,
212 rddCounterpartyIban = iban,
213 rddDescription = desc,
214 rddReference = ref,
215 rddMandateId = mandateId,
216 rddCreditorId = creditorId,
217 rddOtherParty = if T.null otherParty then Nothing else Just otherParty
218 }
219 ingInsurancePayment = do
220 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]) <-
222 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
223 iban <- parseIbanM ibanTxt
224 when (name /= ptxDescription ptx) $
225 fail "Expected counterparty name for direct debit to match primitive description"
226 when (Just iban /= ptxCounterparty ptx) $
227 fail "Expected IBAN for direct debit to match and primitive counterparty IBAN"
228 return $
229 RecurrentDirectDebit
230 { rddCounterpartyName = name,
231 rddCounterpartyIban = iban,
232 rddDescription = desc,
233 rddReference = ref,
234 rddMandateId = mandateId,
235 rddCreditorId = creditorId,
236 rddOtherParty = Nothing
237 }
238specificsFromPrim _ ptx@PrimTx {ptxTransactionType = TransferType, ptxDebitCredit = Credit} = do
239 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]) <-
241 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
242 assertValueDatePtx ptx valDateTxt
243 iban <- parseIbanM ibanTxt
244 when (name /= ptxDescription ptx) $
245 fail "Expected counterparty name for deposit transfer to match primitive description"
246 when (Just iban /= ptxCounterparty ptx) $
247 fail "Expected IBAN for deposit transfer to match and primitive counterparty IBAN"
248 return $
249 DepositTransfer
250 { dtCounterpartyName = name,
251 dtCounterpartyIban = iban,
252 dtDescription = desc,
253 dtReference = ref
254 }
255specificsFromPrim _ ptx@PrimTx {ptxTransactionType = TransferType, ptxDebitCredit = Debit} = do
256 let regex = "^To Oranje spaarrekening ([A-Z0-9]+) Afronding Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
257 (_, _, _, [savingsAccount, valDateTxt]) <-
258 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
259 assertValueDatePtx ptx valDateTxt
260 return $ RoundingSavingsDeposit {rsdSavingsAccount = savingsAccount}
261specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = IdealType, ptxDebitCredit = 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
263 (_, _, _, [name, desc, ibanTxt, timestampTxt, ref, valDateTxt]) <-
264 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
265 assertValueDatePtx ptx valDateTxt
266 timestamp <- parseTimestampM "%d-%m-%Y %H:%M" amsTz timestampTxt
267 iban <- parseIbanM ibanTxt
268 when (name /= ptxDescription ptx) $
269 fail "Expected counterparty name for iDEAL payment to match primitive description"
270 when (Just iban /= ptxCounterparty ptx) $
271 fail "Expected IBAN for iDEAL payment to match and primitive counterparty IBAN"
272 return $
273 IdealDebit
274 { idCounterpartyName = name,
275 idCounterpartyIban = iban,
276 idDescription = desc,
277 idTimestamp = timestamp,
278 idReference = ref
279 }
280specificsFromPrim _ ptx@PrimTx {ptxTransactionType = BatchPaymentType, ptxDebitCredit = Credit} = do
281 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]) <-
283 ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
284 assertValueDatePtx ptx valDateTxt
285 iban <- parseIbanM ibanTxt
286 when (name /= ptxDescription ptx) $
287 fail "Expected counterparty name for batch payment to match primitive description"
288 when (Just iban /= ptxCounterparty ptx) $
289 fail "Expected IBAN for batch payment to match and primitive counterparty IBAN"
290 return $
291 BatchPayment
292 { bpCounterpartyName = name,
293 bpCounterpartyIban = iban,
294 bpDescription = desc,
295 bpReference = ref
296 }
297specificsFromPrim _ ptx =
298 fail $
299 "Could not extract data from transaction ("
300 ++ show (ptxTransactionType ptx)
301 ++ " / "
302 ++ show (ptxDebitCredit ptx)
303 ++ ")"
304
305txBaseFromPrim :: PrimTx -> TxBase
306txBaseFromPrim =
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
385readFile :: Handle -> IO (V.Vector Tx)
386readFile h = do
387 tz <- loadTZFromDB "Europe/Amsterdam"
388 contents <- BS.hGetContents h
389 primTxs <- case C.decodeByNameWith scsvOptions contents of
390 Left err -> fail err
391 Right
392 ( [ "Date",
393 "Name / Description",
394 "Account",
395 "Counterparty",
396 "Code",
397 "Debit/credit",
398 "Amount (EUR)",
399 "Transaction type",
400 "Notifications",
401 "Resulting balance",
402 "Tag"
403 ],
404 txs
405 ) ->
406 return txs
407 Right _ ->
408 fail "Headers do not match expected pattern"
409 case V.mapM (processPrimTx tz) primTxs of
410 Err err -> fail err
411 Ok txs -> return txs
diff --git a/app/Main.hs b/app/Main.hs
index f5140f2..7b4551a 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -16,7 +16,6 @@ import Brick.Widgets.Core
16import Brick.Widgets.Dialog qualified as D 16import Brick.Widgets.Dialog qualified as D
17import Graphics.Vty qualified as V 17import Graphics.Vty qualified as V
18import Import.Ing.CurrentAccountCsv qualified 18import Import.Ing.CurrentAccountCsv qualified
19import Import.Ing.CurrentAccountCsv2 qualified
20import Import.Ing.SavingsAccountCsv qualified 19import Import.Ing.SavingsAccountCsv qualified
21import System.IO (IOMode (ReadMode), withFile) 20import System.IO (IOMode (ReadMode), withFile)
22import Text.Pretty.Simple (pPrint) 21import Text.Pretty.Simple (pPrint)
@@ -95,7 +94,7 @@ main = do
95 let filename = "/home/rutgerbrf/Code/P/wayligmative/test3.csv" 94 let filename = "/home/rutgerbrf/Code/P/wayligmative/test3.csv"
96 putStrLn $ "Reading " ++ filename 95 putStrLn $ "Reading " ++ filename
97 withFile filename ReadMode $ \h -> do 96 withFile filename ReadMode $ \h -> do
98 entries <- Import.Ing.CurrentAccountCsv2.readFile h 97 entries <- Import.Ing.CurrentAccountCsv.readFile h
99 pPrint entries 98 pPrint entries
100 99
101-- d <- M.defaultMain theApp initialState 100-- d <- M.defaultMain theApp initialState