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