diff options
| -rw-r--r-- | app/Data/Iban.hs | 10 | ||||
| -rw-r--r-- | app/Data/Res.hs | 31 | ||||
| -rw-r--r-- | app/Import/Ing/CurrentAccountCsv.hs | 44 | ||||
| -rw-r--r-- | app/Import/Ing/CurrentAccountCsv2.hs | 411 | ||||
| -rw-r--r-- | app/Import/Ing/SavingsAccountCsv.hs | 36 | ||||
| -rw-r--r-- | app/Import/Ing/Shared.hs | 49 | ||||
| -rw-r--r-- | app/Main.hs | 7 | ||||
| -rw-r--r-- | wayligmative.cabal | 2 |
8 files changed, 517 insertions, 73 deletions
diff --git a/app/Data/Iban.hs b/app/Data/Iban.hs index 45343ec..412577a 100644 --- a/app/Data/Iban.hs +++ b/app/Data/Iban.hs | |||
| @@ -4,6 +4,8 @@ import Control.Applicative ((<|>)) | |||
| 4 | import Data.Attoparsec.Text as AP | 4 | import Data.Attoparsec.Text as AP |
| 5 | import Data.Char | 5 | import Data.Char |
| 6 | ( digitToInt, | 6 | ( digitToInt, |
| 7 | isAscii, | ||
| 8 | isDigit, | ||
| 7 | ord, | 9 | ord, |
| 8 | toUpper, | 10 | toUpper, |
| 9 | ) | 11 | ) |
| @@ -24,7 +26,7 @@ validateIban = AP.parseOnly $ do | |||
| 24 | then | 26 | then |
| 25 | if valid countryCode checkDigits chars | 27 | if valid countryCode checkDigits chars |
| 26 | then return () | 28 | then return () |
| 27 | else fail $ "IBAN checksum does not match (" <> countryCode <> checkDigits <> chars <> ")" | 29 | else fail $ "IBAN checksum does not match (" ++ countryCode ++ checkDigits ++ chars ++ ")" |
| 28 | else fail "IBAN has more than 34 characters" | 30 | else fail "IBAN has more than 34 characters" |
| 29 | where | 31 | where |
| 30 | letterToInt c = ord (toUpper c) - ord 'A' + 10 | 32 | letterToInt c = ord (toUpper c) - ord 'A' + 10 |
| @@ -32,10 +34,8 @@ validateIban = AP.parseOnly $ do | |||
| 32 | foldl' | 34 | foldl' |
| 33 | ( \acc -> \case | 35 | ( \acc -> \case |
| 34 | d | 36 | d |
| 35 | | '0' <= d && d <= '9' -> acc * 10 + toInteger (digitToInt d) | 37 | | isDigit d -> acc * 10 + toInteger (digitToInt d) |
| 36 | | 'A' <= d && d <= 'Z' | 38 | | isAscii d -> acc * 100 + toInteger (letterToInt d) |
| 37 | || 'a' <= d && d <= 'z' -> | ||
| 38 | acc * 100 + toInteger (letterToInt d) | ||
| 39 | | otherwise -> error "unreachable" | 39 | | otherwise -> error "unreachable" |
| 40 | ) | 40 | ) |
| 41 | 0 | 41 | 0 |
diff --git a/app/Data/Res.hs b/app/Data/Res.hs new file mode 100644 index 0000000..e8c4ca4 --- /dev/null +++ b/app/Data/Res.hs | |||
| @@ -0,0 +1,31 @@ | |||
| 1 | module Data.Res where | ||
| 2 | |||
| 3 | import Control.Applicative | ||
| 4 | import Data.String (IsString (fromString)) | ||
| 5 | |||
| 6 | data Res e r = Ok r | Err e | ||
| 7 | |||
| 8 | instance Functor (Res e) where | ||
| 9 | fmap f (Ok v) = Ok (f v) | ||
| 10 | fmap _ (Err e) = Err e | ||
| 11 | |||
| 12 | instance Applicative (Res e) where | ||
| 13 | pure = Ok | ||
| 14 | (Ok f) <*> (Ok v) = Ok (f v) | ||
| 15 | (Err e) <*> _ = Err e | ||
| 16 | _ <*> (Err e) = Err e | ||
| 17 | |||
| 18 | instance Monad (Res e) where | ||
| 19 | (Ok v) >>= f = f v | ||
| 20 | (Err e) >>= _ = Err e | ||
| 21 | |||
| 22 | instance IsString e => MonadFail (Res e) where | ||
| 23 | fail = Err . fromString | ||
| 24 | |||
| 25 | instance IsString e => Alternative (Res e) where | ||
| 26 | empty = fail "mzero" | ||
| 27 | m1@(Ok _) <|> _ = m1 | ||
| 28 | (Err _) <|> m2 = m2 | ||
| 29 | |||
| 30 | liftEither :: Either e r -> Res e r | ||
| 31 | liftEither = either Err Ok | ||
diff --git a/app/Import/Ing/CurrentAccountCsv.hs b/app/Import/Ing/CurrentAccountCsv.hs index bf28730..1456be1 100644 --- a/app/Import/Ing/CurrentAccountCsv.hs +++ b/app/Import/Ing/CurrentAccountCsv.hs | |||
| @@ -17,12 +17,12 @@ import Data.Time.Zones (TZ, loadTZFromDB) | |||
| 17 | import Data.Vector qualified as V | 17 | import Data.Vector qualified as V |
| 18 | import Import.Ing.Shared | 18 | import Import.Ing.Shared |
| 19 | ( DebitCredit (Credit, Debit), | 19 | ( DebitCredit (Credit, Debit), |
| 20 | dateCP, | ||
| 21 | decimalCP, | ||
| 22 | ibanCP, | ||
| 23 | maybeCP, | 20 | maybeCP, |
| 21 | parseDateM, | ||
| 22 | parseDecimalM, | ||
| 23 | parseIbanM, | ||
| 24 | parseTimestampM, | ||
| 24 | scsvOptions, | 25 | scsvOptions, |
| 25 | timestampCP, | ||
| 26 | ) | 26 | ) |
| 27 | import System.IO (Handle) | 27 | import System.IO (Handle) |
| 28 | import Text.Regex.TDFA ((=~~)) | 28 | import Text.Regex.TDFA ((=~~)) |
| @@ -155,7 +155,7 @@ maybeNotProvided :: T.Text -> Maybe T.Text | |||
| 155 | maybeNotProvided t = if t == "NOTPROVIDED" then Nothing else Just t | 155 | maybeNotProvided t = if t == "NOTPROVIDED" then Nothing else Just t |
| 156 | 156 | ||
| 157 | valueDateCP :: T.Text -> C.Parser Day | 157 | valueDateCP :: T.Text -> C.Parser Day |
| 158 | valueDateCP = dateCP "%d/%m/%Y" | 158 | valueDateCP = parseDateM "%d/%m/%Y" |
| 159 | 159 | ||
| 160 | data PartTx = PartTx !Day !TransactionType !DebitCredit | 160 | data PartTx = PartTx !Day !TransactionType !DebitCredit |
| 161 | 161 | ||
| @@ -163,7 +163,7 @@ notificationsCP :: TZ -> PartTx -> T.Text -> C.Parser MoreData | |||
| 163 | notificationsCP _ (PartTx _ Transfer Credit) t = do | 163 | notificationsCP _ (PartTx _ Transfer Credit) t = do |
| 164 | let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String | 164 | let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String |
| 165 | (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) | 165 | (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) |
| 166 | iban <- ibanCP ibanTxt | 166 | iban <- parseIbanM ibanTxt |
| 167 | valDate <- valueDateCP valDateTxt | 167 | valDate <- valueDateCP valDateTxt |
| 168 | return $ | 168 | return $ |
| 169 | DepositTransferData | 169 | DepositTransferData |
| @@ -185,7 +185,7 @@ notificationsCP _ (PartTx _ Transfer Debit) t = do | |||
| 185 | notificationsCP amsTz (PartTx _ PaymentTerminal Debit) t = do | 185 | notificationsCP 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 | 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 |
| 187 | (_, _, _, [cardSeqNo, timestampTxt, transaction, _, gpayTerm, noGpayTerm, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) | 187 | (_, _, _, [cardSeqNo, timestampTxt, transaction, _, gpayTerm, noGpayTerm, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) |
| 188 | timestamp <- timestampCP "%d/%m/%Y %H:%M" amsTz timestampTxt | 188 | timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt |
| 189 | valDate <- valueDateCP valDateTxt | 189 | valDate <- valueDateCP valDateTxt |
| 190 | return $ | 190 | return $ |
| 191 | PaymentTerminalData | 191 | PaymentTerminalData |
| @@ -199,7 +199,7 @@ notificationsCP amsTz (PartTx _ PaymentTerminal Debit) t = do | |||
| 199 | notificationsCP amsTz (PartTx _ PaymentTerminal Credit) t = do | 199 | notificationsCP amsTz (PartTx _ PaymentTerminal Credit) t = 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 | 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 |
| 201 | (_, _, _, [cardSeqNo, timestampTxt, transaction, term, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) | 201 | (_, _, _, [cardSeqNo, timestampTxt, transaction, term, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) |
| 202 | timestamp <- timestampCP "%d/%m/%Y %H:%M" amsTz timestampTxt | 202 | timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt |
| 203 | valDate <- valueDateCP valDateTxt | 203 | valDate <- valueDateCP valDateTxt |
| 204 | return $ | 204 | return $ |
| 205 | PaymentTerminalCashbackData | 205 | PaymentTerminalCashbackData |
| @@ -212,8 +212,8 @@ notificationsCP amsTz (PartTx _ PaymentTerminal Credit) t = do | |||
| 212 | notificationsCP amsTz (PartTx _ OnlineBanking Credit) t = do | 212 | notificationsCP amsTz (PartTx _ OnlineBanking Credit) t = 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 | 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 |
| 214 | (_, _, _, [name, desc, ibanTxt, timestampTxt, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) | 214 | (_, _, _, [name, desc, ibanTxt, timestampTxt, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) |
| 215 | iban <- ibanCP ibanTxt | 215 | iban <- parseIbanM ibanTxt |
| 216 | timestamp <- timestampCP "%d-%m-%Y %H:%M:%S" amsTz timestampTxt | 216 | timestamp <- parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt |
| 217 | valDate <- valueDateCP valDateTxt | 217 | valDate <- valueDateCP valDateTxt |
| 218 | return $ | 218 | return $ |
| 219 | OnlineBankingCredit | 219 | OnlineBankingCredit |
| @@ -226,11 +226,11 @@ notificationsCP amsTz (PartTx _ OnlineBanking Credit) t = do | |||
| 226 | notificationsCP amsTz (PartTx _ OnlineBanking Debit) t = do | 226 | notificationsCP amsTz (PartTx _ OnlineBanking Debit) t = 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 | 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 |
| 228 | (_, _, _, [name, desc, ibanTxt, _, timestampTxt, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) | 228 | (_, _, _, [name, desc, ibanTxt, _, timestampTxt, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) |
| 229 | iban <- ibanCP ibanTxt | 229 | iban <- parseIbanM ibanTxt |
| 230 | timestamp <- | 230 | timestamp <- |
| 231 | if T.null timestampTxt | 231 | if T.null timestampTxt |
| 232 | then pure Nothing | 232 | then pure Nothing |
| 233 | else Just <$> timestampCP "%d-%m-%Y %H:%M:%S" amsTz timestampTxt | 233 | else Just <$> parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt |
| 234 | valDate <- valueDateCP valDateTxt | 234 | valDate <- valueDateCP valDateTxt |
| 235 | return $ | 235 | return $ |
| 236 | OnlineBankingDebit | 236 | OnlineBankingDebit |
| @@ -245,7 +245,7 @@ notificationsCP _ (PartTx date DirectDebit Debit) t = normalRecurrentDirectDebit | |||
| 245 | normalRecurrentDirectDebit = do | 245 | 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 | 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 |
| 247 | (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId, _, otherParty, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) | 247 | (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId, _, otherParty, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) |
| 248 | iban <- ibanCP ibanTxt | 248 | iban <- parseIbanM ibanTxt |
| 249 | valDate <- valueDateCP valDateTxt | 249 | valDate <- valueDateCP valDateTxt |
| 250 | return $ | 250 | return $ |
| 251 | RecurrentDirectDebitData | 251 | RecurrentDirectDebitData |
| @@ -261,7 +261,7 @@ notificationsCP _ (PartTx date DirectDebit Debit) t = normalRecurrentDirectDebit | |||
| 261 | ingInsurancePayment = do | 261 | ingInsurancePayment = do |
| 262 | let regex = "^Name: (.* ING Verzekeren) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit$" :: String | 262 | 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]) | 263 | (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) |
| 264 | iban <- ibanCP ibanTxt | 264 | iban <- parseIbanM ibanTxt |
| 265 | return $ | 265 | return $ |
| 266 | RecurrentDirectDebitData | 266 | RecurrentDirectDebitData |
| 267 | { rddName = name, | 267 | { rddName = name, |
| @@ -276,8 +276,8 @@ notificationsCP _ (PartTx date DirectDebit Debit) t = normalRecurrentDirectDebit | |||
| 276 | notificationsCP amsTz (PartTx _ Ideal Debit) t = do | 276 | notificationsCP amsTz (PartTx _ Ideal Debit) t = 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 | 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 |
| 278 | (_, _, _, [name, desc, ibanTxt, timestampTxt, ref, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) | 278 | (_, _, _, [name, desc, ibanTxt, timestampTxt, ref, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) |
| 279 | iban <- ibanCP ibanTxt | 279 | iban <- parseIbanM ibanTxt |
| 280 | timestamp <- timestampCP "%d-%m-%Y %H:%M" amsTz timestampTxt | 280 | timestamp <- parseTimestampM "%d-%m-%Y %H:%M" amsTz timestampTxt |
| 281 | valDate <- valueDateCP valDateTxt | 281 | valDate <- valueDateCP valDateTxt |
| 282 | return $ | 282 | return $ |
| 283 | IdealDebitData | 283 | IdealDebitData |
| @@ -291,7 +291,7 @@ notificationsCP amsTz (PartTx _ Ideal Debit) t = do | |||
| 291 | notificationsCP _ (PartTx _ BatchPayment Credit) t = do | 291 | notificationsCP _ (PartTx _ BatchPayment Credit) t = do |
| 292 | let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String | 292 | 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]) | 293 | (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text]) |
| 294 | iban <- ibanCP ibanTxt | 294 | iban <- parseIbanM ibanTxt |
| 295 | valDate <- valueDateCP valDateTxt | 295 | valDate <- valueDateCP valDateTxt |
| 296 | return $ | 296 | return $ |
| 297 | BatchPaymentData | 297 | BatchPaymentData |
| @@ -310,7 +310,7 @@ debitCreditCP t = fail ("Unknown debit/credit value '" ++ T.unpack t ++ "'") | |||
| 310 | 310 | ||
| 311 | parseNamedRecord :: TZ -> C.NamedRecord -> C.Parser PrimTx | 311 | parseNamedRecord :: TZ -> C.NamedRecord -> C.Parser PrimTx |
| 312 | parseNamedRecord amsTz m = do | 312 | parseNamedRecord amsTz m = do |
| 313 | date <- m .: "Date" >>= dateCP "%0Y%m%d" | 313 | date <- m .: "Date" >>= parseDateM "%0Y%m%d" |
| 314 | debitCredit <- m .: "Debit/credit" >>= debitCreditCP | 314 | debitCredit <- m .: "Debit/credit" >>= debitCreditCP |
| 315 | codeText <- m .: "Code" | 315 | codeText <- m .: "Code" |
| 316 | tyText <- m .: "Transaction type" | 316 | tyText <- m .: "Transaction type" |
| @@ -322,11 +322,11 @@ parseNamedRecord amsTz m = do | |||
| 322 | else | 322 | else |
| 323 | PrimTx date | 323 | PrimTx date |
| 324 | <$> (m .: "Name / Description" <&> maybeNotProvided) | 324 | <$> (m .: "Name / Description" <&> maybeNotProvided) |
| 325 | <*> (m .: "Account" >>= ibanCP) | 325 | <*> (m .: "Account" >>= parseIbanM) |
| 326 | <*> (m .: "Counterparty" >>= maybeCP ibanCP) | 326 | <*> (m .: "Counterparty" >>= maybeCP parseIbanM) |
| 327 | <*> pure debitCredit | 327 | <*> pure debitCredit |
| 328 | <*> (m .: "Amount (EUR)" >>= decimalCP) | 328 | <*> (m .: "Amount (EUR)" >>= parseDecimalM) |
| 329 | <*> (m .: "Resulting balance" >>= decimalCP) | 329 | <*> (m .: "Resulting balance" >>= parseDecimalM) |
| 330 | <*> m .: "Tag" | 330 | <*> m .: "Tag" |
| 331 | <*> (m .: "Notifications" >>= notificationsCP amsTz (PartTx date ty debitCredit)) | 331 | <*> (m .: "Notifications" >>= notificationsCP amsTz (PartTx date ty debitCredit)) |
| 332 | 332 | ||
diff --git a/app/Import/Ing/CurrentAccountCsv2.hs b/app/Import/Ing/CurrentAccountCsv2.hs new file mode 100644 index 0000000..0a5f8af --- /dev/null +++ b/app/Import/Ing/CurrentAccountCsv2.hs | |||
| @@ -0,0 +1,411 @@ | |||
| 1 | {-# LANGUAGE OverloadedLists #-} | ||
| 2 | {-# LANGUAGE OverloadedStrings #-} | ||
| 3 | |||
| 4 | module Import.Ing.CurrentAccountCsv2 where | ||
| 5 | |||
| 6 | import Control.Applicative ((<|>)) | ||
| 7 | import Control.Monad (when) | ||
| 8 | import Data.ByteString.Lazy qualified as BS | ||
| 9 | import Data.Csv ((.:)) | ||
| 10 | import Data.Csv qualified as C | ||
| 11 | import Data.Decimal (Decimal) | ||
| 12 | import Data.Iban (Iban) | ||
| 13 | import Data.Res (Res (Err, Ok)) | ||
| 14 | import Data.Text qualified as T | ||
| 15 | import Data.Time.Calendar (Day) | ||
| 16 | import Data.Time.Clock (UTCTime) | ||
| 17 | import Data.Time.Zones (TZ, loadTZFromDB) | ||
| 18 | import Data.Vector qualified as V | ||
| 19 | import Import.Ing.Shared | ||
| 20 | ( DebitCredit (Credit, Debit), | ||
| 21 | maybeCP, | ||
| 22 | parseDateM, | ||
| 23 | parseDecimalM, | ||
| 24 | parseIbanM, | ||
| 25 | parseTimestampM, | ||
| 26 | scsvOptions, | ||
| 27 | ) | ||
| 28 | import System.IO (Handle) | ||
| 29 | import Text.Regex.TDFA ((=~~)) | ||
| 30 | |||
| 31 | data 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 | |||
| 48 | parseCode :: T.Text -> C.Parser TransactionType | ||
| 49 | parseCode "AC" = return AcceptGiroType | ||
| 50 | parseCode "GM" = return AtmWithdrawalType | ||
| 51 | parseCode "VZ" = return BatchPaymentType | ||
| 52 | parseCode "FL" = return BranchPostingType | ||
| 53 | parseCode "ST" = return DepositType | ||
| 54 | parseCode "IC" = return DirectDebitType | ||
| 55 | parseCode "ID" = return IdealType | ||
| 56 | parseCode "GT" = return OnlineBankingType | ||
| 57 | parseCode "PK" = return OfficeWithdrawalType | ||
| 58 | parseCode "BA" = return PaymentTerminalType | ||
| 59 | parseCode "PO" = return PeriodicTransferType | ||
| 60 | parseCode "GF" = return PhoneBankingType | ||
| 61 | parseCode "OV" = return TransferType | ||
| 62 | parseCode "DV" = return VariousType | ||
| 63 | parseCode t = fail $ "Unknown transaction code '" ++ T.unpack t ++ "'" | ||
| 64 | |||
| 65 | parseType :: T.Text -> C.Parser TransactionType | ||
| 66 | parseType "SEPA direct debit" = return DirectDebitType | ||
| 67 | parseType "Batch payment" = return BatchPaymentType | ||
| 68 | parseType "Online Banking" = return OnlineBankingType | ||
| 69 | parseType "Payment terminal" = return PaymentTerminalType | ||
| 70 | parseType "Transfer" = return TransferType | ||
| 71 | parseType "iDEAL" = return IdealType | ||
| 72 | parseType t = fail $ "Unknown transaction type '" ++ T.unpack t ++ "'" | ||
| 73 | |||
| 74 | data 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 | |||
| 88 | debitCreditCP :: T.Text -> C.Parser DebitCredit | ||
| 89 | debitCreditCP "Debit" = return Debit | ||
| 90 | debitCreditCP "Credit" = return Credit | ||
| 91 | debitCreditCP t = fail ("Unknown debit/credit value '" ++ T.unpack t ++ "'") | ||
| 92 | |||
| 93 | instance 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 | |||
| 112 | processPrimTx :: TZ -> PrimTx -> Res String Tx | ||
| 113 | processPrimTx amsTz ptx = Tx (txBaseFromPrim ptx) <$> specificsFromPrim amsTz ptx | ||
| 114 | |||
| 115 | parseValueDate :: T.Text -> Res String Day | ||
| 116 | parseValueDate = parseDateM "%d/%m/%Y" | ||
| 117 | |||
| 118 | assertValueDate :: Day -> T.Text -> Res String () | ||
| 119 | assertValueDate 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 | |||
| 124 | assertValueDatePtx :: PrimTx -> T.Text -> Res String () | ||
| 125 | assertValueDatePtx PrimTx {ptxDate = expected} = assertValueDate expected | ||
| 126 | |||
| 127 | specificsFromPrim :: TZ -> PrimTx -> Res String TxSpecifics | ||
| 128 | specificsFromPrim 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 | } | ||
| 143 | specificsFromPrim 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 | } | ||
| 157 | specificsFromPrim 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 | } | ||
| 175 | specificsFromPrim 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 | } | ||
| 196 | specificsFromPrim _ 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 | } | ||
| 238 | specificsFromPrim _ 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 | } | ||
| 255 | specificsFromPrim _ 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} | ||
| 261 | specificsFromPrim 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 | } | ||
| 280 | specificsFromPrim _ 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 | } | ||
| 297 | specificsFromPrim _ ptx = | ||
| 298 | fail $ | ||
| 299 | "Could not extract data from transaction (" | ||
| 300 | ++ show (ptxTransactionType ptx) | ||
| 301 | ++ " / " | ||
| 302 | ++ show (ptxDebitCredit ptx) | ||
| 303 | ++ ")" | ||
| 304 | |||
| 305 | txBaseFromPrim :: PrimTx -> TxBase | ||
| 306 | txBaseFromPrim = | ||
| 307 | TxBase | ||
| 308 | <$> ptxDate | ||
| 309 | <*> ptxAccount | ||
| 310 | <*> ptxAmount | ||
| 311 | <*> ptxResBal | ||
| 312 | <*> ptxTag | ||
| 313 | |||
| 314 | data Tx = Tx TxBase TxSpecifics deriving (Show) | ||
| 315 | |||
| 316 | data TxBase = TxBase | ||
| 317 | { txbDate :: !Day, | ||
| 318 | txbAccount :: !Iban, | ||
| 319 | txbAmount :: !Decimal, | ||
| 320 | txbResBal :: !Decimal, | ||
| 321 | txbTag :: !T.Text | ||
| 322 | } | ||
| 323 | deriving (Show) | ||
| 324 | |||
| 325 | data 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 | |||
| 385 | readFile :: Handle -> IO (V.Vector Tx) | ||
| 386 | readFile 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/Import/Ing/SavingsAccountCsv.hs b/app/Import/Ing/SavingsAccountCsv.hs index 3f2e5e6..16b5f92 100644 --- a/app/Import/Ing/SavingsAccountCsv.hs +++ b/app/Import/Ing/SavingsAccountCsv.hs | |||
| @@ -12,7 +12,7 @@ import Data.Maybe (isJust) | |||
| 12 | import Data.Text qualified as T | 12 | import Data.Text qualified as T |
| 13 | import Data.Time.Calendar (Day) | 13 | import Data.Time.Calendar (Day) |
| 14 | import Data.Vector qualified as V | 14 | import Data.Vector qualified as V |
| 15 | import Import.Ing.Shared (dateCP, decimalCP, eitherToCP, ibanCP, maybeCP, scsvOptions) | 15 | import Import.Ing.Shared (maybeCP, parseDateM, parseDecimalM, parseIbanM, scsvOptions) |
| 16 | import System.IO (Handle) | 16 | import System.IO (Handle) |
| 17 | import Text.Regex.TDFA ((=~~)) | 17 | import Text.Regex.TDFA ((=~~)) |
| 18 | 18 | ||
| @@ -49,7 +49,7 @@ instance MonadFail (Either String) where | |||
| 49 | 49 | ||
| 50 | txBaseFromPrim :: PrimTx -> Either String TxBase | 50 | txBaseFromPrim :: PrimTx -> Either String TxBase |
| 51 | txBaseFromPrim ptx@PrimTx {ptxCommodity = "EUR"} = | 51 | txBaseFromPrim ptx@PrimTx {ptxCommodity = "EUR"} = |
| 52 | return $ TxBase (ptxDate ptx) (ptxAccountId ptx) (ptxAccountName ptx) (ptxAmount ptx) (ptxResBal ptx) | 52 | return $ TxBase <$> ptxDate <*> ptxAccountId <*> ptxAccountName <*> ptxAmount <*> ptxResBal $ ptx |
| 53 | txBaseFromPrim ptx = | 53 | txBaseFromPrim ptx = |
| 54 | Left $ "Unexpected commodity '" ++ T.unpack (ptxCommodity ptx) ++ "' (expected EUR)" | 54 | Left $ "Unexpected commodity '" ++ T.unpack (ptxCommodity ptx) ++ "' (expected EUR)" |
| 55 | 55 | ||
| @@ -121,26 +121,25 @@ mutationTypeCP "Opname" = return WithdrawalMutation | |||
| 121 | mutationTypeCP "Rente" = return InterestMutation | 121 | mutationTypeCP "Rente" = return InterestMutation |
| 122 | mutationTypeCP t = fail ("Unknown mutation type '" ++ T.unpack t ++ "'") | 122 | mutationTypeCP t = fail ("Unknown mutation type '" ++ T.unpack t ++ "'") |
| 123 | 123 | ||
| 124 | instance C.FromNamedRecord Tx where | 124 | instance C.FromNamedRecord PrimTx where |
| 125 | parseNamedRecord m = | 125 | parseNamedRecord m = |
| 126 | eitherToCP . processPrimTx | 126 | PrimTx |
| 127 | =<< PrimTx | 127 | <$> (m .: "Datum" >>= parseDateM "%Y-%m-%d") |
| 128 | <$> (m .: "Datum" >>= dateCP "%Y-%m-%d") | 128 | <*> m .: "Omschrijving" |
| 129 | <*> m .: "Omschrijving" | 129 | <*> m .: "Rekening" |
| 130 | <*> m .: "Rekening" | 130 | <*> m .: "Rekening naam" |
| 131 | <*> m .: "Rekening naam" | 131 | <*> (m .: "Tegenrekening" >>= maybeCP parseIbanM) |
| 132 | <*> (m .: "Tegenrekening" >>= maybeCP ibanCP) | 132 | <*> (m .: "Af Bij" >>= debitCreditCP) |
| 133 | <*> (m .: "Af Bij" >>= debitCreditCP) | 133 | <*> (m .: "Bedrag" >>= parseDecimalM) |
| 134 | <*> (m .: "Bedrag" >>= decimalCP) | 134 | <*> m .: "Valuta" |
| 135 | <*> m .: "Valuta" | 135 | <*> (m .: "Mutatiesoort" >>= mutationTypeCP) |
| 136 | <*> (m .: "Mutatiesoort" >>= mutationTypeCP) | 136 | <*> m .: "Mededelingen" |
| 137 | <*> m .: "Mededelingen" | 137 | <*> (m .: "Saldo na mutatie" >>= parseDecimalM) |
| 138 | <*> (m .: "Saldo na mutatie" >>= decimalCP) | ||
| 139 | 138 | ||
| 140 | readFile :: Handle -> IO (V.Vector Tx) | 139 | readFile :: Handle -> IO (V.Vector Tx) |
| 141 | readFile h = do | 140 | readFile h = do |
| 142 | contents <- BS.hGetContents h | 141 | contents <- BS.hGetContents h |
| 143 | case C.decodeByNameWith scsvOptions contents of | 142 | primTxs <- case C.decodeByNameWith scsvOptions contents of |
| 144 | Left err -> fail err | 143 | Left err -> fail err |
| 145 | Right | 144 | Right |
| 146 | ( [ "Datum", | 145 | ( [ "Datum", |
| @@ -160,3 +159,6 @@ readFile h = do | |||
| 160 | return txs | 159 | return txs |
| 161 | Right _ -> | 160 | Right _ -> |
| 162 | fail "Headers do not match expected pattern" | 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 index c70f225..b5d1703 100644 --- a/app/Import/Ing/Shared.hs +++ b/app/Import/Ing/Shared.hs | |||
| @@ -13,35 +13,32 @@ import Data.Time.Zones (TZ, localTimeToUTCTZ) | |||
| 13 | 13 | ||
| 14 | data DebitCredit = Debit | Credit deriving (Show) | 14 | data DebitCredit = Debit | Credit deriving (Show) |
| 15 | 15 | ||
| 16 | readDecimal :: T.Text -> Either String Decimal | ||
| 17 | readDecimal = AP.parseOnly $ do | ||
| 18 | decPart <- AP.decimal | ||
| 19 | _ <- AP.char ',' | ||
| 20 | f1 <- AP.digit | ||
| 21 | f2 <- AP.digit | ||
| 22 | AP.endOfInput | ||
| 23 | let fracPart = fromIntegral $ digitToInt f1 * 10 + digitToInt f2 | ||
| 24 | return $ normalizeDecimal (Decimal 2 (decPart * 100 + fracPart)) | ||
| 25 | |||
| 26 | scsvOptions :: C.DecodeOptions | 16 | scsvOptions :: C.DecodeOptions |
| 27 | scsvOptions = C.defaultDecodeOptions {C.decDelimiter = fromIntegral (ord ';')} | 17 | scsvOptions = C.defaultDecodeOptions {C.decDelimiter = fromIntegral (ord ';')} |
| 28 | 18 | ||
| 29 | eitherToCP :: Either String a -> C.Parser a | ||
| 30 | eitherToCP = either fail return | ||
| 31 | |||
| 32 | decimalCP :: T.Text -> C.Parser Decimal | ||
| 33 | decimalCP = eitherToCP . readDecimal | ||
| 34 | |||
| 35 | dateCP :: String -> T.Text -> C.Parser Day | ||
| 36 | dateCP fmt = parseTimeM False defaultTimeLocale fmt . T.unpack | ||
| 37 | |||
| 38 | maybeCP :: (T.Text -> C.Parser a) -> T.Text -> C.Parser (Maybe a) | 19 | maybeCP :: (T.Text -> C.Parser a) -> T.Text -> C.Parser (Maybe a) |
| 39 | maybeCP p t = if T.null t then return Nothing else Just <$> p t | 20 | maybeCP p t = if T.null t then return Nothing else Just <$> p t |
| 40 | 21 | ||
| 41 | ibanCP :: T.Text -> C.Parser Iban | 22 | parseDecimalM :: (MonadFail m) => T.Text -> m Decimal |
| 42 | ibanCP = eitherToCP . mkIban | 23 | parseDecimalM = |
| 43 | 24 | either fail return | |
| 44 | timestampCP :: String -> TZ -> T.Text -> C.Parser UTCTime | 25 | . AP.parseOnly |
| 45 | timestampCP fmt amsTz t = do | 26 | ( do |
| 46 | localTime <- parseTimeM False defaultTimeLocale fmt (T.unpack t) | 27 | decPart <- AP.decimal |
| 47 | return $ localTimeToUTCTZ amsTz localTime | 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 | |||
| 36 | parseIbanM :: (MonadFail m) => T.Text -> m Iban | ||
| 37 | parseIbanM = either fail return . mkIban | ||
| 38 | |||
| 39 | parseDateM :: (MonadFail m) => String -> T.Text -> m Day | ||
| 40 | parseDateM fmt = parseTimeM False defaultTimeLocale fmt . T.unpack | ||
| 41 | |||
| 42 | parseTimestampM :: (MonadFail m) => String -> TZ -> T.Text -> m UTCTime | ||
| 43 | parseTimestampM fmt amsTz t = do | ||
| 44 | localTimeToUTCTZ amsTz <$> parseTimeM False defaultTimeLocale fmt (T.unpack t) | ||
diff --git a/app/Main.hs b/app/Main.hs index 403b78f..f5140f2 100644 --- a/app/Main.hs +++ b/app/Main.hs | |||
| @@ -15,8 +15,9 @@ import Brick.Widgets.Core | |||
| 15 | ) | 15 | ) |
| 16 | import Brick.Widgets.Dialog qualified as D | 16 | import Brick.Widgets.Dialog qualified as D |
| 17 | import Graphics.Vty qualified as V | 17 | import Graphics.Vty qualified as V |
| 18 | import Import.Ing.SavingsAccountCsv qualified | ||
| 19 | import Import.Ing.CurrentAccountCsv qualified | 18 | import Import.Ing.CurrentAccountCsv qualified |
| 19 | import Import.Ing.CurrentAccountCsv2 qualified | ||
| 20 | import Import.Ing.SavingsAccountCsv qualified | ||
| 20 | import System.IO (IOMode (ReadMode), withFile) | 21 | import System.IO (IOMode (ReadMode), withFile) |
| 21 | import Text.Pretty.Simple (pPrint) | 22 | import Text.Pretty.Simple (pPrint) |
| 22 | 23 | ||
| @@ -91,10 +92,10 @@ theApp = | |||
| 91 | 92 | ||
| 92 | main :: IO () | 93 | main :: IO () |
| 93 | main = do | 94 | main = do |
| 94 | let filename = "/home/rutgerbrf/Code/P/wayligmative/test.csv" | 95 | let filename = "/home/rutgerbrf/Code/P/wayligmative/test3.csv" |
| 95 | putStrLn $ "Reading " ++ filename | 96 | putStrLn $ "Reading " ++ filename |
| 96 | withFile filename ReadMode $ \h -> do | 97 | withFile filename ReadMode $ \h -> do |
| 97 | entries <- Import.Ing.CurrentAccountCsv.readFile h | 98 | entries <- Import.Ing.CurrentAccountCsv2.readFile h |
| 98 | pPrint entries | 99 | pPrint entries |
| 99 | 100 | ||
| 100 | -- d <- M.defaultMain theApp initialState | 101 | -- d <- M.defaultMain theApp initialState |
diff --git a/wayligmative.cabal b/wayligmative.cabal index b604e20..80b9ab5 100644 --- a/wayligmative.cabal +++ b/wayligmative.cabal | |||
| @@ -10,7 +10,9 @@ executable wayligmative | |||
| 10 | hs-source-dirs: app | 10 | hs-source-dirs: app |
| 11 | other-modules: | 11 | other-modules: |
| 12 | Data.Iban | 12 | Data.Iban |
| 13 | Data.Res | ||
| 13 | Import.Ing.CurrentAccountCsv | 14 | Import.Ing.CurrentAccountCsv |
| 15 | Import.Ing.CurrentAccountCsv2 | ||
| 14 | Import.Ing.Shared | 16 | Import.Ing.Shared |
| 15 | Import.Ing.SavingsAccountCsv | 17 | Import.Ing.SavingsAccountCsv |
| 16 | 18 | ||