{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE RecordWildCards #-}

-- | Go from various formats to snelstart (ing)
module SnelstartImport.Convert
  ( n26ToING,
    sepaDirectCoreSchemeToING
  )
where

import SnelstartImport.ING
import SnelstartImport.N26
import Data.Text(Text)
import SnelstartImport.SepaDirectCoreScheme

sepaDirectCoreSchemeToING :: SepaGlobals -> SepaDirectCoreScheme -> ING
sepaDirectCoreSchemeToING :: SepaGlobals -> SepaDirectCoreScheme -> ING
sepaDirectCoreSchemeToING SepaGlobals{Text
UTCTime
creDtTm :: UTCTime
cdtrAcct :: Text
creDtTm :: SepaGlobals -> UTCTime
cdtrAcct :: SepaGlobals -> Text
..} SepaDirectCoreScheme{Text
Day
Currency
endToEndId :: Text
dbtrAcct :: Text
dbtr :: Text
instdAmt :: Currency
dtOfSgntr :: Day
rmtInf :: Text
endToEndId :: SepaDirectCoreScheme -> Text
dbtrAcct :: SepaDirectCoreScheme -> Text
dbtr :: SepaDirectCoreScheme -> Text
instdAmt :: SepaDirectCoreScheme -> Currency
dtOfSgntr :: SepaDirectCoreScheme -> Day
rmtInf :: SepaDirectCoreScheme -> Text
..} = ING{
  datum :: UTCTime
datum = UTCTime
creDtTm ,
  naamBescrhijving :: Text
naamBescrhijving = Text
dbtr,
  rekening :: Text
rekening = Text
cdtrAcct,
  tegenRekening :: Text
tegenRekening  = Text
dbtrAcct,
  mutatieSoort :: MutatieSoort
mutatieSoort = MutatieSoort
Overschijving, -- TODO how can we figure this out?
  bijAf :: BijAf
bijAf = BijAf
Bij, -- appaerantly they ony use it for invoices so they add money
  bedragEur :: Currency
bedragEur = Currency
instdAmt ,
  mededeling :: Text
mededeling = Text
rmtInf
  }

n26ToING :: Text -> N26 -> ING
n26ToING :: Text -> N26 -> ING
n26ToING Text
ownAccoun N26{Maybe Currency
Text
Currency
Date
TransactionType
date :: Date
valueDate :: Date
payee :: Text
accountNumber :: Text
transactionType :: TransactionType
paymentReference :: Text
accountName :: Text
amountEur :: Currency
amountForegin :: Maybe Currency
typeForeign :: Text
exchangeRate :: Text
date :: N26 -> Date
valueDate :: N26 -> Date
payee :: N26 -> Text
accountNumber :: N26 -> Text
transactionType :: N26 -> TransactionType
paymentReference :: N26 -> Text
accountName :: N26 -> Text
amountEur :: N26 -> Currency
amountForegin :: N26 -> Maybe Currency
typeForeign :: N26 -> Text
exchangeRate :: N26 -> Text
..} = ING {
  datum :: UTCTime
datum = Date -> UTCTime
unDate Date
date,
  naamBescrhijving :: Text
naamBescrhijving = Text
payee,
  rekening :: Text
rekening = Text
ownAccoun,
  tegenRekening :: Text
tegenRekening  = Text
accountNumber,
  mutatieSoort :: MutatieSoort
mutatieSoort = TransactionType -> MutatieSoort
toType TransactionType
transactionType , -- eg ook voor code
  bijAf :: BijAf
bijAf = if Currency
amountEur Currency -> Currency -> Bool
forall a. Ord a => a -> a -> Bool
< Currency
0 then BijAf
Af else BijAf
Bij,
  bedragEur :: Currency
bedragEur = Currency -> Currency
forall a. Num a => a -> a
abs Currency
amountEur ,
  mededeling :: Text
mededeling = Text
paymentReference
  }

toType :: TransactionType -> MutatieSoort
toType :: TransactionType -> MutatieSoort
toType = \case
  TransactionType
MastercardPayment -> MutatieSoort
Diversen
  TransactionType
OutgoingTransfer -> MutatieSoort
Overschijving
  TransactionType
Income -> MutatieSoort
Overschijving
  TransactionType
N26Referal -> MutatieSoort
Diversen
  TransactionType
DirectDebit -> MutatieSoort
Overschijving