diff options
author | Rutger Broekhoff | 2025-07-23 12:05:08 +0200 |
---|---|---|
committer | Rutger Broekhoff | 2025-07-23 12:05:08 +0200 |
commit | 56273cf3b371312f0e72fc2af95a9dcacc8228b8 (patch) | |
tree | b4249523cab145fa32e2fdfb826cb592dcfdc127 /app/Data | |
parent | a40d93a36f0dd9f493757d793321f38a58cbb21b (diff) | |
download | rdcapsis-56273cf3b371312f0e72fc2af95a9dcacc8228b8.tar.gz rdcapsis-56273cf3b371312f0e72fc2af95a9dcacc8228b8.zip |
Slaying
Diffstat (limited to 'app/Data')
-rw-r--r-- | app/Data/Iban.hs | 5 | ||||
-rw-r--r-- | app/Data/Ledger.hs | 115 | ||||
-rw-r--r-- | app/Data/Ledger/AutoFile.hs | 1 |
3 files changed, 120 insertions, 1 deletions
diff --git a/app/Data/Iban.hs b/app/Data/Iban.hs index 412577a..d9566b9 100644 --- a/app/Data/Iban.hs +++ b/app/Data/Iban.hs | |||
@@ -1,4 +1,4 @@ | |||
1 | module Data.Iban (Iban, mkIban) where | 1 | module Data.Iban (Iban, mkIban, toText) where |
2 | 2 | ||
3 | import Control.Applicative ((<|>)) | 3 | import Control.Applicative ((<|>)) |
4 | import Data.Attoparsec.Text as AP | 4 | import Data.Attoparsec.Text as AP |
@@ -43,3 +43,6 @@ validateIban = AP.parseOnly $ do | |||
43 | charsToInteger chars * 1000000 + charsToInteger countryCode * 100 + charsToInteger checkDigits | 43 | charsToInteger chars * 1000000 + charsToInteger countryCode * 100 + charsToInteger checkDigits |
44 | valid countryCode checkDigits chars = | 44 | valid countryCode checkDigits chars = |
45 | ibanToInteger countryCode checkDigits chars `mod` 97 == 1 | 45 | ibanToInteger countryCode checkDigits chars `mod` 97 == 1 |
46 | |||
47 | toText :: Iban -> T.Text | ||
48 | toText (Iban t) = t | ||
diff --git a/app/Data/Ledger.hs b/app/Data/Ledger.hs new file mode 100644 index 0000000..ceca9da --- /dev/null +++ b/app/Data/Ledger.hs | |||
@@ -0,0 +1,115 @@ | |||
1 | {-# LANGUAGE TemplateHaskell #-} | ||
2 | {-# LANGUAGE TypeFamilies #-} | ||
3 | |||
4 | module Data.Ledger where | ||
5 | |||
6 | import Data.Constraint.Extras.TH (deriveArgDict) | ||
7 | import Data.Dependent.Map (DMap, fromList, singleton, union, unionWithKey) | ||
8 | import Data.Dependent.Sum ((==>)) | ||
9 | import Data.Functor.Identity | ||
10 | import Data.Functor.Identity (Identity (..)) | ||
11 | import Data.GADT.Compare.TH (deriveGCompare, deriveGEq) | ||
12 | import Data.GADT.Show.TH (deriveGShow) | ||
13 | import Data.Iban | ||
14 | import Data.Map qualified as M | ||
15 | import Data.Text qualified as T | ||
16 | import Data.Time.Calendar | ||
17 | import Data.Time.Clock | ||
18 | import Data.UUID | ||
19 | import GHC.Generics | ||
20 | |||
21 | data AccountType = Asset | Equity | Liability | Expense | Income | ||
22 | |||
23 | data TxAction = Inc | Dec | ||
24 | |||
25 | txaOpp :: TxAction -> TxAction | ||
26 | txaOpp Inc = Dec | ||
27 | txaOpp Dec = Inc | ||
28 | |||
29 | onDebit :: AccountType -> TxAction | ||
30 | onDebit Asset = Inc | ||
31 | onDebit Equity = Dec | ||
32 | onDebit Liability = Dec | ||
33 | onDebit Expense = Inc | ||
34 | onDebit Income = Dec | ||
35 | |||
36 | onCredit :: AccountType -> TxAction | ||
37 | onCredit = txaOpp . onDebit | ||
38 | |||
39 | data TxType | ||
40 | = InterestCtx | ||
41 | | OnlineBankingTx | ||
42 | | RecurrentDirectTx | ||
43 | | PaymentTerminalTx | ||
44 | | CashPaymentTx | ||
45 | | AtmTx | ||
46 | | AutoSaveRoundingTx | ||
47 | | BatchTx | ||
48 | | DirectDebitTx | ||
49 | | PeriodicTx | ||
50 | |||
51 | data IbanTag = AccountTag | CounterpartyIbanTag deriving (Eq, Enum, Ord, Show) | ||
52 | |||
53 | data UnitTag = FiledTag | GooglePayTag deriving (Eq, Enum, Ord, Show) | ||
54 | |||
55 | data TextTag = DescTag | UserTag | CounterpartyNameTag | ReferenceTag | MandateIdTag | CreditorIdTag | OtherPartyTag | TransactionTag | TerminalTag | CardSeqNoTag deriving (Eq, Enum, Ord, Show) | ||
56 | |||
57 | data Label a where | ||
58 | TextLabel :: TextTag -> Label T.Text | ||
59 | IbanLabel :: IbanTag -> Label Iban | ||
60 | UnitLabel :: UnitTag -> Label () | ||
61 | TimestampLabel :: Label UTCTime | ||
62 | |||
63 | deriveGEq ''Label | ||
64 | deriveGCompare ''Label | ||
65 | deriveGShow ''Label | ||
66 | deriveArgDict ''Label | ||
67 | |||
68 | type Labels = DMap Label Identity | ||
69 | |||
70 | data Money = Money Integer deriving (Show) | ||
71 | |||
72 | infixl 6 +€, -€ | ||
73 | |||
74 | (+€) :: Money -> Money -> Money | ||
75 | Money x +€ Money y = Money (x + y) | ||
76 | |||
77 | (-€) :: Money -> Money -> Money | ||
78 | Money x -€ Money y = Money (x - y) | ||
79 | |||
80 | data Scalar = Amount Money | Rate Integer deriving (Show) | ||
81 | |||
82 | data AccountId = AccountId [T.Text] deriving (Show) | ||
83 | |||
84 | data CommodityId = CommodityId UUID deriving (Show) | ||
85 | |||
86 | data 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. | ||
96 | data BalAssert = BalAssert | ||
97 | { account :: Account, | ||
98 | amount :: Integer, | ||
99 | labels :: Labels | ||
100 | } | ||
101 | |||
102 | data 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 | |||
113 | data LedgerEntry = TxEntry SeqTx | BalAssertEntry BalAssert | ||
114 | |||
115 | data Ledger = Ledger [LedgerEntry] | ||
diff --git a/app/Data/Ledger/AutoFile.hs b/app/Data/Ledger/AutoFile.hs new file mode 100644 index 0000000..15a1b16 --- /dev/null +++ b/app/Data/Ledger/AutoFile.hs | |||
@@ -0,0 +1 @@ | |||
module Data.Ledger.AutoFile where | |||