summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.envrc1
-rw-r--r--.gitignore2
-rw-r--r--.ocamlformat0
-rw-r--r--app/Data/Iban.hs48
-rw-r--r--app/Data/Ledger.hs115
-rw-r--r--app/Data/Ledger/AutoFile.hs1
-rw-r--r--app/Data/Res.hs31
-rw-r--r--app/Format.hs3
-rw-r--r--app/Import/Ing/Convert.hs257
-rw-r--r--app/Import/Ing/CurrentAccountCsv.hs407
-rw-r--r--app/Import/Ing/SavingsAccountCsv.hs164
-rw-r--r--app/Import/Ing/Shared.hs44
-rw-r--r--app/Main.hs4
-rw-r--r--bin/dune4
-rw-r--r--bin/main.ml1
-rw-r--r--dune-project26
-rw-r--r--lib/dune5
-rw-r--r--lib/iban.ml87
-rw-r--r--lib/iban.mli8
-rw-r--r--lib/ingcsv.ml487
-rw-r--r--lib/ledger.ml110
-rw-r--r--rdcapsis.cabal47
-rw-r--r--rdcapsis.opam39
-rw-r--r--test/dune2
-rw-r--r--test/test_rdcapsis.ml0
25 files changed, 772 insertions, 1121 deletions
diff --git a/.envrc b/.envrc
new file mode 100644
index 0000000..a62ca0a
--- /dev/null
+++ b/.envrc
@@ -0,0 +1 @@
eval $(opam env)
diff --git a/.gitignore b/.gitignore
index 4bfa210..c4c4112 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,3 +1,5 @@
1.\#* 1.\#*
2\#*\# 2\#*\#
3*~ 3*~
4_build/
5_opam/
diff --git a/.ocamlformat b/.ocamlformat
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/.ocamlformat
diff --git a/app/Data/Iban.hs b/app/Data/Iban.hs
deleted file mode 100644
index d9566b9..0000000
--- a/app/Data/Iban.hs
+++ /dev/null
@@ -1,48 +0,0 @@
1module Data.Iban (Iban, mkIban, toText) where
2
3import Control.Applicative ((<|>))
4import Data.Attoparsec.Text as AP
5import Data.Char
6 ( digitToInt,
7 isAscii,
8 isDigit,
9 ord,
10 toUpper,
11 )
12import Data.Text qualified as T
13
14newtype Iban = Iban T.Text deriving (Show, Eq)
15
16mkIban :: T.Text -> Either String Iban
17mkIban t = validateIban t >> return (Iban t)
18
19validateIban :: T.Text -> Either String ()
20validateIban = AP.parseOnly $ do
21 countryCode <- AP.count 2 AP.letter
22 checkDigits <- AP.count 2 AP.digit
23 chars <- AP.many1 (AP.letter <|> AP.digit)
24 endOfInput
25 if length chars < 30
26 then
27 if valid countryCode checkDigits chars
28 then return ()
29 else fail $ "IBAN checksum does not match (" ++ countryCode ++ checkDigits ++ chars ++ ")"
30 else fail "IBAN has more than 34 characters"
31 where
32 letterToInt c = ord (toUpper c) - ord 'A' + 10
33 charsToInteger =
34 foldl'
35 ( \acc -> \case
36 d
37 | isDigit d -> acc * 10 + toInteger (digitToInt d)
38 | isAscii d -> acc * 100 + toInteger (letterToInt d)
39 | otherwise -> error "unreachable"
40 )
41 0
42 ibanToInteger countryCode checkDigits chars =
43 charsToInteger chars * 1000000 + charsToInteger countryCode * 100 + charsToInteger checkDigits
44 valid countryCode checkDigits chars =
45 ibanToInteger countryCode checkDigits chars `mod` 97 == 1
46
47toText :: Iban -> T.Text
48toText (Iban t) = t
diff --git a/app/Data/Ledger.hs b/app/Data/Ledger.hs
deleted file mode 100644
index 4aa5137..0000000
--- a/app/Data/Ledger.hs
+++ /dev/null
@@ -1,115 +0,0 @@
1{-# LANGUAGE TemplateHaskell #-}
2{-# LANGUAGE TypeFamilies #-}
3
4module Data.Ledger where
5
6import Data.Constraint.Extras.TH (deriveArgDict)
7import Data.Dependent.Map (DMap, fromList, singleton, union, unionWithKey)
8import Data.Dependent.Sum ((==>))
9import Data.Functor.Identity
10import Data.Functor.Identity (Identity (..))
11import Data.GADT.Compare.TH (deriveGCompare, deriveGEq)
12import Data.GADT.Show.TH (deriveGShow)
13import Data.Iban
14import Data.Map qualified as M
15import Data.Text qualified as T
16import Data.Time.Calendar
17import Data.Time.Clock
18import Data.UUID
19import GHC.Generics
20
21data AccountType = Asset | Equity | Liability | Expense | Income
22
23data TxAction = Inc | Dec
24
25txaOpp :: TxAction -> TxAction
26txaOpp Inc = Dec
27txaOpp Dec = Inc
28
29onDebit :: AccountType -> TxAction
30onDebit Asset = Inc
31onDebit Equity = Dec
32onDebit Liability = Dec
33onDebit Expense = Inc
34onDebit Income = Dec
35
36onCredit :: AccountType -> TxAction
37onCredit = txaOpp . onDebit
38
39data TxType
40 = InterestCtx
41 | OnlineBankingTx
42 | RecurrentDirectTx
43 | PaymentTerminalTx
44 | CashPaymentTx
45 | AtmTx
46 | AutoSaveRoundingTx
47 | BatchTx
48 | DirectDebitTx
49 | PeriodicTx
50
51data IbanTag = AccountTag | CounterpartyIbanTag deriving (Eq, Enum, Ord, Show)
52
53data UnitTag = FiledTag | GooglePayTag | AutoRoundSavingsTag deriving (Eq, Enum, Ord, Show)
54
55data TextTag = DescTag | UserTag | CounterpartyNameTag | ReferenceTag | MandateIdTag | CreditorIdTag | OtherPartyTag | TransactionTag | TerminalTag | CardSeqNoTag | SavingsAccountTag deriving (Eq, Enum, Ord, Show)
56
57data Label a where
58 TextLabel :: TextTag -> Label T.Text
59 IbanLabel :: IbanTag -> Label Iban
60 UnitLabel :: UnitTag -> Label ()
61 TimestampLabel :: Label UTCTime
62
63deriveGEq ''Label
64deriveGCompare ''Label
65deriveGShow ''Label
66deriveArgDict ''Label
67
68type Labels = DMap Label Identity
69
70data Money = Money Integer deriving (Show)
71
72infixl 6 +€, -€
73
74(+€) :: Money -> Money -> Money
75Money x +€ Money y = Money (x + y)
76
77(-€) :: Money -> Money -> Money
78Money x -€ Money y = Money (x - y)
79
80data Scalar = Amount Money | Rate Integer deriving (Show)
81
82data AccountId = AccountId [T.Text] deriving (Show)
83
84data CommodityId = CommodityId UUID deriving (Show)
85
86data Account = Account
87 { id :: AccountId,
88 description :: [T.Text],
89 commodityId :: CommodityId,
90 balance :: Money
91 }
92
93-- A balance assertion is only valid when all transactions before it have been
94-- cleared and the balance of the account agrees with the amount in the
95-- assertion.
96data BalAssert = BalAssert
97 { account :: AccountId,
98 amount :: Money,
99 labels :: Labels
100 }
101
102data Tx = Tx
103 { cleared :: Maybe Day,
104 commodityId :: CommodityId, -- the commodity w.r.t. which rates are calculated
105 debit :: M.Map AccountId Scalar,
106 credit :: M.Map AccountId Scalar,
107 labels :: Labels
108 }
109 deriving (Show, Generic)
110
111-- data SeqTx = SeqTx [Integer] Tx
112
113data Entry = TxEntry Tx | BalAssertEntry BalAssert
114
115data Ledger = Ledger [Entry]
diff --git a/app/Data/Ledger/AutoFile.hs b/app/Data/Ledger/AutoFile.hs
deleted file mode 100644
index 15a1b16..0000000
--- a/app/Data/Ledger/AutoFile.hs
+++ /dev/null
@@ -1 +0,0 @@
1module Data.Ledger.AutoFile where
diff --git a/app/Data/Res.hs b/app/Data/Res.hs
deleted file mode 100644
index 3806e5a..0000000
--- a/app/Data/Res.hs
+++ /dev/null
@@ -1,31 +0,0 @@
1module Data.Res where
2
3import Control.Applicative
4import Data.String (IsString (fromString))
5
6data Res e r = Ok r | Err e
7
8instance Functor (Res e) where
9 fmap f (Ok v) = Ok (f v)
10 fmap _ (Err e) = Err e
11
12instance Applicative (Res e) where
13 pure = Ok
14 (Ok f) <*> (Ok v) = Ok (f v)
15 (Err e) <*> _ = Err e
16 _ <*> (Err e) = Err e
17
18instance Monad (Res e) where
19 (Ok v) >>= f = f v
20 (Err e) >>= _ = Err e
21
22instance (IsString e) => MonadFail (Res e) where
23 fail = Err . fromString
24
25instance (IsString e) => Alternative (Res e) where
26 empty = fail "mzero"
27 m1@(Ok _) <|> _ = m1
28 (Err _) <|> m2 = m2
29
30liftEither :: Either e r -> Res e r
31liftEither = either Err Ok
diff --git a/app/Format.hs b/app/Format.hs
deleted file mode 100644
index a779d95..0000000
--- a/app/Format.hs
+++ /dev/null
@@ -1,3 +0,0 @@
1module Format where
2
3import Text.Parsec
diff --git a/app/Import/Ing/Convert.hs b/app/Import/Ing/Convert.hs
deleted file mode 100644
index 5dcda0b..0000000
--- a/app/Import/Ing/Convert.hs
+++ /dev/null
@@ -1,257 +0,0 @@
1module Import.Ing.Convert where
2
3import Control.Monad (when)
4import Data.Decimal
5import Data.Dependent.Map
6import Data.Dependent.Sum ((==>))
7import Data.Functor.Identity
8import Data.Iban qualified as Iban
9import Data.Ledger as L
10import Data.Map qualified as M
11import Data.Res
12import Data.Text qualified as T
13import Import.Ing.CurrentAccountCsv as C
14import Import.Ing.SavingsAccountCsv as S
15
16virtCheckingAcc :: L.AccountId
17virtCheckingAcc = AccountId ["Unfiled", "Checking"]
18
19virtSavingsAcc :: L.AccountId
20virtSavingsAcc = AccountId ["Unfiled", "Savings"]
21
22virtCounterparty :: L.AccountId
23virtCounterparty = AccountId ["Unfiled", "Counterparty"]
24
25toCents :: Decimal -> Res String L.Money
26toCents m
27 | f == 0 =
28 return (L.Money m')
29 | otherwise =
30 fail "Cannot convert to whole cents: amount of money is more specific"
31 where
32 (m', f) = properFraction (m * 100)
33
34condUnitLabel :: UnitTag -> Bool -> L.Labels
35condUnitLabel _ False = empty
36condUnitLabel t True = singleton (UnitLabel t) (Identity ())
37
38lesFromCurrentAcc :: CommodityId -> C.Tx -> Res String [L.Entry]
39lesFromCurrentAcc eucId tx@(C.Tx base _) = do
40 tx' <- txFromCurrentAcc eucId tx
41 ba <- baFromCurrentAccBase base
42 return [BalAssertEntry ba, TxEntry tx']
43
44baFromCurrentAccBase :: C.TxBase -> Res String L.BalAssert
45baFromCurrentAccBase base = do
46 resBal <- toCents base.resBal
47 return $
48 L.BalAssert
49 { account = virtCheckingAcc,
50 amount = resBal,
51 labels =
52 fromList [IbanLabel AccountTag ==> base.account]
53 }
54
55baFromCurrentAcc :: C.Tx -> Res String L.BalAssert
56baFromCurrentAcc (C.Tx base _) = baFromCurrentAccBase base
57
58txFromCurrentAcc :: CommodityId -> C.Tx -> Res String L.Tx
59txFromCurrentAcc eucId (C.Tx base spec) = do
60 when (base.amount < 0) $
61 fail "Transaction amount may not be lower than zero"
62 amount <- L.Amount <$> toCents base.amount
63 case spec of
64 PaymentTerminalPayment
65 { counterpartyName,
66 cardSequenceNo,
67 timestamp,
68 transaction,
69 terminal,
70 googlePay
71 } ->
72 return $
73 L.Tx
74 { cleared = Just base.date,
75 commodityId = eucId,
76 credit = M.singleton virtCheckingAcc amount,
77 debit = M.singleton virtCounterparty amount,
78 labels =
79 fromList
80 [ IbanLabel AccountTag ==> base.account,
81 TextLabel CounterpartyNameTag ==> counterpartyName,
82 TextLabel CardSeqNoTag ==> cardSequenceNo,
83 TextLabel TerminalTag ==> terminal,
84 TextLabel TransactionTag ==> transaction,
85 TimestampLabel ==> timestamp
86 ]
87 `union` condUnitLabel GooglePayTag googlePay
88 }
89 PaymentTerminalCashback
90 { counterpartyName,
91 cardSequenceNo,
92 timestamp,
93 transaction,
94 terminal
95 } ->
96 return $
97 L.Tx
98 { cleared = Just base.date,
99 commodityId = eucId,
100 debit = M.singleton virtCheckingAcc amount,
101 credit = M.singleton virtCounterparty amount,
102 labels =
103 fromList
104 [ IbanLabel AccountTag ==> base.account,
105 TextLabel CounterpartyNameTag ==> counterpartyName,
106 TextLabel CardSeqNoTag ==> cardSequenceNo,
107 TextLabel TerminalTag ==> terminal,
108 TextLabel TransactionTag ==> transaction,
109 TimestampLabel ==> timestamp
110 ]
111 }
112 OnlineBankingCredit
113 { counterpartyName,
114 counterpartyIban,
115 description,
116 timestamp
117 } ->
118 return $
119 L.Tx
120 { cleared = Just base.date,
121 commodityId = eucId,
122 debit = M.singleton virtCheckingAcc amount,
123 credit = M.singleton virtCounterparty amount,
124 labels =
125 fromList
126 [ IbanLabel AccountTag ==> base.account,
127 TextLabel CounterpartyNameTag ==> counterpartyName,
128 IbanLabel CounterpartyIbanTag ==> counterpartyIban,
129 TextLabel DescTag ==> description,
130 TimestampLabel ==> timestamp
131 ]
132 }
133 OnlineBankingDebit
134 { counterpartyName,
135 counterpartyIban,
136 description,
137 mtimestamp
138 } ->
139 return $
140 L.Tx
141 { cleared = Just base.date,
142 commodityId = eucId,
143 debit = M.singleton virtCounterparty amount,
144 credit = M.singleton virtCheckingAcc amount,
145 labels =
146 fromList
147 [ IbanLabel AccountTag ==> base.account,
148 TextLabel CounterpartyNameTag ==> counterpartyName,
149 IbanLabel CounterpartyIbanTag ==> counterpartyIban,
150 TextLabel DescTag ==> description
151 ]
152 `union` (maybe empty (singleton TimestampLabel . Identity) mtimestamp)
153 }
154 RecurrentDirectDebit
155 { counterpartyName,
156 counterpartyIban,
157 description,
158 reference,
159 mandateId,
160 creditorId,
161 otherParty
162 } ->
163 return $
164 L.Tx
165 { cleared = Just base.date,
166 commodityId = eucId,
167 credit = M.singleton virtCheckingAcc amount,
168 debit = M.singleton virtCounterparty amount,
169 labels =
170 fromList
171 [ IbanLabel AccountTag ==> base.account,
172 IbanLabel CounterpartyIbanTag ==> counterpartyIban,
173 TextLabel CounterpartyNameTag ==> counterpartyName,
174 TextLabel DescTag ==> description,
175 TextLabel ReferenceTag ==> reference,
176 TextLabel MandateIdTag ==> mandateId,
177 TextLabel CreditorIdTag ==> creditorId
178 ]
179 `union` (maybe empty (singleton (TextLabel OtherPartyTag) . Identity) otherParty)
180 }
181 RoundingSavingsDeposit
182 { savingsAccount
183 } ->
184 return $
185 L.Tx
186 { cleared = Just base.date,
187 commodityId = eucId,
188 credit = M.singleton virtCheckingAcc amount,
189 debit = M.singleton virtSavingsAcc amount,
190 labels =
191 fromList
192 [ UnitLabel AutoRoundSavingsTag ==> (),
193 TextLabel SavingsAccountTag ==> savingsAccount
194 ]
195 }
196 DepositTransfer
197 { counterpartyName,
198 counterpartyIban,
199 description,
200 reference
201 } ->
202 return $
203 L.Tx
204 { cleared = Just base.date,
205 commodityId = eucId,
206 debit = M.singleton virtCheckingAcc amount,
207 credit = M.singleton virtCounterparty amount,
208 labels =
209 fromList
210 [ IbanLabel CounterpartyIbanTag ==> counterpartyIban,
211 TextLabel CounterpartyNameTag ==> counterpartyName,
212 TextLabel DescTag ==> description,
213 TextLabel ReferenceTag ==> reference
214 ]
215 }
216 IdealDebit
217 { counterpartyName,
218 counterpartyIban,
219 description,
220 timestamp,
221 reference
222 } ->
223 return $
224 L.Tx
225 { cleared = Just base.date,
226 commodityId = eucId,
227 debit = M.singleton virtCheckingAcc amount,
228 credit = M.singleton virtCounterparty amount,
229 labels =
230 fromList
231 [ IbanLabel CounterpartyIbanTag ==> counterpartyIban,
232 TextLabel CounterpartyNameTag ==> counterpartyName,
233 TextLabel DescTag ==> description,
234 TextLabel ReferenceTag ==> reference,
235 TimestampLabel ==> timestamp
236 ]
237 }
238 BatchPayment
239 { counterpartyName,
240 counterpartyIban,
241 description,
242 reference
243 } ->
244 return $
245 L.Tx
246 { cleared = Just base.date,
247 commodityId = eucId,
248 debit = M.singleton virtCheckingAcc amount,
249 credit = M.singleton virtCounterparty amount,
250 labels =
251 fromList
252 [ IbanLabel CounterpartyIbanTag ==> counterpartyIban,
253 TextLabel CounterpartyNameTag ==> counterpartyName,
254 TextLabel DescTag ==> description,
255 TextLabel ReferenceTag ==> reference
256 ]
257 }
diff --git a/app/Import/Ing/CurrentAccountCsv.hs b/app/Import/Ing/CurrentAccountCsv.hs
deleted file mode 100644
index 21ca53d..0000000
--- a/app/Import/Ing/CurrentAccountCsv.hs
+++ /dev/null
@@ -1,407 +0,0 @@
1{-# LANGUAGE OverloadedLists #-}
2{-# LANGUAGE OverloadedStrings #-}
3
4module Import.Ing.CurrentAccountCsv where
5
6import Control.Applicative ((<|>))
7import Control.Monad (when)
8import Data.ByteString.Lazy qualified as BS
9import Data.Csv ((.:))
10import Data.Csv qualified as C
11import Data.Decimal (Decimal)
12import Data.Generics.Product.Subtype (upcast)
13import Data.Iban (Iban)
14import Data.Res (Res (Err, Ok))
15import Data.Text qualified as T
16import Data.Time.Calendar (Day)
17import Data.Time.Clock (UTCTime)
18import Data.Time.Zones (TZ, loadTZFromDB)
19import Data.Vector qualified as V
20import GHC.Generics
21import Import.Ing.Shared
22 ( DebitCredit (Credit, Debit),
23 maybeCP,
24 parseDateM,
25 parseDecimalM,
26 parseIbanM,
27 parseTimestampM,
28 scsvOptions,
29 )
30import System.IO (Handle)
31import Text.Regex.TDFA ((=~~))
32
33data Tx = Tx TxBase TxSpecifics deriving (Show)
34
35data TxBase = TxBase
36 { date :: !Day,
37 account :: !Iban,
38 amount :: !Decimal,
39 resBal :: !Decimal,
40 tag :: !T.Text
41 }
42 deriving (Show, Generic)
43
44data TxSpecifics
45 = PaymentTerminalPayment
46 { counterpartyName :: !T.Text,
47 cardSequenceNo :: !T.Text,
48 timestamp :: !UTCTime,
49 transaction :: !T.Text,
50 terminal :: !T.Text,
51 googlePay :: !Bool
52 }
53 | PaymentTerminalCashback
54 { counterpartyName :: !T.Text,
55 cardSequenceNo :: !T.Text,
56 timestamp :: !UTCTime,
57 transaction :: !T.Text,
58 terminal :: !T.Text
59 }
60 | OnlineBankingCredit
61 { counterpartyName :: !T.Text,
62 counterpartyIban :: !Iban,
63 description :: !T.Text,
64 timestamp :: !UTCTime
65 }
66 | OnlineBankingDebit
67 { counterpartyName :: !T.Text,
68 counterpartyIban :: !Iban,
69 description :: T.Text,
70 mtimestamp :: !(Maybe UTCTime)
71 }
72 | RecurrentDirectDebit
73 { counterpartyName :: !T.Text,
74 counterpartyIban :: !Iban,
75 description :: !T.Text,
76 reference :: !T.Text,
77 mandateId :: !T.Text,
78 creditorId :: !T.Text,
79 otherParty :: !(Maybe T.Text)
80 }
81 | RoundingSavingsDeposit
82 {savingsAccount :: !T.Text}
83 | DepositTransfer
84 { counterpartyName :: !T.Text,
85 counterpartyIban :: !Iban,
86 description :: !T.Text,
87 reference :: !T.Text
88 }
89 | IdealDebit
90 { counterpartyName :: !T.Text,
91 counterpartyIban :: !Iban,
92 description :: !T.Text,
93 timestamp :: !UTCTime,
94 reference :: !T.Text
95 }
96 | BatchPayment
97 { counterpartyName :: !T.Text,
98 counterpartyIban :: !Iban,
99 description :: !T.Text,
100 reference :: !T.Text
101 }
102 deriving (Show, Generic)
103
104data TransactionType
105 = AcceptGiroType -- AC (acceptgiro)
106 | AtmWithdrawalType -- GM (geldautomaat, Giromaat)
107 | BatchPaymentType -- VZ (verzamelbetaling); 'Batch payment'
108 | BranchPostingType -- FL (filiaalboeking)
109 | DepositType -- ST (storting)
110 | DirectDebitType -- IC (incasso); 'SEPA direct debit'
111 | IdealType -- ID (iDEAL); 'iDEAL'
112 | OnlineBankingType -- GT (internetbankieren, Girotel); 'Online Banking'
113 | OfficeWithdrawalType -- PK (opname kantoor, postkantoor)
114 | PaymentTerminalType -- BA (betaalautomaat); 'Payment terminal'
115 | PeriodicTransferType -- PO (periodieke overschrijving)
116 | PhoneBankingType -- GF (telefonisch bankieren, Girofoon)
117 | TransferType -- OV (overboeking); 'Transfer'
118 | VariousType -- DV (diversen)
119 deriving (Eq, Show)
120
121parseCode :: T.Text -> C.Parser TransactionType
122parseCode "AC" = return AcceptGiroType
123parseCode "GM" = return AtmWithdrawalType
124parseCode "VZ" = return BatchPaymentType
125parseCode "FL" = return BranchPostingType
126parseCode "ST" = return DepositType
127parseCode "IC" = return DirectDebitType
128parseCode "ID" = return IdealType
129parseCode "GT" = return OnlineBankingType
130parseCode "PK" = return OfficeWithdrawalType
131parseCode "BA" = return PaymentTerminalType
132parseCode "PO" = return PeriodicTransferType
133parseCode "GF" = return PhoneBankingType
134parseCode "OV" = return TransferType
135parseCode "DV" = return VariousType
136parseCode t = fail $ "Unknown transaction code '" ++ T.unpack t ++ "'"
137
138parseType :: T.Text -> C.Parser TransactionType
139parseType "SEPA direct debit" = return DirectDebitType
140parseType "Batch payment" = return BatchPaymentType
141parseType "Online Banking" = return OnlineBankingType
142parseType "Payment terminal" = return PaymentTerminalType
143parseType "Transfer" = return TransferType
144parseType "iDEAL" = return IdealType
145parseType t = fail $ "Unknown transaction type '" ++ T.unpack t ++ "'"
146
147data PrimTx = PrimTx
148 { date :: !Day,
149 description :: !T.Text,
150 account :: !Iban,
151 counterparty :: !(Maybe Iban),
152 transactionType :: !TransactionType,
153 debitCredit :: !DebitCredit,
154 amount :: !Decimal,
155 notifications :: !T.Text,
156 resBal :: !Decimal,
157 tag :: !T.Text
158 }
159 deriving (Show, Generic)
160
161debitCreditCP :: T.Text -> C.Parser DebitCredit
162debitCreditCP "Debit" = return Debit
163debitCreditCP "Credit" = return Credit
164debitCreditCP t = fail ("Unknown debit/credit value '" ++ T.unpack t ++ "'")
165
166instance C.FromNamedRecord PrimTx where
167 parseNamedRecord m = do
168 code <- m .: "Code" >>= parseCode
169 txType <- m .: "Transaction type" >>= parseType
170 if code /= txType
171 then fail "Expected code and transaction type to agree"
172 else
173 PrimTx
174 <$> (m .: "Date" >>= parseDateM "%0Y%m%d")
175 <*> m .: "Name / Description"
176 <*> (m .: "Account" >>= parseIbanM)
177 <*> (m .: "Counterparty" >>= maybeCP parseIbanM)
178 <*> return txType
179 <*> (m .: "Debit/credit" >>= debitCreditCP)
180 <*> (m .: "Amount (EUR)" >>= parseDecimalM)
181 <*> m .: "Notifications"
182 <*> (m .: "Resulting balance" >>= parseDecimalM)
183 <*> m .: "Tag"
184
185processPrimTx :: TZ -> PrimTx -> Res String Tx
186processPrimTx amsTz ptx = Tx (txBaseFromPrim ptx) <$> specificsFromPrim amsTz ptx
187
188parseValueDate :: T.Text -> Res String Day
189parseValueDate = parseDateM "%d/%m/%Y"
190
191assertValueDate :: Day -> T.Text -> Res String ()
192assertValueDate expected t = do
193 valDate <- parseDateM "%d/%m/%Y" t
194 when (valDate /= expected) $
195 fail "Expected transaction date and value date to be the same"
196
197assertValueDatePtx :: PrimTx -> T.Text -> Res String ()
198assertValueDatePtx PrimTx {date = expected} = assertValueDate expected
199
200specificsFromPrim :: TZ -> PrimTx -> Res String TxSpecifics
201specificsFromPrim amsTz ptx@PrimTx {transactionType = PaymentTerminalType, debitCredit = Debit} = do
202 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
203 (_, _, _, [cardSeqNo, timestampTxt, transaction, _, gpayTerm, noGpayTerm, valDateTxt]) <-
204 ptx.notifications =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
205 assertValueDatePtx ptx valDateTxt
206 timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt
207 return $
208 PaymentTerminalPayment
209 { counterpartyName = ptx.description,
210 cardSequenceNo = cardSeqNo,
211 timestamp = timestamp,
212 transaction = transaction,
213 terminal = if T.null gpayTerm then noGpayTerm else gpayTerm,
214 googlePay = T.null noGpayTerm
215 }
216specificsFromPrim amsTz ptx@PrimTx {transactionType = PaymentTerminalType, debitCredit = Credit} = do
217 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
218 (_, _, _, [cardSeqNo, timestampTxt, transaction, term, valDateTxt]) <-
219 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
220 assertValueDatePtx ptx valDateTxt
221 timestamp <- parseTimestampM "%d/%m/%Y %H:%M" amsTz timestampTxt
222 return $
223 PaymentTerminalCashback
224 { counterpartyName = ptx.description,
225 cardSequenceNo = cardSeqNo,
226 timestamp = timestamp,
227 transaction = transaction,
228 terminal = term
229 }
230specificsFromPrim amsTz ptx@PrimTx {transactionType = OnlineBankingType, debitCredit = Credit} = do
231 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
232 (_, _, _, [name, desc, ibanTxt, timestampTxt, valDateTxt]) <-
233 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
234 assertValueDatePtx ptx valDateTxt
235 iban <- parseIbanM ibanTxt
236 timestamp <- parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt
237 when (name /= ptx.description) $
238 fail "Expected counterparty name for online banking credit to match primitive description"
239 when (Just iban /= ptx.counterparty) $
240 fail "Expected IBAN for online banking credit to match and primitive counterparty IBAN"
241 return $
242 OnlineBankingCredit
243 { counterpartyName = name,
244 counterpartyIban = iban,
245 description = desc,
246 timestamp = timestamp
247 }
248specificsFromPrim amsTz ptx@PrimTx {transactionType = OnlineBankingType, debitCredit = Debit} = do
249 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
250 (_, _, _, [name, desc, ibanTxt, _, timestampTxt, valDateTxt]) <-
251 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
252 assertValueDatePtx ptx valDateTxt
253 iban <- parseIbanM ibanTxt
254 timestamp <-
255 if T.null timestampTxt
256 then pure Nothing
257 else Just <$> parseTimestampM "%d-%m-%Y %H:%M:%S" amsTz timestampTxt
258 when (name /= ptx.description) $
259 fail "Expected counterparty name for online banking debit to match primitive description"
260 when (Just iban /= ptx.counterparty) $
261 fail "Expected IBAN for online banking debit to match and primitive counterparty IBAN"
262 return $
263 OnlineBankingDebit
264 { counterpartyIban = iban,
265 counterpartyName = name,
266 description = desc,
267 mtimestamp = timestamp
268 }
269specificsFromPrim _ ptx@PrimTx {transactionType = DirectDebitType, debitCredit = Debit} =
270 normalRecurrentDirectDebit <|> ingInsurancePayment
271 where
272 normalRecurrentDirectDebit = do
273 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
274 (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId, _, otherParty, valDateTxt]) <-
275 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
276 assertValueDatePtx ptx valDateTxt
277 iban <- parseIbanM ibanTxt
278 when (name /= ptx.description) $
279 fail "Expected counterparty name for direct debit to match primitive description"
280 when (Just iban /= ptx.counterparty) $
281 fail "Expected IBAN for direct debit to match and primitive counterparty IBAN"
282 return $
283 RecurrentDirectDebit
284 { counterpartyName = name,
285 counterpartyIban = iban,
286 description = desc,
287 reference = ref,
288 mandateId = mandateId,
289 creditorId = creditorId,
290 otherParty = if T.null otherParty then Nothing else Just otherParty
291 }
292 ingInsurancePayment = do
293 let regex = "^Name: (.* ING Verzekeren) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit$" :: String
294 (_, _, _, [name, desc, ibanTxt, ref, mandateId, creditorId]) <-
295 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
296 iban <- parseIbanM ibanTxt
297 when (name /= ptx.description) $
298 fail "Expected counterparty name for direct debit to match primitive description"
299 when (Just iban /= ptx.counterparty) $
300 fail "Expected IBAN for direct debit to match and primitive counterparty IBAN"
301 return $
302 RecurrentDirectDebit
303 { counterpartyName = name,
304 counterpartyIban = iban,
305 description = desc,
306 reference = ref,
307 mandateId = mandateId,
308 creditorId = creditorId,
309 otherParty = Nothing
310 }
311specificsFromPrim _ ptx@PrimTx {transactionType = TransferType, debitCredit = Credit} = do
312 let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
313 (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <-
314 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
315 assertValueDatePtx ptx valDateTxt
316 iban <- parseIbanM ibanTxt
317 when (name /= ptx.description) $
318 fail "Expected counterparty name for deposit transfer to match primitive description"
319 when (Just iban /= ptx.counterparty) $
320 fail "Expected IBAN for deposit transfer to match and primitive counterparty IBAN"
321 return $
322 DepositTransfer
323 { counterpartyName = name,
324 counterpartyIban = iban,
325 description = desc,
326 reference = ref
327 }
328specificsFromPrim _ ptx@PrimTx {transactionType = TransferType, debitCredit = Debit} = do
329 let regex = "^To Oranje spaarrekening ([A-Z0-9]+) Afronding Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
330 (_, _, _, [savingsAccount, valDateTxt]) <-
331 ptx.notifications =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
332 assertValueDatePtx ptx valDateTxt
333 return $ RoundingSavingsDeposit {savingsAccount = savingsAccount}
334specificsFromPrim amsTz ptx@PrimTx {transactionType = IdealType, debitCredit = Debit} = do
335 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
336 (_, _, _, [name, desc, ibanTxt, timestampTxt, ref, valDateTxt]) <-
337 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
338 assertValueDatePtx ptx valDateTxt
339 timestamp <- parseTimestampM "%d-%m-%Y %H:%M" amsTz timestampTxt
340 iban <- parseIbanM ibanTxt
341 when (name /= ptx.description) $
342 fail "Expected counterparty name for iDEAL payment to match primitive description"
343 when (Just iban /= ptx.counterparty) $
344 fail "Expected IBAN for iDEAL payment to match and primitive counterparty IBAN"
345 return $
346 IdealDebit
347 { counterpartyName = name,
348 counterpartyIban = iban,
349 description = desc,
350 timestamp = timestamp,
351 reference = ref
352 }
353specificsFromPrim _ ptx@PrimTx {transactionType = BatchPaymentType, debitCredit = Credit} = do
354 let regex = "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$" :: String
355 (_, _, _, [name, desc, ibanTxt, ref, valDateTxt]) <-
356 notifications ptx =~~ regex :: Res String (T.Text, T.Text, T.Text, [T.Text])
357 assertValueDatePtx ptx valDateTxt
358 iban <- parseIbanM ibanTxt
359 when (name /= ptx.description) $
360 fail "Expected counterparty name for batch payment to match primitive description"
361 when (Just iban /= ptx.counterparty) $
362 fail "Expected IBAN for batch payment to match and primitive counterparty IBAN"
363 return $
364 BatchPayment
365 { counterpartyName = name,
366 counterpartyIban = iban,
367 description = desc,
368 reference = ref
369 }
370specificsFromPrim _ ptx =
371 fail $
372 "Could not extract data from transaction ("
373 ++ show (transactionType ptx)
374 ++ " / "
375 ++ show (debitCredit ptx)
376 ++ ")"
377
378txBaseFromPrim :: PrimTx -> TxBase
379txBaseFromPrim = upcast
380
381readFile :: Handle -> IO (V.Vector Tx)
382readFile h = do
383 tz <- loadTZFromDB "Europe/Amsterdam"
384 contents <- BS.hGetContents h
385 primTxs <- case C.decodeByNameWith scsvOptions contents of
386 Left err -> fail err
387 Right
388 ( [ "Date",
389 "Name / Description",
390 "Account",
391 "Counterparty",
392 "Code",
393 "Debit/credit",
394 "Amount (EUR)",
395 "Transaction type",
396 "Notifications",
397 "Resulting balance",
398 "Tag"
399 ],
400 txs
401 ) ->
402 return txs
403 Right _ ->
404 fail "Headers do not match expected pattern"
405 case V.mapM (processPrimTx tz) primTxs of
406 Err err -> fail err
407 Ok txs -> return txs
diff --git a/app/Import/Ing/SavingsAccountCsv.hs b/app/Import/Ing/SavingsAccountCsv.hs
deleted file mode 100644
index 16b5f92..0000000
--- a/app/Import/Ing/SavingsAccountCsv.hs
+++ /dev/null
@@ -1,164 +0,0 @@
1{-# LANGUAGE OverloadedLists #-}
2{-# LANGUAGE OverloadedStrings #-}
3
4module Import.Ing.SavingsAccountCsv where
5
6import Data.ByteString.Lazy qualified as BS
7import Data.Csv ((.:))
8import Data.Csv qualified as C
9import Data.Decimal (Decimal)
10import Data.Iban (Iban, mkIban)
11import Data.Maybe (isJust)
12import Data.Text qualified as T
13import Data.Time.Calendar (Day)
14import Data.Vector qualified as V
15import Import.Ing.Shared (maybeCP, parseDateM, parseDecimalM, parseIbanM, scsvOptions)
16import System.IO (Handle)
17import Text.Regex.TDFA ((=~~))
18
19data DebitCredit = Debit | Credit deriving (Show, Eq)
20
21data MutationType = DepositMutation | WithdrawalMutation | InterestMutation deriving (Show)
22
23data TxBase = TxBase
24 { txbDate :: !Day,
25 txbAccountId :: !T.Text,
26 txbAccountName :: !T.Text,
27 txbAmount :: !Decimal,
28 txbResBal :: !Decimal
29 }
30 deriving (Show)
31
32data TxSpecifics
33 = Interest
34 | Withdrawal
35 { wToCurrentAccountIban :: !Iban,
36 wDescription :: !T.Text
37 }
38 | Deposit
39 { dFromCurrentAccountIban :: !Iban,
40 dDescription :: !T.Text
41 }
42 | CurrentAccountAutoSaveRounding {caasFromCurrentAccountIban :: !Iban}
43 deriving (Show)
44
45data Tx = Tx TxBase TxSpecifics deriving (Show)
46
47instance MonadFail (Either String) where
48 fail = Left
49
50txBaseFromPrim :: PrimTx -> Either String TxBase
51txBaseFromPrim ptx@PrimTx {ptxCommodity = "EUR"} =
52 return $ TxBase <$> ptxDate <*> ptxAccountId <*> ptxAccountName <*> ptxAmount <*> ptxResBal $ ptx
53txBaseFromPrim ptx =
54 Left $ "Unexpected commodity '" ++ T.unpack (ptxCommodity ptx) ++ "' (expected EUR)"
55
56specificsFromPrim :: PrimTx -> Either String TxSpecifics
57specificsFromPrim ptx@PrimTx {ptxMutationType = InterestMutation}
58 | isJust (ptxCounterparty ptx) = Left "Expected no counterparty for interest transaction"
59 | ptxDebitCredit ptx /= Credit =
60 Left "Expected interest transaction to be of credit ('Bij') type, got debit ('Af')"
61 | not (T.null (ptxNotifications ptx)) =
62 Left "Expected no notifications for interest transaction"
63 | ptxDescription ptx /= "Rente" =
64 Left $ "Expected interest transaction to have description 'Rente', got '" ++ T.unpack (ptxDescription ptx) ++ "'"
65 | otherwise = return Interest
66specificsFromPrim ptx@PrimTx {ptxMutationType = WithdrawalMutation} = do
67 let regex = "Overboeking naar betaalrekening (.*)" :: String
68 (_, _, _, [ibanTxt]) <- ptxDescription ptx =~~ regex :: Either String (T.Text, T.Text, T.Text, [T.Text])
69 iban <- mkIban ibanTxt
70 case ptxCounterparty ptx of
71 Nothing -> Left "Expected counterparty for withdrawal transaction"
72 Just cpIban ->
73 if cpIban /= iban
74 then Left "Expected counterparty and IBAN in description to be equal"
75 else return $ Withdrawal {wToCurrentAccountIban = iban, wDescription = ptxNotifications ptx}
76specificsFromPrim ptx@PrimTx {ptxMutationType = DepositMutation} = do
77 let regex = "(Afronding|Overboeking) van betaalrekening (.*)" :: String
78 (_, _, _, [ty, ibanTxt]) <- ptxDescription ptx =~~ regex :: Either String (T.Text, T.Text, T.Text, [T.Text])
79 iban <- mkIban ibanTxt
80 case ptxCounterparty ptx of
81 Nothing -> Left "Expected counterparty for deposit transaction"
82 Just cpIban ->
83 if cpIban /= iban
84 then Left "Expected counterparty and IBAN in description to be equal"
85 else case ty of
86 "Afronding" ->
87 if not (T.null (ptxNotifications ptx))
88 then
89 Left "Expected no notifications for auto-save rounding transaction"
90 else return $ CurrentAccountAutoSaveRounding {caasFromCurrentAccountIban = iban}
91 "Overboeking" ->
92 return $ Deposit {dFromCurrentAccountIban = iban, dDescription = ptxNotifications ptx}
93 _ -> error "unreachable"
94
95processPrimTx :: PrimTx -> Either String Tx
96processPrimTx ptx = Tx <$> txBaseFromPrim ptx <*> specificsFromPrim ptx
97
98data PrimTx = PrimTx
99 { ptxDate :: !Day,
100 ptxDescription :: !T.Text,
101 ptxAccountId :: !T.Text,
102 ptxAccountName :: !T.Text,
103 ptxCounterparty :: !(Maybe Iban),
104 ptxDebitCredit :: !DebitCredit,
105 ptxAmount :: !Decimal,
106 ptxCommodity :: !T.Text,
107 ptxMutationType :: !MutationType,
108 ptxNotifications :: !T.Text,
109 ptxResBal :: !Decimal
110 }
111 deriving (Show)
112
113debitCreditCP :: T.Text -> C.Parser DebitCredit
114debitCreditCP "Af" = return Debit
115debitCreditCP "Bij" = return Credit
116debitCreditCP t = fail ("Unknown debit/credit value '" ++ T.unpack t ++ "'")
117
118mutationTypeCP :: T.Text -> C.Parser MutationType
119mutationTypeCP "Inleg" = return DepositMutation
120mutationTypeCP "Opname" = return WithdrawalMutation
121mutationTypeCP "Rente" = return InterestMutation
122mutationTypeCP t = fail ("Unknown mutation type '" ++ T.unpack t ++ "'")
123
124instance C.FromNamedRecord PrimTx where
125 parseNamedRecord m =
126 PrimTx
127 <$> (m .: "Datum" >>= parseDateM "%Y-%m-%d")
128 <*> m .: "Omschrijving"
129 <*> m .: "Rekening"
130 <*> m .: "Rekening naam"
131 <*> (m .: "Tegenrekening" >>= maybeCP parseIbanM)
132 <*> (m .: "Af Bij" >>= debitCreditCP)
133 <*> (m .: "Bedrag" >>= parseDecimalM)
134 <*> m .: "Valuta"
135 <*> (m .: "Mutatiesoort" >>= mutationTypeCP)
136 <*> m .: "Mededelingen"
137 <*> (m .: "Saldo na mutatie" >>= parseDecimalM)
138
139readFile :: Handle -> IO (V.Vector Tx)
140readFile h = do
141 contents <- BS.hGetContents h
142 primTxs <- case C.decodeByNameWith scsvOptions contents of
143 Left err -> fail err
144 Right
145 ( [ "Datum",
146 "Omschrijving",
147 "Rekening",
148 "Rekening naam",
149 "Tegenrekening",
150 "Af Bij",
151 "Bedrag",
152 "Valuta",
153 "Mutatiesoort",
154 "Mededelingen",
155 "Saldo na mutatie"
156 ],
157 txs
158 ) ->
159 return txs
160 Right _ ->
161 fail "Headers do not match expected pattern"
162 case V.mapM processPrimTx primTxs of
163 Left err -> fail err
164 Right txs -> return txs
diff --git a/app/Import/Ing/Shared.hs b/app/Import/Ing/Shared.hs
deleted file mode 100644
index b5d1703..0000000
--- a/app/Import/Ing/Shared.hs
+++ /dev/null
@@ -1,44 +0,0 @@
1module Import.Ing.Shared where
2
3import Data.Attoparsec.Text qualified as AP
4import Data.Char (digitToInt, ord)
5import Data.Csv qualified as C
6import Data.Decimal (Decimal, DecimalRaw (Decimal), normalizeDecimal)
7import Data.Iban (Iban, mkIban)
8import Data.Text qualified as T
9import Data.Time.Calendar (Day)
10import Data.Time.Clock (UTCTime)
11import Data.Time.Format (defaultTimeLocale, parseTimeM)
12import Data.Time.Zones (TZ, localTimeToUTCTZ)
13
14data DebitCredit = Debit | Credit deriving (Show)
15
16scsvOptions :: C.DecodeOptions
17scsvOptions = C.defaultDecodeOptions {C.decDelimiter = fromIntegral (ord ';')}
18
19maybeCP :: (T.Text -> C.Parser a) -> T.Text -> C.Parser (Maybe a)
20maybeCP p t = if T.null t then return Nothing else Just <$> p t
21
22parseDecimalM :: (MonadFail m) => T.Text -> m Decimal
23parseDecimalM =
24 either fail return
25 . AP.parseOnly
26 ( do
27 decPart <- AP.decimal
28 _ <- AP.char ','
29 f1 <- AP.digit
30 f2 <- AP.digit
31 AP.endOfInput
32 let fracPart = fromIntegral $ digitToInt f1 * 10 + digitToInt f2
33 return $ normalizeDecimal (Decimal 2 (decPart * 100 + fracPart))
34 )
35
36parseIbanM :: (MonadFail m) => T.Text -> m Iban
37parseIbanM = either fail return . mkIban
38
39parseDateM :: (MonadFail m) => String -> T.Text -> m Day
40parseDateM fmt = parseTimeM False defaultTimeLocale fmt . T.unpack
41
42parseTimestampM :: (MonadFail m) => String -> TZ -> T.Text -> m UTCTime
43parseTimestampM fmt amsTz t = do
44 localTimeToUTCTZ amsTz <$> parseTimeM False defaultTimeLocale fmt (T.unpack t)
diff --git a/app/Main.hs b/app/Main.hs
deleted file mode 100644
index 82505bf..0000000
--- a/app/Main.hs
+++ /dev/null
@@ -1,4 +0,0 @@
1module Main where
2
3main :: IO ()
4main = putStrLn "Hello!"
diff --git a/bin/dune b/bin/dune
new file mode 100644
index 0000000..b82e38f
--- /dev/null
+++ b/bin/dune
@@ -0,0 +1,4 @@
1(executable
2 (public_name rdcapsis)
3 (name main)
4 (libraries rdcapsis))
diff --git a/bin/main.ml b/bin/main.ml
new file mode 100644
index 0000000..7bf6048
--- /dev/null
+++ b/bin/main.ml
@@ -0,0 +1 @@
let () = print_endline "Hello, World!"
diff --git a/dune-project b/dune-project
new file mode 100644
index 0000000..00fe620
--- /dev/null
+++ b/dune-project
@@ -0,0 +1,26 @@
1(lang dune 3.17)
2
3(name rdcapsis)
4
5(generate_opam_files true)
6
7(source
8 (github username/reponame))
9
10(authors "Author Name <[email protected]>")
11
12(maintainers "Maintainer Name <[email protected]>")
13
14(license LICENSE)
15
16(documentation https://url/to/documentation)
17
18(package
19 (name rdcapsis)
20 (synopsis "A short synopsis")
21 (description "A longer description")
22 (depends ocaml zarith core dmap delimited_parsing re (utop :dev) (merlin :dev) (ocamlformat :dev))
23 (tags
24 ("add topics" "to describe" your project)))
25
26; See the complete stanza docs at https://dune.readthedocs.io/en/stable/reference/dune-project/index.html
diff --git a/lib/dune b/lib/dune
new file mode 100644
index 0000000..ff9a2ee
--- /dev/null
+++ b/lib/dune
@@ -0,0 +1,5 @@
1(library
2 (name rdcapsis)
3 (preprocess
4 (pps ppx_jane))
5 (libraries core zarith dmap delimited_parsing re core_unix.date_unix))
diff --git a/lib/iban.ml b/lib/iban.ml
new file mode 100644
index 0000000..6e47e9d
--- /dev/null
+++ b/lib/iban.ml
@@ -0,0 +1,87 @@
1open Core
2open Option.Let_syntax
3
4type t = string
5
6(* Modulo-97 arithmetic. Prevents us from having to use Zarith here. *)
7module M97 : sig
8 type t
9
10 val of_int : int -> t
11 val lt : t -> t -> bool
12 val equal : t -> t -> bool
13 val ( * ) : t -> t -> t
14 val ( + ) : t -> t -> t
15 val ( ~$ ) : int -> t
16end = struct
17 type t = int
18
19 let of_int x = x % 97
20 let equal = Int.( = )
21 let lt = Int.( < )
22 let ( * ) x y = x * y % 97
23 let ( + ) x y = (x + y) % 97
24 let ( ~$ ) = of_int
25end
26
27let m97_of_alnum c =
28 let v = Char.to_int c in
29 if Char.is_digit c then Some (M97.of_int (v - Char.to_int '0'))
30 else if Char.is_alpha c then
31 if Char.is_lowercase c then Some (M97.of_int (v - Char.to_int 'a' + 10))
32 else Some (M97.of_int (v - Char.to_int 'A' + 10))
33 else None
34
35let m97_of_digit c =
36 match m97_of_alnum c with Some v when M97.(lt v ~$10) -> Some v | _ -> None
37
38let m97_of_alpha c =
39 match m97_of_alnum c with
40 | Some v when not M97.(lt v ~$10) -> Some v
41 | _ -> None
42
43let string_fold_option ~(init : 'a) ~(f : 'a -> char -> 'a option) s =
44 let rec go i (acc : 'a) : 'a option =
45 if i >= String.length s then Some acc
46 else Option.(f acc (String.unsafe_get s i) >>= go (i + 1))
47 in
48 go 0 init
49
50let m97_of_iban s =
51 string_fold_option s ~init:`In_country1 ~f:(fun st c ->
52 match st with
53 | `In_country1 ->
54 let%map co1 = m97_of_alpha c in
55 `In_country2 co1
56 | `In_country2 co1 ->
57 let%map co2 = m97_of_alpha c in
58 `In_check1 M97.((co1 * ~$100) + co2)
59 | `In_check1 co ->
60 let%map ch1 = m97_of_digit c in
61 `In_check2 (co, ch1)
62 | `In_check2 (co, ch1) ->
63 let%map ch2 = m97_of_digit c in
64 `In_bban M97.(co, (ch1 * ~$10) + ch2, ~$0)
65 | `In_bban (co, ch, bban) ->
66 let%map v = m97_of_alnum c in
67 let bban' =
68 M97.(if lt v ~$10 then (bban * ~$10) + v else (bban * ~$100) + v)
69 in
70 `In_bban (co, ch, bban'))
71 |> function
72 | Some (`In_bban (co, ch, bban)) ->
73 Some M97.((bban * ~$1000000) + (co * ~$100) + ch)
74 | _ -> None
75
76let check_iban s =
77 String.length s <= 34 && Option.exists (m97_of_iban s) ~f:M97.(equal ~$1)
78
79let make s : t option = if check_iban s then Some s else None
80let to_string = Fn.id
81
82let of_string s =
83 match make s with
84 | Some iban -> iban
85 | None -> Printf.failwithf "Iban.of_string: %S" s ()
86
87let equal = String.equal
diff --git a/lib/iban.mli b/lib/iban.mli
new file mode 100644
index 0000000..944928c
--- /dev/null
+++ b/lib/iban.mli
@@ -0,0 +1,8 @@
1open Core
2
3type t
4
5val make : string -> t option
6
7include Stringable.S with type t := t
8include Equal.S with type t := t
diff --git a/lib/ingcsv.ml b/lib/ingcsv.ml
new file mode 100644
index 0000000..a8eba51
--- /dev/null
+++ b/lib/ingcsv.ml
@@ -0,0 +1,487 @@
1open Core
2module Time_ns = Time_ns_unix
3
4module Debit_credit = struct
5 type t = Debit | Credit
6
7 let of_string = function
8 | "Debit" -> Debit
9 | "Credit" -> Credit
10 | s -> Printf.failwithf "DebitCredit.of_string: %S" s ()
11
12 let to_string = function Debit -> "Debit" | Credit -> "Credit"
13end
14
15module Cents = struct
16 type t = Z.t
17
18 let of_string s =
19 (* TODO: consider being more bitchy here *)
20 String.lsplit2_exn s ~on:',' |> Tuple2.map ~f:Z.of_string
21 |> fun (high, low) -> Z.((high * ~$100) + low)
22end
23
24module Transaction_type = struct
25 type t =
26 | Accept_giro (* AC (acceptgiro) *)
27 | Atm_withdrawal (* GM (geldautomaat, Giromaat) *)
28 | Batch_payment (* VZ (verzamelbetaling); 'Batch payment' *)
29 | Branch_posting (* FL (filiaalboeking) *)
30 | Deposit (* ST (storting) *)
31 | Direct_debit (* IC (incasso); 'SEPA direct debit' *)
32 | Ideal (* ID (iDEAL); 'iDEAL' *)
33 | Online_banking (* GT (internetbankieren, Girotel); 'Online Banking' *)
34 | Office_withdrawal (* PK (opname kantoor, postkantoor) *)
35 | Payment_terminal (* BA (betaalautomaat); 'Payment terminal' *)
36 | Periodic_transfer (* PO (periodieke overschrijving) *)
37 | Phone_banking (* GF (telefonisch bankieren, Girofoon) *)
38 | Transfer (* OV (overboeking); 'Transfer' *)
39 | Various (* DV (diversen) *)
40 [@@deriving equal, string]
41
42 let of_code = function
43 | "AC" -> Accept_giro
44 | "GM" -> Atm_withdrawal
45 | "VZ" -> Batch_payment
46 | "FL" -> Branch_posting
47 | "ST" -> Deposit
48 | "IC" -> Direct_debit
49 | "ID" -> Ideal
50 | "GT" -> Online_banking
51 | "PK" -> Office_withdrawal
52 | "BA" -> Payment_terminal
53 | "PO" -> Periodic_transfer
54 | "GF" -> Phone_banking
55 | "OV" -> Transfer
56 | "DV" -> Various
57 | s -> Printf.failwithf "TransactionType.of_code: %S" s ()
58
59 let of_type = function
60 | "SEPA direct debit" -> Direct_debit
61 | "Batch payment" -> Batch_payment
62 | "Online Banking" -> Online_banking
63 | "Payment terminal" -> Payment_terminal
64 | "Transfer" -> Transfer
65 | "iDEAL" -> Ideal
66 | s -> Printf.failwithf "TransactionType.of_type: %S" s ()
67end
68
69module Primitive_tx = struct
70 type t = {
71 date : Date.t;
72 description : string;
73 account : Iban.t;
74 counterparty : Iban.t option;
75 type_ : Transaction_type.t;
76 debit_credit : Debit_credit.t;
77 amount : Cents.t;
78 notifications : string;
79 resulting_balance : Cents.t;
80 tag : string;
81 }
82 [@@deriving fields]
83
84 let opt_field (f : string -> 'a) (v : string) : 'a option =
85 if String.is_empty (String.strip v) then None else Some (f v)
86
87 let parse : t Delimited.Read.t =
88 let open Delimited.Read.Let_syntax in
89 let%map_open date = at_header "Date" ~f:Date.of_string
90 and description = at_header "Name / Description" ~f:Fn.id
91 and account = at_header "Account" ~f:Iban.of_string
92 and counterparty = at_header "Counterparty" ~f:(opt_field Iban.of_string)
93 and code = at_header "Code" ~f:Transaction_type.of_code
94 and debit_credit = at_header "Debit/credit" ~f:Debit_credit.of_string
95 and amount = at_header "Amount (EUR)" ~f:Cents.of_string
96 and type_ = at_header "Transaction type" ~f:Transaction_type.of_type
97 and notifications = at_header "Notifications" ~f:Fn.id
98 and resulting_balance = at_header "Resulting balance" ~f:Cents.of_string
99 and tag = at_header "Tag" ~f:Fn.id in
100 if not ([%equal: Transaction_type.t] code type_) then
101 Printf.failwithf
102 "Primitive_tx.parse: parsed transaction code (%S) and type (%S) do not \
103 match"
104 (Transaction_type.to_string code)
105 (Transaction_type.to_string type_)
106 ();
107 {
108 date;
109 description;
110 account;
111 counterparty;
112 type_;
113 debit_credit;
114 amount;
115 notifications;
116 resulting_balance;
117 tag;
118 }
119end
120
121type tx_base = {
122 date : Date.t;
123 account : Iban.t;
124 amount : Cents.t;
125 res_bal : Cents.t;
126 tag : string;
127}
128
129type tx_specifics =
130 | Payment_terminal_payment of {
131 counterparty_name : string;
132 card_sequence_no : string;
133 timestamp : Time_ns.t;
134 transaction : string;
135 terminal : string;
136 google_pay : bool;
137 }
138 | Payment_terminal_cashback of {
139 counterparty_name : string;
140 card_sequence_no : string;
141 timestamp : Time_ns.t;
142 transaction : string;
143 terminal : string;
144 }
145 | Online_banking_credit of {
146 counterparty_name : string;
147 counterparty_iban : Iban.t;
148 description : string;
149 timestamp : Time_ns.t;
150 }
151 | Online_banking_debit of {
152 counterparty_name : string;
153 counterparty_iban : Iban.t;
154 description : string;
155 mtimestamp : Time_ns.t option;
156 }
157 | Recurrent_direct_debit of {
158 counterparty_name : string;
159 counterparty_iban : Iban.t;
160 description : string;
161 reference : string;
162 mandate_id : string;
163 creditor_id : string;
164 other_party : string option;
165 }
166 | Rounding_savings_deposit of { savings_account : string }
167 | Deposit of {
168 counterparty_name : string;
169 counterparty_iban : Iban.t;
170 description : string;
171 reference : string;
172 }
173 | Ideal_debit of {
174 counterparty_name : string;
175 counterparty_iban : Iban.t;
176 description : string;
177 timestamp : Time_ns.t;
178 reference : string;
179 }
180 | Batch_payment of {
181 counterparty_name : string;
182 counterparty_iban : Iban.t;
183 description : string;
184 reference : string;
185 }
186
187type tx = Tx of tx_base * tx_specifics
188
189let assert_value_date (ptx : Primitive_tx.t) s =
190 let val_date = Date_unix.parse s ~fmt:"%d/%m/%Y" in
191 if not Date.(val_date = ptx.date) then
192 failwith
193 "assert_value_date: expected transaction date and value date to be the \
194 same"
195
196let[@warning "-8"] specifics_from_prim_exn (ams_tz : Time_ns.Zone.t) :
197 Primitive_tx.t -> tx_specifics = function
198 | { type_ = Payment_terminal; debit_credit = Debit; _ } as ptx ->
199 let regex =
200 Re.Pcre.regexp
201 "^Card sequence no.: ([0-9]+) ? ([0-9]{2}/[0-9]{2}/[0-9]{4} \
202 [0-9]{2}:[0-9]{2}) Transaction: (.*) Term: ((.+) Google Pay|(.+)) \
203 Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
204 in
205 let [|
206 _;
207 card_seq_no;
208 timestamp_str;
209 transaction;
210 _;
211 gpay_term;
212 no_gpay_term;
213 val_date_str;
214 |] =
215 Re.Pcre.extract ~rex:regex ptx.notifications
216 in
217 assert_value_date ptx val_date_str;
218 let timestamp =
219 Time_ns.parse timestamp_str ~allow_trailing_input:false
220 ~fmt:"%d/%m/%Y %H:%M" ~zone:ams_tz
221 in
222 Payment_terminal_payment
223 {
224 counterparty_name = ptx.description;
225 card_sequence_no = card_seq_no;
226 timestamp;
227 transaction;
228 terminal =
229 (if String.is_empty gpay_term then no_gpay_term else gpay_term);
230 google_pay = String.is_empty no_gpay_term;
231 }
232 | { type_ = Payment_terminal; debit_credit = Credit; _ } as ptx ->
233 let regex =
234 Re.Pcre.regexp
235 "^Card sequence no.: ([0-9]+) ? ([0-9]{2}/[0-9]{2}/[0-9]{4} \
236 [0-9]{2}:[0-9]{2}) Transaction: (.*) Term: (.*) Cashback \
237 transaction Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
238 in
239 let [| _; card_seq_no; timestamp_str; transaction; term; val_date_str |] =
240 Re.Pcre.extract ~rex:regex ptx.notifications
241 in
242 assert_value_date ptx val_date_str;
243 let timestamp =
244 Time_ns.parse timestamp_str ~allow_trailing_input:false
245 ~fmt:"%d/%m/%Y %H:%M" ~zone:ams_tz
246 in
247 Payment_terminal_cashback
248 {
249 counterparty_name = ptx.description;
250 card_sequence_no = card_seq_no;
251 timestamp;
252 transaction;
253 terminal = term;
254 }
255 | { type_ = Online_banking; debit_credit = Credit; _ } as ptx ->
256 let regex =
257 Re.Pcre.regexp
258 "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Date/time: \
259 ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}:[0-9]{2}) Value date: \
260 ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
261 in
262 let [| _; name; desc; iban_str; timestamp_str; val_date_str |] =
263 Re.Pcre.extract ~rex:regex ptx.notifications
264 in
265 assert_value_date ptx val_date_str;
266 let iban = Iban.of_string iban_str
267 and timestamp =
268 Time_ns.parse timestamp_str ~allow_trailing_input:false
269 ~fmt:"%d-%m-%Y %H:%M:%S" ~zone:ams_tz
270 in
271 if not String.(name = ptx.description) then
272 failwith
273 "specifics_from_prim (Online_banking/Credit): expected counterparty \
274 name to match primitive description";
275 if not (Option.equal Iban.equal (Some iban) ptx.counterparty) then
276 failwith
277 "specifics_from_prim (Online_banking/Credit): expected IBAN to match \
278 and primitive counterparty IBAN";
279 Online_banking_credit
280 {
281 counterparty_name = name;
282 counterparty_iban = iban;
283 description = desc;
284 timestamp;
285 }
286 | { type_ = Online_banking; debit_credit = Debit; _ } as ptx ->
287 let regex =
288 Re.Pcre.regexp
289 "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) (Date/time: \
290 ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}:[0-9]{2}) )?Value \
291 date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
292 in
293 let [| _; name; desc; iban_str; _; timestamp_str; val_date_str |] =
294 Re.Pcre.extract ~rex:regex ptx.notifications
295 in
296 assert_value_date ptx val_date_str;
297 let iban = Iban.of_string iban_str
298 and mtimestamp =
299 if String.is_empty timestamp_str then None
300 else
301 Some
302 (Time_ns.parse timestamp_str ~allow_trailing_input:false
303 ~fmt:"%d-%m-%Y %H:%M:%S" ~zone:ams_tz)
304 in
305 if not String.(name = ptx.description) then
306 failwith
307 "specifics_from_prim (Online_banking/Debit): expected counterparty \
308 name to match primitive description";
309 if not (Option.equal Iban.equal (Some iban) ptx.counterparty) then
310 failwith
311 "specifics_from_prim (Online_banking/Debit): expected IBAN to match \
312 and primitive counterparty IBAN";
313 Online_banking_debit
314 {
315 counterparty_name = name;
316 counterparty_iban = iban;
317 description = desc;
318 mtimestamp;
319 }
320 | { type_ = Direct_debit; debit_credit = Debit; _ } as ptx
321 when String.is_suffix ptx.notifications
322 ~suffix:"Recurrent SEPA direct debit" ->
323 let regex =
324 Re.Pcre.regexp
325 "^Name: (.* ING Verzekeren) Description: (.*) IBAN: ([A-Z0-9]+) \
326 Reference: (.*) Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA \
327 direct debit$"
328 in
329 let [| _; name; desc; iban_str; ref_; mandate_id; creditor_id |] =
330 Re.Pcre.extract ~rex:regex ptx.notifications
331 in
332 let iban = Iban.of_string iban_str in
333 if not String.(name = ptx.description) then
334 failwith
335 "specifics_from_prim (Direct_debit/Debit): expected counterparty \
336 name to match primitive description";
337 if not (Option.equal Iban.equal (Some iban) ptx.counterparty) then
338 failwith
339 "specifics_from_prim (Direct_debit/Debit): expected IBAN to match \
340 and primitive counterparty IBAN";
341 Recurrent_direct_debit
342 {
343 counterparty_name = name;
344 counterparty_iban = iban;
345 description = desc;
346 reference = ref_;
347 mandate_id;
348 creditor_id;
349 other_party = None;
350 }
351 | { type_ = Direct_debit; debit_credit = Debit; _ } as ptx ->
352 let regex =
353 Re.Pcre.regexp
354 "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) \
355 Mandate ID: (.*) Creditor ID: (.*) Recurrent SEPA direct debit \
356 (Other party: (.*) )?Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
357 in
358 let [|
359 _;
360 name;
361 desc;
362 iban_str;
363 ref_;
364 mandate_id;
365 creditor_id;
366 _;
367 other_party;
368 val_date_str;
369 |] =
370 Re.Pcre.extract ~rex:regex ptx.notifications
371 in
372 assert_value_date ptx val_date_str;
373 let iban = Iban.of_string iban_str in
374 if not String.(name = ptx.description) then
375 failwith
376 "specifics_from_prim (Direct_debit/Debit): expected counterparty \
377 name to match primitive description";
378 if not (Option.equal Iban.equal (Some iban) ptx.counterparty) then
379 failwith
380 "specifics_from_prim (Direct_debit/Debit): expected IBAN to match \
381 and primitive counterparty IBAN";
382 Recurrent_direct_debit
383 {
384 counterparty_name = name;
385 counterparty_iban = iban;
386 description = desc;
387 reference = ref_;
388 mandate_id;
389 creditor_id;
390 other_party =
391 (if String.is_empty other_party then None else Some other_party);
392 }
393 | { type_ = Transfer; debit_credit = Credit; _ } as ptx ->
394 let regex =
395 Re.Pcre.regexp
396 "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) \
397 Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
398 in
399 let [| _; name; desc; iban_str; ref_; val_date_str |] =
400 Re.Pcre.extract ~rex:regex ptx.notifications
401 in
402 assert_value_date ptx val_date_str;
403 let iban = Iban.of_string iban_str in
404 if not String.(name = ptx.description) then
405 failwith
406 "specifics_from_prim (Transfer/Credit): expected counterparty name \
407 to match primitive description";
408 if not (Option.equal Iban.equal (Some iban) ptx.counterparty) then
409 failwith
410 "specifics_from_prim (Direct_debit/Debit): expected IBAN to match \
411 and primitive counterparty IBAN";
412 Deposit
413 {
414 counterparty_name = name;
415 counterparty_iban = iban;
416 description = desc;
417 reference = ref_;
418 }
419 | { type_ = Transfer; debit_credit = Debit; _ } as ptx ->
420 let regex =
421 Re.Pcre.regexp
422 "^To Oranje spaarrekening ([A-Z0-9]+) Afronding Value date: \
423 ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
424 in
425 let [| _; savings_account; val_date_str |] =
426 Re.Pcre.extract ~rex:regex ptx.notifications
427 in
428 assert_value_date ptx val_date_str;
429 Rounding_savings_deposit { savings_account }
430 | { type_ = Ideal; debit_credit = Debit; _ } as ptx ->
431 let regex =
432 Re.Pcre.regexp
433 "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: \
434 ([0-9]{2}-[0-9]{2}-[0-9]{4} [0-9]{2}:[0-9]{2}) ([0-9]+) Value date: \
435 ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
436 in
437 let [| _; name; desc; iban_str; timestamp_str; ref_; val_date_str |] =
438 Re.Pcre.extract ~rex:regex ptx.notifications
439 in
440 assert_value_date ptx val_date_str;
441 let timestamp =
442 Time_ns.parse timestamp_str ~allow_trailing_input:false
443 ~fmt:"%d-%m-%Y %H:%M" ~zone:ams_tz
444 in
445 let iban = Iban.of_string iban_str in
446 if not String.(name = ptx.description) then
447 failwith
448 "specifics_from_prim (Ideal/Debit): expected counterparty name to \
449 match primitive description";
450 if not (Option.equal Iban.equal (Some iban) ptx.counterparty) then
451 failwith
452 "specifics_from_prim (Ideal/Debit): expected IBAN to match and \
453 primitive counterparty IBAN";
454 Ideal_debit
455 {
456 counterparty_name = name;
457 counterparty_iban = iban;
458 description = desc;
459 timestamp;
460 reference = ref_;
461 }
462 | { type_ = Batch_payment; debit_credit = Credit; _ } as ptx ->
463 let regex =
464 Re.Pcre.regexp
465 "^Name: (.*) Description: (.*) IBAN: ([A-Z0-9]+) Reference: (.*) \
466 Value date: ([0-9]{2}/[0-9]{2}/[0-9]{4})$"
467 in
468 let [| _; name; desc; iban_str; ref_; val_date_str |] =
469 Re.Pcre.extract ~rex:regex ptx.notifications
470 in
471 assert_value_date ptx val_date_str;
472 let iban = Iban.of_string iban_str in
473 if not String.(name = ptx.description) then
474 failwith
475 "specifics_from_prim (Batch_payment/Credit): expected counterparty \
476 name to match primitive description";
477 if not (Option.equal Iban.equal (Some iban) ptx.counterparty) then
478 failwith
479 "specifics_from_prim (Batch_payment/Credit): expected IBAN to match \
480 and primitive counterparty IBAN";
481 Batch_payment
482 {
483 counterparty_name = name;
484 counterparty_iban = iban;
485 description = desc;
486 reference = ref_;
487 }
diff --git a/lib/ledger.ml b/lib/ledger.ml
new file mode 100644
index 0000000..fd1b2a9
--- /dev/null
+++ b/lib/ledger.ml
@@ -0,0 +1,110 @@
1open Core
2
3type account_type = Asset | Equity | Liability | Expense | Income
4
5type tx_type =
6 | Interest_tx
7 | Online_banking_tx
8 | Recurrent_direct_tx
9 | Payment_terminal_tx
10 | Cash_payment_tx
11 | Atm_tx
12 | Auto_save_rounding_tx
13 | Batch_tx
14 | Direct_debit_tx
15 | Periodic_tx
16
17type iban_tag = Account_tag | Counterparty_iban_tag [@@deriving compare]
18
19type unit_tag = Filed_tag | GooglePay_tag | AutoRoundSavings_tag
20[@@deriving compare]
21
22type string_tag =
23 | Desc_tag
24 | User_tag
25 | Counterparty_name_tag
26 | Reference_tag
27 | Mandate_id_tag
28 | Creditor_id_tag
29 | Other_party_tag
30 | Transaction_tag
31 | Terminal_tag
32 | Card_seq_no_tag
33 | Savings_account_tag
34[@@deriving compare]
35
36module Label = struct
37 type 'a t =
38 | Iban_label : iban_tag -> Iban.t t
39 | String_label : string_tag -> string t
40 | Timestamp_label : Time_ns.t t
41 | Unit_label : unit_tag -> unit t
42
43 let int_to_cmp x : ('a, 'a) Dmap.cmp =
44 if x < 0 then Lt else if x > 0 then Gt else Eq
45
46 let compare (type a1 a2) (v1 : a1 t) (v2 : a2 t) : (a1, a2) Dmap.cmp =
47 match (v1, v2) with
48 | Iban_label t1, Iban_label t2 -> int_to_cmp @@ [%compare: iban_tag] t1 t2
49 | String_label t1, String_label t2 ->
50 int_to_cmp @@ [%compare: string_tag] t1 t2
51 | Timestamp_label, Timestamp_label -> Eq
52 | Unit_label t1, Unit_label t2 -> int_to_cmp @@ [%compare: unit_tag] t1 t2
53 | Iban_label _, _ -> Lt
54 | String_label _, Iban_label _ -> Gt
55 | String_label _, _ -> Lt
56 | Timestamp_label, Unit_label _ -> Lt
57 | Timestamp_label, _ -> Gt
58 | Unit_label _, _ -> Gt
59end
60
61module Labels = Dmap.Make (Label)
62
63module Money : sig
64 type t
65
66 val equal : t -> t -> bool
67 val compare : t -> t -> int
68 val of_z : Z.t -> t
69 val to_z : t -> Z.t
70 val ( + ) : t -> t -> t
71 val ( - ) : t -> t -> t
72end = struct
73 type t = Z.t
74
75 let equal = Z.equal
76 let compare = Z.compare
77 let of_z = Fn.id
78 let to_z = Fn.id
79 let ( + ) x y = Z.(x + y)
80 let ( - ) x y = Z.(x - y)
81end
82
83type scalar = Amount of Money.t | Rate of Z.t [@@deriving equal, compare]
84type account_id = string list
85type commodity_id = string (* TODO: consider making this UUID *)
86
87type account = {
88 id : account_id;
89 description : string list;
90 commodity_id : commodity_id;
91 balance : Money.t;
92}
93
94type bal_assert = { account : account_id; amount : Money.t; labels : Labels.t }
95
96module Account_id_key = struct
97 type t = account_id
98 type comparator_witness
99end
100
101type tx = {
102 cleared : Date.t option;
103 commodity_id : commodity_id;
104 debit : scalar Map.M(Account_id_key).t;
105 credit : scalar Map.M(Account_id_key).t;
106 labels : Labels.t;
107}
108
109type item = Tx_item of tx | Bal_assert_item of bal_assert
110type ledger = Ledger of item list
diff --git a/rdcapsis.cabal b/rdcapsis.cabal
deleted file mode 100644
index 3b4bd16..0000000
--- a/rdcapsis.cabal
+++ /dev/null
@@ -1,47 +0,0 @@
1cabal-version: 3.0
2name: rdcapsis
3version: 0.1.0.0
4maintainer: [email protected]
5author: Rutger Broekhoff
6build-type: Simple
7
8executable rdcapsis
9 main-is: Main.hs
10 hs-source-dirs: app
11 other-modules:
12 Data.Iban
13 Data.Ledger
14 Data.Ledger.AutoFile
15 Data.Res
16 Import.Ing.Convert
17 Import.Ing.CurrentAccountCsv
18 Import.Ing.SavingsAccountCsv
19 Import.Ing.Shared
20
21 default-language: GHC2024
22 default-extensions:
23 AllowAmbiguousTypes DuplicateRecordFields NoMonomorphismRestriction
24 OverloadedRecordDot OverloadedLabels OverloadedStrings
25
26 ghc-options: -Wall -threaded
27 build-depends:
28 Decimal,
29 attoparsec,
30 base ^>=4.21.0.0,
31 bytestring,
32 cassava,
33 containers,
34 constraints-extras,
35 dependent-map,
36 dependent-sum,
37 dependent-sum-template,
38 generic-lens,
39 lens,
40 parsec,
41 pretty-simple,
42 regex-tdfa,
43 text,
44 time,
45 tz,
46 uuid,
47 vector
diff --git a/rdcapsis.opam b/rdcapsis.opam
new file mode 100644
index 0000000..876bf93
--- /dev/null
+++ b/rdcapsis.opam
@@ -0,0 +1,39 @@
1# This file is generated by dune, edit dune-project instead
2opam-version: "2.0"
3synopsis: "A short synopsis"
4description: "A longer description"
5maintainer: ["Maintainer Name <[email protected]>"]
6authors: ["Author Name <[email protected]>"]
7license: "LICENSE"
8tags: ["add topics" "to describe" "your" "project"]
9homepage: "https://github.com/username/reponame"
10doc: "https://url/to/documentation"
11bug-reports: "https://github.com/username/reponame/issues"
12depends: [
13 "dune" {>= "3.17"}
14 "ocaml"
15 "zarith"
16 "core"
17 "dmap"
18 "delimited_parsing"
19 "re"
20 "utop" {dev}
21 "merlin" {dev}
22 "ocamlformat" {dev}
23 "odoc" {with-doc}
24]
25build: [
26 ["dune" "subst"] {dev}
27 [
28 "dune"
29 "build"
30 "-p"
31 name
32 "-j"
33 jobs
34 "@install"
35 "@runtest" {with-test}
36 "@doc" {with-doc}
37 ]
38]
39dev-repo: "git+https://github.com/username/reponame.git"
diff --git a/test/dune b/test/dune
new file mode 100644
index 0000000..d48b587
--- /dev/null
+++ b/test/dune
@@ -0,0 +1,2 @@
1(test
2 (name test_rdcapsis))
diff --git a/test/test_rdcapsis.ml b/test/test_rdcapsis.ml
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/test/test_rdcapsis.ml
generated by cgit v1.2.3 (git 2.49.0) at 2025-12-24 22:57:16 +0000