summaryrefslogtreecommitdiffstats
path: root/app/Data
diff options
context:
space:
mode:
authorRutger Broekhoff2025-08-25 19:48:19 +0200
committerRutger Broekhoff2025-08-25 19:48:19 +0200
commit95d50b25c990e8c945ce2507b16ff3c8b039d286 (patch)
treec1ff4c7f9601c6980eed1a7235ba336c5c6f6106 /app/Data
parent29b26dcbc1404925bbf12cddd66f7fcd3c57cfe7 (diff)
downloadrdcapsis-95d50b25c990e8c945ce2507b16ff3c8b039d286.tar.gz
rdcapsis-95d50b25c990e8c945ce2507b16ff3c8b039d286.zip
OCaml
Diffstat (limited to 'app/Data')
-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
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 @@
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