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 | |||