diff options
author | Rutger Broekhoff | 2025-08-25 19:48:19 +0200 |
---|---|---|
committer | Rutger Broekhoff | 2025-08-25 19:48:19 +0200 |
commit | 95d50b25c990e8c945ce2507b16ff3c8b039d286 (patch) | |
tree | c1ff4c7f9601c6980eed1a7235ba336c5c6f6106 /app/Data | |
parent | 29b26dcbc1404925bbf12cddd66f7fcd3c57cfe7 (diff) | |
download | rdcapsis-95d50b25c990e8c945ce2507b16ff3c8b039d286.tar.gz rdcapsis-95d50b25c990e8c945ce2507b16ff3c8b039d286.zip |
OCaml
Diffstat (limited to 'app/Data')
-rw-r--r-- | app/Data/Iban.hs | 48 | ||||
-rw-r--r-- | app/Data/Ledger.hs | 115 | ||||
-rw-r--r-- | app/Data/Ledger/AutoFile.hs | 1 | ||||
-rw-r--r-- | app/Data/Res.hs | 31 |
4 files changed, 0 insertions, 195 deletions
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 @@ | |||
1 | module Data.Iban (Iban, mkIban, toText) where | ||
2 | |||
3 | import Control.Applicative ((<|>)) | ||
4 | import Data.Attoparsec.Text as AP | ||
5 | import Data.Char | ||
6 | ( digitToInt, | ||
7 | isAscii, | ||
8 | isDigit, | ||
9 | ord, | ||
10 | toUpper, | ||
11 | ) | ||
12 | import Data.Text qualified as T | ||
13 | |||
14 | newtype Iban = Iban T.Text deriving (Show, Eq) | ||
15 | |||
16 | mkIban :: T.Text -> Either String Iban | ||
17 | mkIban t = validateIban t >> return (Iban t) | ||
18 | |||
19 | validateIban :: T.Text -> Either String () | ||
20 | validateIban = 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 | |||
47 | toText :: Iban -> T.Text | ||
48 | toText (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 | |||
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 | AutoRoundSavingsTag deriving (Eq, Enum, Ord, Show) | ||
54 | |||
55 | data TextTag = DescTag | UserTag | CounterpartyNameTag | ReferenceTag | MandateIdTag | CreditorIdTag | OtherPartyTag | TransactionTag | TerminalTag | CardSeqNoTag | SavingsAccountTag 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 :: AccountId, | ||
98 | amount :: Money, | ||
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 Entry = TxEntry Tx | BalAssertEntry BalAssert | ||
114 | |||
115 | data 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 @@ | |||
1 | module 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 @@ | |||
1 | module Data.Res where | ||
2 | |||
3 | import Control.Applicative | ||
4 | import Data.String (IsString (fromString)) | ||
5 | |||
6 | data Res e r = Ok r | Err e | ||
7 | |||
8 | instance Functor (Res e) where | ||
9 | fmap f (Ok v) = Ok (f v) | ||
10 | fmap _ (Err e) = Err e | ||
11 | |||
12 | instance 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 | |||
18 | instance Monad (Res e) where | ||
19 | (Ok v) >>= f = f v | ||
20 | (Err e) >>= _ = Err e | ||
21 | |||
22 | instance (IsString e) => MonadFail (Res e) where | ||
23 | fail = Err . fromString | ||
24 | |||
25 | instance (IsString e) => Alternative (Res e) where | ||
26 | empty = fail "mzero" | ||
27 | m1@(Ok _) <|> _ = m1 | ||
28 | (Err _) <|> m2 = m2 | ||
29 | |||
30 | liftEither :: Either e r -> Res e r | ||
31 | liftEither = either Err Ok | ||