1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
{-# 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 (dateCP, decimalCP, eitherToCP, ibanCP, maybeCP, 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 ptx) (ptxAccountId ptx) (ptxAccountName ptx) (ptxAmount ptx) (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 ++ "'")
parseNamedRecord :: C.NamedRecord -> C.Parser Tx
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)
readFile :: Handle -> IO (V.Vector Tx)
readFile h = do
contents <- BS.hGetContents h
case C.decodeByNameWithP parseNamedRecord 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"
|
