{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}

module Import.Ing.SavingsAccountCsv where

import Data.ByteString.Lazy qualified as BS
import Data.Csv ((.:))
import Data.Csv qualified as C
import Data.Decimal (Decimal)
import Data.Iban (Iban, mkIban)
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 (maybeCP, parseDateM, parseDecimalM, parseIbanM, scsvOptions)
import System.IO (Handle)
import Text.Regex.TDFA ((=~~))

data DebitCredit = Debit | Credit deriving (Show, Eq)

data MutationType = DepositMutation | WithdrawalMutation | InterestMutation deriving (Show)

data TxBase = TxBase
  { txbDate :: !Day,
    txbAccountId :: !T.Text,
    txbAccountName :: !T.Text,
    txbAmount :: !Decimal,
    txbResBal :: !Decimal
  }
  deriving (Show)

data TxSpecifics
  = Interest
  | Withdrawal
      { wToCurrentAccountIban :: !Iban,
        wDescription :: !T.Text
      }
  | Deposit
      { dFromCurrentAccountIban :: !Iban,
        dDescription :: !T.Text
      }
  | CurrentAccountAutoSaveRounding {caasFromCurrentAccountIban :: !Iban}
  deriving (Show)

data Tx = Tx TxBase TxSpecifics deriving (Show)

instance MonadFail (Either String) where
  fail = Left

txBaseFromPrim :: PrimTx -> Either String TxBase
txBaseFromPrim ptx@PrimTx {ptxCommodity = "EUR"} =
  return $ TxBase <$> ptxDate <*> ptxAccountId <*> ptxAccountName <*> ptxAmount <*> ptxResBal $ ptx
txBaseFromPrim ptx =
  Left $ "Unexpected commodity '" ++ T.unpack (ptxCommodity ptx) ++ "' (expected EUR)"

specificsFromPrim :: PrimTx -> Either String TxSpecifics
specificsFromPrim ptx@PrimTx {ptxMutationType = InterestMutation}
  | isJust (ptxCounterparty ptx) = Left "Expected no counterparty for interest transaction"
  | ptxDebitCredit ptx /= Credit =
      Left "Expected interest transaction to be of credit ('Bij') type, got debit ('Af')"
  | not (T.null (ptxNotifications ptx)) =
      Left "Expected no notifications for interest transaction"
  | ptxDescription ptx /= "Rente" =
      Left $ "Expected interest transaction to have description 'Rente', got '" ++ T.unpack (ptxDescription ptx) ++ "'"
  | otherwise = return Interest
specificsFromPrim ptx@PrimTx {ptxMutationType = WithdrawalMutation} = do
  let regex = "Overboeking naar betaalrekening (.*)" :: String
  (_, _, _, [ibanTxt]) <- ptxDescription ptx =~~ regex :: Either String (T.Text, T.Text, T.Text, [T.Text])
  iban <- mkIban ibanTxt
  case ptxCounterparty ptx of
    Nothing -> Left "Expected counterparty for withdrawal transaction"
    Just cpIban ->
      if cpIban /= iban
        then Left "Expected counterparty and IBAN in description to be equal"
        else return $ Withdrawal {wToCurrentAccountIban = iban, wDescription = ptxNotifications ptx}
specificsFromPrim ptx@PrimTx {ptxMutationType = DepositMutation} = do
  let regex = "(Afronding|Overboeking) van betaalrekening (.*)" :: String
  (_, _, _, [ty, ibanTxt]) <- ptxDescription ptx =~~ regex :: Either String (T.Text, T.Text, T.Text, [T.Text])
  iban <- mkIban ibanTxt
  case ptxCounterparty ptx of
    Nothing -> Left "Expected counterparty for deposit transaction"
    Just cpIban ->
      if cpIban /= iban
        then Left "Expected counterparty and IBAN in description to be equal"
        else case ty of
          "Afronding" ->
            if not (T.null (ptxNotifications ptx))
              then
                Left "Expected no notifications for auto-save rounding transaction"
              else return $ CurrentAccountAutoSaveRounding {caasFromCurrentAccountIban = iban}
          "Overboeking" ->
            return $ Deposit {dFromCurrentAccountIban = iban, dDescription = ptxNotifications ptx}
          _ -> error "unreachable"

processPrimTx :: PrimTx -> Either String Tx
processPrimTx ptx = Tx <$> txBaseFromPrim ptx <*> specificsFromPrim ptx

data PrimTx = PrimTx
  { ptxDate :: !Day,
    ptxDescription :: !T.Text,
    ptxAccountId :: !T.Text,
    ptxAccountName :: !T.Text,
    ptxCounterparty :: !(Maybe Iban),
    ptxDebitCredit :: !DebitCredit,
    ptxAmount :: !Decimal,
    ptxCommodity :: !T.Text,
    ptxMutationType :: !MutationType,
    ptxNotifications :: !T.Text,
    ptxResBal :: !Decimal
  }
  deriving (Show)

debitCreditCP :: T.Text -> C.Parser DebitCredit
debitCreditCP "Af" = return Debit
debitCreditCP "Bij" = return Credit
debitCreditCP t = fail ("Unknown debit/credit value '" ++ T.unpack t ++ "'")

mutationTypeCP :: T.Text -> C.Parser MutationType
mutationTypeCP "Inleg" = return DepositMutation
mutationTypeCP "Opname" = return WithdrawalMutation
mutationTypeCP "Rente" = return InterestMutation
mutationTypeCP t = fail ("Unknown mutation type '" ++ T.unpack t ++ "'")

instance C.FromNamedRecord PrimTx where
  parseNamedRecord m =
    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
  primTxs <- case C.decodeByNameWith scsvOptions contents of
    Left err -> fail err
    Right
      ( [ "Datum",
          "Omschrijving",
          "Rekening",
          "Rekening naam",
          "Tegenrekening",
          "Af Bij",
          "Bedrag",
          "Valuta",
          "Mutatiesoort",
          "Mededelingen",
          "Saldo na mutatie"
          ],
        txs
        ) ->
        return txs
    Right _ ->
      fail "Headers do not match expected pattern"
  case V.mapM processPrimTx primTxs of
    Left err -> fail err
    Right txs -> return txs