Slaying

1 files changed, 168 insertions, 172 deletions

diff --git a/app/Import/Ing/CurrentAccountCsv.hs b/app/Import/Ing/CurrentAccountCsv.hs
index d17221d..21ca53d 100644
--- a/app/Import/Ing/CurrentAccountCsv.hs
+++ b/app/Import/Ing/CurrentAccountCsv.hs
@@ -9,6 +9,7 @@ import Data.ByteString.Lazy qualified as BS
 import Data.Csv ((.:))
 import Data.Csv qualified as C
 import Data.Decimal (Decimal)
+import Data.Generics.Product.Subtype (upcast)
 import Data.Iban (Iban)
 import Data.Res (Res (Err, Ok))
 import Data.Text qualified as T
@@ -16,6 +17,7 @@ import Data.Time.Calendar (Day)
 import Data.Time.Clock (UTCTime)
 import Data.Time.Zones (TZ, loadTZFromDB)
 import Data.Vector qualified as V
+import GHC.Generics
 import Import.Ing.Shared
   ( DebitCredit (Credit, Debit),
     maybeCP,
@@ -28,6 +30,77 @@ import Import.Ing.Shared
 import System.IO (Handle)
 import Text.Regex.TDFA ((=~~))
 
+data Tx = Tx TxBase TxSpecifics deriving (Show)
+
+data TxBase = TxBase
+  { date :: !Day,
+    account :: !Iban,
+    amount :: !Decimal,
+    resBal :: !Decimal,
+    tag :: !T.Text
+  }
+  deriving (Show, Generic)
+
+data TxSpecifics
+  = PaymentTerminalPayment
+      { counterpartyName :: !T.Text,
+        cardSequenceNo :: !T.Text,
+        timestamp :: !UTCTime,
+        transaction :: !T.Text,
+        terminal :: !T.Text,
+        googlePay :: !Bool
+      }
+  | PaymentTerminalCashback
+      { counterpartyName :: !T.Text,
+        cardSequenceNo :: !T.Text,
+        timestamp :: !UTCTime,
+        transaction :: !T.Text,
+        terminal :: !T.Text
+      }
+  | OnlineBankingCredit
+      { counterpartyName :: !T.Text,
+        counterpartyIban :: !Iban,
+        description :: !T.Text,
+        timestamp :: !UTCTime
+      }
+  | OnlineBankingDebit
+      { counterpartyName :: !T.Text,
+        counterpartyIban :: !Iban,
+        description :: T.Text,
+        mtimestamp :: !(Maybe UTCTime)
+      }
+  | RecurrentDirectDebit
+      { counterpartyName :: !T.Text,
+        counterpartyIban :: !Iban,
+        description :: !T.Text,
+        reference :: !T.Text,
+        mandateId :: !T.Text,
+        creditorId :: !T.Text,
+        otherParty :: !(Maybe T.Text)
+      }
+  | RoundingSavingsDeposit
+      {savingsAccount :: !T.Text}
+  | DepositTransfer
+      { counterpartyName :: !T.Text,
+        counterpartyIban :: !Iban,
+        description :: !T.Text,
+        reference :: !T.Text
+      }
+  | IdealDebit
+      { counterpartyName :: !T.Text,
+        counterpartyIban :: !Iban,
+        description :: !T.Text,
+        timestamp :: !UTCTime,
+        reference :: !T.Text
+      }
+  | BatchPayment
+      { counterpartyName :: !T.Text,
+        counterpartyIban :: !Iban,
+        description :: !T.Text,
+        reference :: !T.Text
+      }
+  deriving (Show, Generic)
+
 data TransactionType
   = AcceptGiroType -- AC (acceptgiro)
   | AtmWithdrawalType -- GM (geldautomaat, Giromaat)
@@ -72,18 +145,18 @@ 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
+  { date :: !Day,
+    description :: !T.Text,
+    account :: !Iban,
+    counterparty :: !(Maybe Iban),
+    transactionType :: !TransactionType,
+    debitCredit :: !DebitCredit,
+    amount :: !Decimal,
+    notifications :: !T.Text,
+    resBal :: !Decimal,
+    tag :: !T.Text
   }
-  deriving (Show)
+  deriving (Show, Generic)
 
 debitCreditCP :: T.Text -> C.Parser DebitCredit
 debitCreditCP "Debit" = return Debit
@@ -122,265 +195,188 @@ assertValueDate expected t = do
     fail "Expected transaction date and value date to be the same"
 
 assertValueDatePtx :: PrimTx -> T.Text -> Res String ()
-assertValueDatePtx PrimTx {ptxDate = expected} = assertValueDate expected
+assertValueDatePtx PrimTx {date = expected} = assertValueDate expected
 
 specificsFromPrim :: TZ -> PrimTx -> Res String TxSpecifics
-specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = PaymentTerminalType, ptxDebitCredit = Debit} = do
+specificsFromPrim amsTz ptx@PrimTx {transactionType = PaymentTerminalType, debitCredit = 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])
+    ptx.notifications =~~ 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
+      { counterpartyName = ptx.description,
+        cardSequenceNo = cardSeqNo,
+        timestamp = timestamp,
+        transaction = transaction,
+        terminal = if T.null gpayTerm then noGpayTerm else gpayTerm,
+        googlePay = T.null noGpayTerm
       }
-specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = PaymentTerminalType, ptxDebitCredit = Credit} = do
+specificsFromPrim amsTz ptx@PrimTx {transactionType = PaymentTerminalType, debitCredit = 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])
+    notifications 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
+      { counterpartyName = ptx.description,
+        cardSequenceNo = cardSeqNo,
+        timestamp = timestamp,
+        transaction = transaction,
+        terminal = term
       }
-specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = OnlineBankingType, ptxDebitCredit = Credit} = do
+specificsFromPrim amsTz ptx@PrimTx {transactionType = OnlineBankingType, debitCredit = 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])
+    notifications 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) $
+  when (name /= ptx.description) $
     fail "Expected counterparty name for online banking credit to match primitive description"
-  when (Just iban /= ptxCounterparty ptx) $
+  when (Just iban /= ptx.counterparty) $
     fail "Expected IBAN for online banking credit to match and primitive counterparty IBAN"
   return $
     OnlineBankingCredit
-      { obcCounterpartyName = name,
-        obcCounterpartyIban = iban,
-        obcDescription = desc,
-        obcTimestamp = timestamp
+      { counterpartyName = name,
+        counterpartyIban = iban,
+        description = desc,
+        timestamp = timestamp
       }
-specificsFromPrim amsTz ptx@PrimTx {ptxTransactionType = OnlineBankingType, ptxDebitCredit = Debit} = do
+specificsFromPrim amsTz ptx@PrimTx {transactionType = OnlineBankingType, debitCredit = 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])
+    notifications 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) $
+  when (name /= ptx.description) $
     fail "Expected counterparty name for online banking debit to match primitive description"
-  when (Just iban /= ptxCounterparty ptx) $
+  when (Just iban /= ptx.counterparty) $
     fail "Expected IBAN for online banking debit to match and primitive counterparty IBAN"
   return $
     OnlineBankingDebit
-      { obdCounterpartyIban = iban,
-        obdCounterpartyName = name,
-        obdDescription = desc,
-        obdTimestamp = timestamp
+      { counterpartyIban = iban,
+        counterpartyName = name,
+        description = desc,
+        mtimestamp = timestamp
       }
-specificsFromPrim _ ptx@PrimTx {ptxTransactionType = DirectDebitType, ptxDebitCredit = Debit} =
+specificsFromPrim _ ptx@PrimTx {transactionType = DirectDebitType, debitCredit = 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])
+        notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
       assertValueDatePtx ptx valDateTxt
       iban <- parseIbanM ibanTxt
-      when (name /= ptxDescription ptx) $
+      when (name /= ptx.description) $
         fail "Expected counterparty name for direct debit to match primitive description"
-      when (Just iban /= ptxCounterparty ptx) $
+      when (Just iban /= ptx.counterparty) $
         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
+          { counterpartyName = name,
+            counterpartyIban = iban,
+            description = desc,
+            reference = ref,
+            mandateId = mandateId,
+            creditorId = creditorId,
+            otherParty = 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])
+        notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
       iban <- parseIbanM ibanTxt
-      when (name /= ptxDescription ptx) $
+      when (name /= ptx.description) $
         fail "Expected counterparty name for direct debit to match primitive description"
-      when (Just iban /= ptxCounterparty ptx) $
+      when (Just iban /= ptx.counterparty) $
         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
+          { counterpartyName = name,
+            counterpartyIban = iban,
+            description = desc,
+            reference = ref,
+            mandateId = mandateId,
+            creditorId = creditorId,
+            otherParty = Nothing
           }
-specificsFromPrim _ ptx@PrimTx {ptxTransactionType = TransferType, ptxDebitCredit = Credit} = do
+specificsFromPrim _ ptx@PrimTx {transactionType = TransferType, debitCredit = 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])
+    notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
   assertValueDatePtx ptx valDateTxt
   iban <- parseIbanM ibanTxt
-  when (name /= ptxDescription ptx) $
+  when (name /= ptx.description) $
     fail "Expected counterparty name for deposit transfer to match primitive description"
-  when (Just iban /= ptxCounterparty ptx) $
+  when (Just iban /= ptx.counterparty) $
     fail "Expected IBAN for deposit transfer to match and primitive counterparty IBAN"
   return $
     DepositTransfer
-      { dtCounterpartyName = name,
-        dtCounterpartyIban = iban,
-        dtDescription = desc,
-        dtReference = ref
+      { counterpartyName = name,
+        counterpartyIban = iban,
+        description = desc,
+        reference = ref
       }
-specificsFromPrim _ ptx@PrimTx {ptxTransactionType = TransferType, ptxDebitCredit = Debit} = do
+specificsFromPrim _ ptx@PrimTx {transactionType = TransferType, debitCredit = 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])
+    ptx.notifications =~~ 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
+  return $ RoundingSavingsDeposit {savingsAccount = savingsAccount}
+specificsFromPrim amsTz ptx@PrimTx {transactionType = IdealType, debitCredit = 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])
+    notifications 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) $
+  when (name /= ptx.description) $
     fail "Expected counterparty name for iDEAL payment to match primitive description"
-  when (Just iban /= ptxCounterparty ptx) $
+  when (Just iban /= ptx.counterparty) $
     fail "Expected IBAN for iDEAL payment to match and primitive counterparty IBAN"
   return $
     IdealDebit
-      { idCounterpartyName = name,
-        idCounterpartyIban = iban,
-        idDescription = desc,
-        idTimestamp = timestamp,
-        idReference = ref
+      { counterpartyName = name,
+        counterpartyIban = iban,
+        description = desc,
+        timestamp = timestamp,
+        reference = ref
       }
-specificsFromPrim _ ptx@PrimTx {ptxTransactionType = BatchPaymentType, ptxDebitCredit = Credit} = do
+specificsFromPrim _ ptx@PrimTx {transactionType = BatchPaymentType, debitCredit = 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])
+    notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
   assertValueDatePtx ptx valDateTxt
   iban <- parseIbanM ibanTxt
-  when (name /= ptxDescription ptx) $
+  when (name /= ptx.description) $
     fail "Expected counterparty name for batch payment to match primitive description"
-  when (Just iban /= ptxCounterparty ptx) $
+  when (Just iban /= ptx.counterparty) $
     fail "Expected IBAN for batch payment to match and primitive counterparty IBAN"
   return $
     BatchPayment
-      { bpCounterpartyName = name,
-        bpCounterpartyIban = iban,
-        bpDescription = desc,
-        bpReference = ref
+      { counterpartyName = name,
+        counterpartyIban = iban,
+        description = desc,
+        reference = ref
       }
 specificsFromPrim _ ptx =
   fail $
     "Could not extract data from transaction ("
-      ++ show (ptxTransactionType ptx)
+      ++ show (transactionType ptx)
       ++ " / "
-      ++ show (ptxDebitCredit ptx)
+      ++ show (debitCredit 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)
+txBaseFromPrim = upcast
 
 readFile :: Handle -> IO (V.Vector Tx)
 readFile h = do