Refactor parser for current account statement

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 ((<|>))
 import Data.Attoparsec.Text as AP
 import Data.Char
   ( digitToInt,
+    isAscii,
+    isDigit,
     ord,
     toUpper,
   )
@@ -24,7 +26,7 @@ validateIban = AP.parseOnly $ do
     then
       if valid countryCode checkDigits chars
         then return ()
-        else fail $ "IBAN checksum does not match (" <> countryCode <> checkDigits <> chars <> ")"
+        else fail $ "IBAN checksum does not match (" ++ countryCode ++ checkDigits ++ chars ++ ")"
     else fail "IBAN has more than 34 characters"
   where
     letterToInt c = ord (toUpper c) - ord 'A' + 10
@@ -32,10 +34,8 @@ validateIban = AP.parseOnly $ do
       foldl'
         ( \acc -> \case
             d
-              | '0' <= d && d <= '9' -> acc * 10 + toInteger (digitToInt d)
-              | 'A' <= d && d <= 'Z'
-                  || 'a' <= d && d <= 'z' ->
-                  acc * 100 + toInteger (letterToInt d)
+              | isDigit d -> acc * 10 + toInteger (digitToInt d)
+              | isAscii d -> acc * 100 + toInteger (letterToInt d)
               | otherwise -> error "unreachable"
         )
         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 @@
+module Data.Res where
+
+import Control.Applicative
+import Data.String (IsString (fromString))
+
+data Res e r = Ok r | Err e
+
+instance Functor (Res e) where
+  fmap f (Ok v) = Ok (f v)
+  fmap _ (Err e) = Err e
+
+instance Applicative (Res e) where
+  pure = Ok
+  (Ok f) <*> (Ok v) = Ok (f v)
+  (Err e) <*> _ = Err e
+  _ <*> (Err e) = Err e
+
+instance Monad (Res e) where
+  (Ok v) >>= f = f v
+  (Err e) >>= _ = Err e
+
+instance IsString e => MonadFail (Res e) where
+  fail = Err . fromString
+
+instance IsString e => Alternative (Res e) where
+  empty = fail "mzero"
+  m1@(Ok _) <|> _ = m1
+  (Err _) <|> m2 = m2
+
+liftEither :: Either e r -> Res e r
+liftEither = either Err Ok
diff --git a/app/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)
 import Data.Vector qualified as V
 import Import.Ing.Shared
   ( DebitCredit (Credit, Debit),
-    dateCP,
-    decimalCP,
-    ibanCP,
     maybeCP,
+    parseDateM,
+    parseDecimalM,
+    parseIbanM,
+    parseTimestampM,
     scsvOptions,
-    timestampCP,
   )
 import System.IO (Handle)
 import Text.Regex.TDFA ((=~~))
@@ -155,7 +155,7 @@ maybeNotProvided :: T.Text -> Maybe T.Text
 maybeNotProvided t = if t == "NOTPROVIDED" then Nothing else Just t
 
 valueDateCP :: T.Text -> C.Parser Day
-valueDateCP = dateCP "%d/%m/%Y"
+valueDateCP = parseDateM "%d/%m/%Y"
 
 data PartTx = PartTx !Day !TransactionType !DebitCredit
 
@@ -163,7 +163,7 @@ notificationsCP :: TZ -> PartTx -> T.Text -> C.Parser MoreData
 notificationsCP _ (PartTx _ Transfer Credit) t = do
   let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
   (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text])
-  iban <- ibanCP ibanTxt
+  iban <- parseIbanM ibanTxt
   valDate <- valueDateCP valDateTxt
   return $
     DepositTransferData
@@ -185,7 +185,7 @@ notificationsCP _ (PartTx _ Transfer Debit) t = do
 notificationsCP amsTz (PartTx _ PaymentTerminal Debit) t = do
   let regex = "^Card sequence no.: ([0-9]+) ? ([0-9]{2}/[0-9]{2}/[0-9]{4} [0-9]{2}:[0-9]{2}) Transaction: (.*) Term: ((.+) Google Pay|(.+)) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
   (_, _, _, [cardSeqNo, timestampTxt, transaction, _, gpayTerm, noGpayTerm, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text])
-  timestamp <- timestampCP "%d/%m/%Y %H:%M" amsTz timestampTxt
+  timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt
   valDate <- valueDateCP valDateTxt
   return $
     PaymentTerminalData
@@ -199,7 +199,7 @@ notificationsCP amsTz (PartTx _ PaymentTerminal Debit) t = do
 notificationsCP amsTz (PartTx _ PaymentTerminal Credit) t = do
   let regex = "^Card sequence no.: ([0-9]+) ? ([0-9]{2}/[0-9]{2}/[0-9]{4} [0-9]{2}:[0-9]{2}) Transaction: (.*) Term: (.*) Cashback transaction Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
   (_, _, _, [cardSeqNo, timestampTxt, transaction, term, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text])
-  timestamp <- timestampCP "%d/%m/%Y %H:%M" amsTz timestampTxt
+  timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt
   valDate <- valueDateCP valDateTxt
   return $
     PaymentTerminalCashbackData
@@ -212,8 +212,8 @@ notificationsCP amsTz (PartTx _ PaymentTerminal Credit) t = do
 notificationsCP amsTz (PartTx _ OnlineBanking Credit) t = do
   let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Date/time: ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}:[0-9]{2}) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
   (_, _, _, [name, desc, ibanTxt, timestampTxt, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text])
-  iban <- ibanCP ibanTxt
-  timestamp <- timestampCP "%d-%m-%Y %H:%M:%S" amsTz timestampTxt
+  iban <- parseIbanM ibanTxt
+  timestamp <- parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt
   valDate <- valueDateCP valDateTxt
   return $
     OnlineBankingCredit
@@ -226,11 +226,11 @@ notificationsCP amsTz (PartTx _ OnlineBanking Credit) t = do
 notificationsCP amsTz (PartTx _ OnlineBanking Debit) t = do
   let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) (Date/time: ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}:[0-9]{2}) )?Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
   (_, _, _, [name, desc, ibanTxt, _, timestampTxt, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text])
-  iban <- ibanCP ibanTxt
+  iban <- parseIbanM ibanTxt
   timestamp <-
     if T.null timestampTxt
       then pure Nothing
-      else Just <$> timestampCP "%d-%m-%Y %H:%M:%S" amsTz timestampTxt
+      else Just <$> parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt
   valDate <- valueDateCP valDateTxt
   return $
     OnlineBankingDebit
@@ -245,7 +245,7 @@ notificationsCP _ (PartTx date DirectDebit Debit) t = normalRecurrentDirectDebit
     normalRecurrentDirectDebit = do
       let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit (Other party: (.*) )?Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
       (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId, _, otherParty, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text])
-      iban <- ibanCP ibanTxt
+      iban <- parseIbanM ibanTxt
       valDate <- valueDateCP valDateTxt
       return $
         RecurrentDirectDebitData
@@ -261,7 +261,7 @@ notificationsCP _ (PartTx date DirectDebit Debit) t = normalRecurrentDirectDebit
     ingInsurancePayment = do
       let regex = "^Name: (.* ING Verzekeren) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit$" :: String
       (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text])
-      iban <- ibanCP ibanTxt
+      iban <- parseIbanM ibanTxt
       return $
         RecurrentDirectDebitData
           { rddName = name,
@@ -276,8 +276,8 @@ notificationsCP _ (PartTx date DirectDebit Debit) t = normalRecurrentDirectDebit
 notificationsCP amsTz (PartTx _ Ideal Debit) t = do
   let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}) ([0-9]+) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
   (_, _, _, [name, desc, ibanTxt, timestampTxt, ref, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text])
-  iban <- ibanCP ibanTxt
-  timestamp <- timestampCP "%d-%m-%Y %H:%M" amsTz timestampTxt
+  iban <- parseIbanM ibanTxt
+  timestamp <- parseTimestampM "%d-%m-%Y %H:%M" amsTz timestampTxt
   valDate <- valueDateCP valDateTxt
   return $
     IdealDebitData
@@ -291,7 +291,7 @@ notificationsCP amsTz (PartTx _ Ideal Debit) t = do
 notificationsCP _ (PartTx _ BatchPayment Credit) t = do
   let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
   (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <- t =~~ regex :: C.Parser (T.Text, T.Text, T.Text, [T.Text])
-  iban <- ibanCP ibanTxt
+  iban <- parseIbanM ibanTxt
   valDate <- valueDateCP valDateTxt
   return $
     BatchPaymentData
@@ -310,7 +310,7 @@ debitCreditCP t = fail ("Unknown debit/credit value '" ++ T.unpack t ++ "'")
 
 parseNamedRecord :: TZ -> C.NamedRecord -> C.Parser PrimTx
 parseNamedRecord amsTz m = do
-  date <- m .: "Date" >>= dateCP "%0Y%m%d"
+  date <- m .: "Date" >>= parseDateM "%0Y%m%d"
   debitCredit <- m .: "Debit/credit" >>= debitCreditCP
   codeText <- m .: "Code"
   tyText <- m .: "Transaction type"
@@ -322,11 +322,11 @@ parseNamedRecord amsTz m = do
     else
       PrimTx date
         <$> (m .: "Name / Description" <&> maybeNotProvided)
-        <*> (m .: "Account" >>= ibanCP)
-        <*> (m .: "Counterparty" >>= maybeCP ibanCP)
+        <*> (m .: "Account" >>= parseIbanM)
+        <*> (m .: "Counterparty" >>= maybeCP parseIbanM)
         <*> pure debitCredit
-        <*> (m .: "Amount (EUR)" >>= decimalCP)
-        <*> (m .: "Resulting balance" >>= decimalCP)
+        <*> (m .: "Amount (EUR)" >>= parseDecimalM)
+        <*> (m .: "Resulting balance" >>= parseDecimalM)
         <*> m .: "Tag"
         <*> (m .: "Notifications" >>= notificationsCP amsTz (PartTx date ty debitCredit))
 
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 @@
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Import.Ing.CurrentAccountCsv2 where
+
+import Control.Applicative ((<|>))
+import Control.Monad (when)
+import Data.ByteString.Lazy qualified as BS
+import Data.Csv ((.:))
+import Data.Csv qualified as C
+import Data.Decimal (Decimal)
+import Data.Iban (Iban)
+import Data.Res (Res (Err, Ok))
+import Data.Text qualified as T
+import Data.Time.Calendar (Day)
+import Data.Time.Clock (UTCTime)
+import Data.Time.Zones (TZ, loadTZFromDB)
+import Data.Vector qualified as V
+import Import.Ing.Shared
+  ( DebitCredit (Credit, Debit),
+    maybeCP,
+    parseDateM,
+    parseDecimalM,
+    parseIbanM,
+    parseTimestampM,
+    scsvOptions,
+  )
+import System.IO (Handle)
+import Text.Regex.TDFA ((=~~))
+
+data TransactionType
+  = AcceptGiroType -- AC (acceptgiro)
+  | AtmWithdrawalType -- GM (geldautomaat, Giromaat)
+  | BatchPaymentType -- VZ (verzamelbetaling); 'Batch payment'
+  | BranchPostingType -- FL (filiaalboeking)
+  | DepositType -- ST (storting)
+  | DirectDebitType -- IC (incasso); 'SEPA direct debit'
+  | IdealType -- ID (iDEAL); 'iDEAL'
+  | OnlineBankingType -- GT (internetbankieren, Girotel); 'Online Banking'
+  | OfficeWithdrawalType -- PK (opname kantoor, postkantoor)
+  | PaymentTerminalType -- BA (betaalautomaat); 'Payment terminal'
+  | PeriodicTransferType -- PO (periodieke overschrijving)
+  | PhoneBankingType -- GF (telefonisch bankieren, Girofoon)
+  | TransferType -- OV (overboeking); 'Transfer'
+  | VariousType -- DV (diversen)
+  deriving (Eq, Show)
+
+parseCode :: T.Text -> C.Parser TransactionType
+parseCode "AC" = return AcceptGiroType
+parseCode "GM" = return AtmWithdrawalType
+parseCode "VZ" = return BatchPaymentType
+parseCode "FL" = return BranchPostingType
+parseCode "ST" = return DepositType
+parseCode "IC" = return DirectDebitType
+parseCode "ID" = return IdealType
+parseCode "GT" = return OnlineBankingType
+parseCode "PK" = return OfficeWithdrawalType
+parseCode "BA" = return PaymentTerminalType
+parseCode "PO" = return PeriodicTransferType
+parseCode "GF" = return PhoneBankingType
+parseCode "OV" = return TransferType
+parseCode "DV" = return VariousType
+parseCode t = fail $ "Unknown transaction code '" ++ T.unpack t ++ "'"
+
+parseType :: T.Text -> C.Parser TransactionType
+parseType "SEPA direct debit" = return DirectDebitType
+parseType "Batch payment" = return BatchPaymentType
+parseType "Online Banking" = return OnlineBankingType
+parseType "Payment terminal" = return PaymentTerminalType
+parseType "Transfer" = return TransferType
+parseType "iDEAL" = return IdealType
+parseType t = fail $ "Unknown transaction type '" ++ T.unpack t ++ "'"
+
+data PrimTx = PrimTx
+  { ptxDate :: !Day,
+    ptxDescription :: !T.Text,
+    ptxAccount :: !Iban,
+    ptxCounterparty :: !(Maybe Iban),
+    ptxTransactionType :: !TransactionType,
+    ptxDebitCredit :: !DebitCredit,
+    ptxAmount :: !Decimal,
+    ptxNotifications :: !T.Text,
+    ptxResBal :: !Decimal,
+    ptxTag :: !T.Text
+  }
+  deriving (Show)
+
+debitCreditCP :: T.Text -> C.Parser DebitCredit
+debitCreditCP "Debit" = return Debit
+debitCreditCP "Credit" = return Credit
+debitCreditCP t = fail ("Unknown debit/credit value '" ++ T.unpack t ++ "'")
+
+instance C.FromNamedRecord PrimTx where
+  parseNamedRecord m = do
+    code <- m .: "Code" >>= parseCode
+    txType <- m .: "Transaction type" >>= parseType
+    if code /= txType
+      then fail "Expected code and transaction type to agree"
+      else
+        PrimTx
+          <$> (m .: "Date" >>= parseDateM "%0Y%m%d")
+          <*> m .: "Name / Description"
+          <*> (m .: "Account" >>= parseIbanM)
+          <*> (m .: "Counterparty" >>= maybeCP parseIbanM)
+          <*> return txType
+          <*> (m .: "Debit/credit" >>= debitCreditCP)
+          <*> (m .: "Amount (EUR)" >>= parseDecimalM)
+          <*> m .: "Notifications"
+          <*> (m .: "Resulting balance" >>= parseDecimalM)
+          <*> m .: "Tag"
+
+processPrimTx :: TZ -> PrimTx -> Res String Tx
+processPrimTx amsTz ptx = Tx (txBaseFromPrim ptx) <$> specificsFromPrim amsTz ptx
+
+parseValueDate :: T.Text -> Res String Day
+parseValueDate = parseDateM "%d/%m/%Y"
+
+assertValueDate :: Day -> T.Text -> Res String ()
+assertValueDate expected t = do
+  valDate <- parseDateM "%d/%m/%Y" t
+  when (valDate /= expected) $
+    fail "Expected transaction date and value date to be the same"
+
+assertValueDatePtx :: PrimTx -> T.Text -> Res String ()
+assertValueDatePtx PrimTx {ptxDate = expected} = assertValueDate expected
+
+specificsFromPrim :: TZ -> PrimTx -> Res String TxSpecifics
+specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = PaymentTerminalType, ptxDebitCredit = Debit} = do
+  let regex = "^Card sequence no.: ([0-9]+) ? ([0-9]{2}/[0-9]{2}/[0-9]{4} [0-9]{2}:[0-9]{2}) Transaction: (.*) Term: ((.+) Google Pay|(.+)) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
+  (_, _, _, [cardSeqNo, timestampTxt, transaction, _, gpayTerm, noGpayTerm, valDateTxt]) <-
+    ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
+  assertValueDatePtx ptx valDateTxt
+  timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt
+  return $
+    PaymentTerminalPayment
+      { ptpCounterpartyName = ptxDescription ptx,
+        ptpCardSequenceNo = cardSeqNo,
+        ptpTimestamp = timestamp,
+        ptpTransaction = transaction,
+        ptpTerminal = if T.null gpayTerm then noGpayTerm else gpayTerm,
+        ptpGooglePay = T.null noGpayTerm
+      }
+specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = PaymentTerminalType, ptxDebitCredit = Credit} = do
+  let regex = "^Card sequence no.: ([0-9]+) ? ([0-9]{2}/[0-9]{2}/[0-9]{4} [0-9]{2}:[0-9]{2}) Transaction: (.*) Term: (.*) Cashback transaction Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
+  (_, _, _, [cardSeqNo, timestampTxt, transaction, term, valDateTxt]) <-
+    ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
+  assertValueDatePtx ptx valDateTxt
+  timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt
+  return $
+    PaymentTerminalCashback
+      { ptcCounterpartyName = ptxDescription ptx,
+        ptcCardSequenceNo = cardSeqNo,
+        ptcTimestamp = timestamp,
+        ptcTransaction = transaction,
+        ptcTerminal = term
+      }
+specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = OnlineBankingType, ptxDebitCredit = Credit} = do
+  let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Date/time: ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}:[0-9]{2}) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
+  (_, _, _, [name, desc, ibanTxt, timestampTxt, valDateTxt]) <-
+    ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
+  assertValueDatePtx ptx valDateTxt
+  iban <- parseIbanM ibanTxt
+  timestamp <- parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt
+  when (name /= ptxDescription ptx) $
+    fail "Expected counterparty name for online banking credit to match primitive description"
+  when (Just iban /= ptxCounterparty ptx) $
+    fail "Expected IBAN for online banking credit to match and primitive counterparty IBAN"
+  return $
+    OnlineBankingCredit
+      { obcCounterpartyName = name,
+        obcCounterpartyIban = iban,
+        obcDescription = desc,
+        obcTimestamp = timestamp
+      }
+specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = OnlineBankingType, ptxDebitCredit = Debit} = do
+  let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) (Date/time: ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}:[0-9]{2}) )?Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
+  (_, _, _, [name, desc, ibanTxt, _, timestampTxt, valDateTxt]) <-
+    ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
+  assertValueDatePtx ptx valDateTxt
+  iban <- parseIbanM ibanTxt
+  timestamp <-
+    if T.null timestampTxt
+      then pure Nothing
+      else Just <$> parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt
+  when (name /= ptxDescription ptx) $
+    fail "Expected counterparty name for online banking debit to match primitive description"
+  when (Just iban /= ptxCounterparty ptx) $
+    fail "Expected IBAN for online banking debit to match and primitive counterparty IBAN"
+  return $
+    OnlineBankingDebit
+      { obdCounterpartyIban = iban,
+        obdCounterpartyName = name,
+        obdDescription = desc,
+        obdTimestamp = timestamp
+      }
+specificsFromPrim _ ptx@PrimTx {ptxTransactionType = DirectDebitType, ptxDebitCredit = Debit} =
+  normalRecurrentDirectDebit <|> ingInsurancePayment
+  where
+    normalRecurrentDirectDebit = do
+      let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit (Other party: (.*) )?Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
+      (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId, _, otherParty, valDateTxt]) <-
+        ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
+      assertValueDatePtx ptx valDateTxt
+      iban <- parseIbanM ibanTxt
+      when (name /= ptxDescription ptx) $
+        fail "Expected counterparty name for direct debit to match primitive description"
+      when (Just iban /= ptxCounterparty ptx) $
+        fail "Expected IBAN for direct debit to match and primitive counterparty IBAN"
+      return $
+        RecurrentDirectDebit
+          { rddCounterpartyName = name,
+            rddCounterpartyIban = iban,
+            rddDescription = desc,
+            rddReference = ref,
+            rddMandateId = mandateId,
+            rddCreditorId = creditorId,
+            rddOtherParty = if T.null otherParty then Nothing else Just otherParty
+          }
+    ingInsurancePayment = do
+      let regex = "^Name: (.* ING Verzekeren) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit$" :: String
+      (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId]) <-
+        ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
+      iban <- parseIbanM ibanTxt
+      when (name /= ptxDescription ptx) $
+        fail "Expected counterparty name for direct debit to match primitive description"
+      when (Just iban /= ptxCounterparty ptx) $
+        fail "Expected IBAN for direct debit to match and primitive counterparty IBAN"
+      return $
+        RecurrentDirectDebit
+          { rddCounterpartyName = name,
+            rddCounterpartyIban = iban,
+            rddDescription = desc,
+            rddReference = ref,
+            rddMandateId = mandateId,
+            rddCreditorId = creditorId,
+            rddOtherParty = Nothing
+          }
+specificsFromPrim _ ptx@PrimTx {ptxTransactionType = TransferType, ptxDebitCredit = Credit} = do
+  let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
+  (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <-
+    ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
+  assertValueDatePtx ptx valDateTxt
+  iban <- parseIbanM ibanTxt
+  when (name /= ptxDescription ptx) $
+    fail "Expected counterparty name for deposit transfer to match primitive description"
+  when (Just iban /= ptxCounterparty ptx) $
+    fail "Expected IBAN for deposit transfer to match and primitive counterparty IBAN"
+  return $
+    DepositTransfer
+      { dtCounterpartyName = name,
+        dtCounterpartyIban = iban,
+        dtDescription = desc,
+        dtReference = ref
+      }
+specificsFromPrim _ ptx@PrimTx {ptxTransactionType = TransferType, ptxDebitCredit = Debit} = do
+  let regex = "^To Oranje spaarrekening ([A-Z0-9]+) Afronding Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
+  (_, _, _, [savingsAccount, valDateTxt]) <-
+    ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
+  assertValueDatePtx ptx valDateTxt
+  return $ RoundingSavingsDeposit {rsdSavingsAccount = savingsAccount}
+specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = IdealType, ptxDebitCredit = Debit} = do
+  let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}) ([0-9]+) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
+  (_, _, _, [name, desc, ibanTxt, timestampTxt, ref, valDateTxt]) <-
+    ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
+  assertValueDatePtx ptx valDateTxt
+  timestamp <- parseTimestampM "%d-%m-%Y %H:%M" amsTz timestampTxt
+  iban <- parseIbanM ibanTxt
+  when (name /= ptxDescription ptx) $
+    fail "Expected counterparty name for iDEAL payment to match primitive description"
+  when (Just iban /= ptxCounterparty ptx) $
+    fail "Expected IBAN for iDEAL payment to match and primitive counterparty IBAN"
+  return $
+    IdealDebit
+      { idCounterpartyName = name,
+        idCounterpartyIban = iban,
+        idDescription = desc,
+        idTimestamp = timestamp,
+        idReference = ref
+      }
+specificsFromPrim _ ptx@PrimTx {ptxTransactionType = BatchPaymentType, ptxDebitCredit = Credit} = do
+  let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
+  (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <-
+    ptxNotifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
+  assertValueDatePtx ptx valDateTxt
+  iban <- parseIbanM ibanTxt
+  when (name /= ptxDescription ptx) $
+    fail "Expected counterparty name for batch payment to match primitive description"
+  when (Just iban /= ptxCounterparty ptx) $
+    fail "Expected IBAN for batch payment to match and primitive counterparty IBAN"
+  return $
+    BatchPayment
+      { bpCounterpartyName = name,
+        bpCounterpartyIban = iban,
+        bpDescription = desc,
+        bpReference = ref
+      }
+specificsFromPrim _ ptx =
+  fail $
+    "Could not extract data from transaction ("
+      ++ show (ptxTransactionType ptx)
+      ++ " / "
+      ++ show (ptxDebitCredit ptx)
+      ++ ")"
+
+txBaseFromPrim :: PrimTx -> TxBase
+txBaseFromPrim =
+  TxBase
+    <$> ptxDate
+    <*> ptxAccount
+    <*> ptxAmount
+    <*> ptxResBal
+    <*> ptxTag
+
+data Tx = Tx TxBase TxSpecifics deriving (Show)
+
+data TxBase = TxBase
+  { txbDate :: !Day,
+    txbAccount :: !Iban,
+    txbAmount :: !Decimal,
+    txbResBal :: !Decimal,
+    txbTag :: !T.Text
+  }
+  deriving (Show)
+
+data TxSpecifics
+  = PaymentTerminalPayment
+      { ptpCounterpartyName :: !T.Text,
+        ptpCardSequenceNo :: !T.Text,
+        ptpTimestamp :: !UTCTime,
+        ptpTransaction :: !T.Text,
+        ptpTerminal :: !T.Text,
+        ptpGooglePay :: !Bool
+      }
+  | PaymentTerminalCashback
+      { ptcCounterpartyName :: !T.Text,
+        ptcCardSequenceNo :: !T.Text,
+        ptcTimestamp :: !UTCTime,
+        ptcTransaction :: !T.Text,
+        ptcTerminal :: !T.Text
+      }
+  | OnlineBankingCredit
+      { obcCounterpartyName :: !T.Text,
+        obcCounterpartyIban :: !Iban,
+        obcDescription :: !T.Text,
+        obcTimestamp :: !UTCTime
+      }
+  | OnlineBankingDebit
+      { obdCounterpartyName :: !T.Text,
+        obdCounterpartyIban :: !Iban,
+        obdDescription :: T.Text,
+        obdTimestamp :: !(Maybe UTCTime)
+      }
+  | RecurrentDirectDebit
+      { rddCounterpartyName :: !T.Text,
+        rddCounterpartyIban :: !Iban,
+        rddDescription :: !T.Text,
+        rddReference :: !T.Text,
+        rddMandateId :: !T.Text,
+        rddCreditorId :: !T.Text,
+        rddOtherParty :: !(Maybe T.Text)
+      }
+  | RoundingSavingsDeposit
+      {rsdSavingsAccount :: !T.Text}
+  | DepositTransfer
+      { dtCounterpartyName :: !T.Text,
+        dtCounterpartyIban :: !Iban,
+        dtDescription :: !T.Text,
+        dtReference :: !T.Text
+      }
+  | IdealDebit
+      { idCounterpartyName :: !T.Text,
+        idCounterpartyIban :: !Iban,
+        idDescription :: !T.Text,
+        idTimestamp :: !UTCTime,
+        idReference :: !T.Text
+      }
+  | BatchPayment
+      { bpCounterpartyName :: !T.Text,
+        bpCounterpartyIban :: !Iban,
+        bpDescription :: !T.Text,
+        bpReference :: !T.Text
+      }
+  deriving (Show)
+
+readFile :: Handle -> IO (V.Vector Tx)
+readFile h = do
+  tz <- loadTZFromDB "Europe/Amsterdam"
+  contents <- BS.hGetContents h
+  primTxs <- case C.decodeByNameWith scsvOptions contents of
+    Left err -> fail err
+    Right
+      ( [ "Date",
+          "Name / Description",
+          "Account",
+          "Counterparty",
+          "Code",
+          "Debit/credit",
+          "Amount (EUR)",
+          "Transaction type",
+          "Notifications",
+          "Resulting balance",
+          "Tag"
+          ],
+        txs
+        ) ->
+        return txs
+    Right _ ->
+      fail "Headers do not match expected pattern"
+  case V.mapM (processPrimTx tz) primTxs of
+    Err err -> fail err
+    Ok txs -> return txs
diff --git a/app/Import/Ing/SavingsAccountCsv.hs b/app/Import/Ing/SavingsAccountCsv.hs
index 3f2e5e6..16b5f92 100644
--- a/app/Import/Ing/SavingsAccountCsv.hs
+++ b/app/Import/Ing/SavingsAccountCsv.hs
@@ -12,7 +12,7 @@ import Data.Maybe (isJust)
 import Data.Text qualified as T
 import Data.Time.Calendar (Day)
 import Data.Vector qualified as V
-import Import.Ing.Shared (dateCP, decimalCP, eitherToCP, ibanCP, maybeCP, scsvOptions)
+import Import.Ing.Shared (maybeCP, parseDateM, parseDecimalM, parseIbanM, scsvOptions)
 import System.IO (Handle)
 import Text.Regex.TDFA ((=~~))
 
@@ -49,7 +49,7 @@ instance MonadFail (Either String) where
 
 txBaseFromPrim :: PrimTx -> Either String TxBase
 txBaseFromPrim ptx@PrimTx {ptxCommodity = "EUR"} =
-  return $ TxBase (ptxDate ptx) (ptxAccountId ptx) (ptxAccountName ptx) (ptxAmount ptx) (ptxResBal ptx)
+  return $ TxBase <$> ptxDate <*> ptxAccountId <*> ptxAccountName <*> ptxAmount <*> ptxResBal $ ptx
 txBaseFromPrim ptx =
   Left $ "Unexpected commodity '" ++ T.unpack (ptxCommodity ptx) ++ "' (expected EUR)"
 
@@ -121,26 +121,25 @@ mutationTypeCP "Opname" = return WithdrawalMutation
 mutationTypeCP "Rente" = return InterestMutation
 mutationTypeCP t = fail ("Unknown mutation type '" ++ T.unpack t ++ "'")
 
-instance C.FromNamedRecord Tx where
+instance C.FromNamedRecord PrimTx where
   parseNamedRecord m =
-    eitherToCP . processPrimTx
-      =<< PrimTx
-        <$> (m .: "Datum" >>= dateCP "%Y-%m-%d")
-        <*> m .: "Omschrijving"
-        <*> m .: "Rekening"
-        <*> m .: "Rekening naam"
-        <*> (m .: "Tegenrekening" >>= maybeCP ibanCP)
-        <*> (m .: "Af Bij" >>= debitCreditCP)
-        <*> (m .: "Bedrag" >>= decimalCP)
-        <*> m .: "Valuta"
-        <*> (m .: "Mutatiesoort" >>= mutationTypeCP)
-        <*> m .: "Mededelingen"
-        <*> (m .: "Saldo na mutatie" >>= decimalCP)
+    PrimTx
+      <$> (m .: "Datum" >>= parseDateM "%Y-%m-%d")
+      <*> m .: "Omschrijving"
+      <*> m .: "Rekening"
+      <*> m .: "Rekening naam"
+      <*> (m .: "Tegenrekening" >>= maybeCP parseIbanM)
+      <*> (m .: "Af Bij" >>= debitCreditCP)
+      <*> (m .: "Bedrag" >>= parseDecimalM)
+      <*> m .: "Valuta"
+      <*> (m .: "Mutatiesoort" >>= mutationTypeCP)
+      <*> m .: "Mededelingen"
+      <*> (m .: "Saldo na mutatie" >>= parseDecimalM)
 
 readFile :: Handle -> IO (V.Vector Tx)
 readFile h = do
   contents <- BS.hGetContents h
-  case C.decodeByNameWith scsvOptions contents of
+  primTxs <- case C.decodeByNameWith scsvOptions contents of
     Left err -> fail err
     Right
       ( [ "Datum",
@@ -160,3 +159,6 @@ readFile h = do
         return txs
     Right _ ->
       fail "Headers do not match expected pattern"
+  case V.mapM processPrimTx primTxs of
+    Left err -> fail err
+    Right txs -> return txs
diff --git a/app/Import/Ing/Shared.hs b/app/Import/Ing/Shared.hs
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)
 
 data DebitCredit = Debit | Credit deriving (Show)
 
-readDecimal :: T.Text -> Either String Decimal
-readDecimal = AP.parseOnly $ do
-  decPart <- AP.decimal
-  _ <- AP.char ','
-  f1 <- AP.digit
-  f2 <- AP.digit
-  AP.endOfInput
-  let fracPart = fromIntegral $ digitToInt f1 * 10 + digitToInt f2
-  return $ normalizeDecimal (Decimal 2 (decPart * 100 + fracPart))
-
 scsvOptions :: C.DecodeOptions
 scsvOptions = C.defaultDecodeOptions {C.decDelimiter = fromIntegral (ord ';')}
 
-eitherToCP :: Either String a -> C.Parser a
-eitherToCP = either fail return
-
-decimalCP :: T.Text -> C.Parser Decimal
-decimalCP = eitherToCP . readDecimal
-
-dateCP :: String -> T.Text -> C.Parser Day
-dateCP fmt = parseTimeM False defaultTimeLocale fmt . T.unpack
-
 maybeCP :: (T.Text -> C.Parser a) -> T.Text -> C.Parser (Maybe a)
 maybeCP p t = if T.null t then return Nothing else Just <$> p t
 
-ibanCP :: T.Text -> C.Parser Iban
-ibanCP = eitherToCP . mkIban
-
-timestampCP :: String -> TZ -> T.Text -> C.Parser UTCTime
-timestampCP fmt amsTz t = do
-  localTime <- parseTimeM False defaultTimeLocale fmt (T.unpack t)
-  return $ localTimeToUTCTZ amsTz localTime
+parseDecimalM :: (MonadFail m) => T.Text -> m Decimal
+parseDecimalM =
+  either fail return
+    . AP.parseOnly
+      ( do
+          decPart <- AP.decimal
+          _ <- AP.char ','
+          f1 <- AP.digit
+          f2 <- AP.digit
+          AP.endOfInput
+          let fracPart = fromIntegral $ digitToInt f1 * 10 + digitToInt f2
+          return $ normalizeDecimal (Decimal 2 (decPart * 100 + fracPart))
+      )
+
+parseIbanM :: (MonadFail m) => T.Text -> m Iban
+parseIbanM = either fail return . mkIban
+
+parseDateM :: (MonadFail m) => String -> T.Text -> m Day
+parseDateM fmt = parseTimeM False defaultTimeLocale fmt . T.unpack
+
+parseTimestampM :: (MonadFail m) => String -> TZ -> T.Text -> m UTCTime
+parseTimestampM fmt amsTz t = do
+  localTimeToUTCTZ amsTz <$> parseTimeM False defaultTimeLocale fmt (T.unpack t)
diff --git a/app/Main.hs b/app/Main.hs
index 403b78f..f5140f2 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -15,8 +15,9 @@ import Brick.Widgets.Core
   )
 import Brick.Widgets.Dialog qualified as D
 import Graphics.Vty qualified as V
-import Import.Ing.SavingsAccountCsv qualified
 import Import.Ing.CurrentAccountCsv qualified
+import Import.Ing.CurrentAccountCsv2 qualified
+import Import.Ing.SavingsAccountCsv qualified
 import System.IO (IOMode (ReadMode), withFile)
 import Text.Pretty.Simple (pPrint)
 
@@ -91,10 +92,10 @@ theApp =
 
 main :: IO ()
 main = do
-  let filename = "/home/rutgerbrf/Code/P/wayligmative/test.csv"
+  let filename = "/home/rutgerbrf/Code/P/wayligmative/test3.csv"
   putStrLn $ "Reading " ++ filename
   withFile filename ReadMode $ \h -> do
-    entries <- Import.Ing.CurrentAccountCsv.readFile h
+    entries <- Import.Ing.CurrentAccountCsv2.readFile h
     pPrint entries
 
 --  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
     hs-source-dirs:   app
     other-modules:
         Data.Iban
+        Data.Res
         Import.Ing.CurrentAccountCsv
+        Import.Ing.CurrentAccountCsv2
         Import.Ing.Shared
         Import.Ing.SavingsAccountCsv