From 56273cf3b371312f0e72fc2af95a9dcacc8228b8 Mon Sep 17 00:00:00 2001
From: Rutger Broekhoff
Date: Wed, 23 Jul 2025 12:05:08 +0200
Subject: Slaying

---
 app/Data/Ledger.hs | 115 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 115 insertions(+)
 create mode 100644 app/Data/Ledger.hs

(limited to 'app/Data/Ledger.hs')

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 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Data.Ledger where
+
+import Data.Constraint.Extras.TH (deriveArgDict)
+import Data.Dependent.Map (DMap, fromList, singleton, union, unionWithKey)
+import Data.Dependent.Sum ((==>))
+import Data.Functor.Identity
+import Data.Functor.Identity (Identity (..))
+import Data.GADT.Compare.TH (deriveGCompare, deriveGEq)
+import Data.GADT.Show.TH (deriveGShow)
+import Data.Iban
+import Data.Map qualified as M
+import Data.Text qualified as T
+import Data.Time.Calendar
+import Data.Time.Clock
+import Data.UUID
+import GHC.Generics
+
+data AccountType = Asset | Equity | Liability | Expense | Income
+
+data TxAction = Inc | Dec
+
+txaOpp :: TxAction -> TxAction
+txaOpp Inc = Dec
+txaOpp Dec = Inc
+
+onDebit :: AccountType -> TxAction
+onDebit Asset = Inc
+onDebit Equity = Dec
+onDebit Liability = Dec
+onDebit Expense = Inc
+onDebit Income = Dec
+
+onCredit :: AccountType -> TxAction
+onCredit = txaOpp . onDebit
+
+data TxType
+  = InterestCtx
+  | OnlineBankingTx
+  | RecurrentDirectTx
+  | PaymentTerminalTx
+  | CashPaymentTx
+  | AtmTx
+  | AutoSaveRoundingTx
+  | BatchTx
+  | DirectDebitTx
+  | PeriodicTx
+
+data IbanTag = AccountTag | CounterpartyIbanTag deriving (Eq, Enum, Ord, Show)
+
+data UnitTag = FiledTag | GooglePayTag deriving (Eq, Enum, Ord, Show)
+
+data TextTag = DescTag | UserTag | CounterpartyNameTag | ReferenceTag | MandateIdTag | CreditorIdTag | OtherPartyTag | TransactionTag | TerminalTag | CardSeqNoTag deriving (Eq, Enum, Ord, Show)
+
+data Label a where
+  TextLabel :: TextTag -> Label T.Text
+  IbanLabel :: IbanTag -> Label Iban
+  UnitLabel :: UnitTag -> Label ()
+  TimestampLabel :: Label UTCTime
+
+deriveGEq ''Label
+deriveGCompare ''Label
+deriveGShow ''Label
+deriveArgDict ''Label
+
+type Labels = DMap Label Identity
+
+data Money = Money Integer deriving (Show)
+
+infixl 6 +€, -€
+
+(+€) :: Money -> Money -> Money
+Money x +€ Money y = Money (x + y)
+
+(-€) :: Money -> Money -> Money
+Money x -€ Money y = Money (x - y)
+
+data Scalar = Amount Money | Rate Integer deriving (Show)
+
+data AccountId = AccountId [T.Text] deriving (Show)
+
+data CommodityId = CommodityId UUID deriving (Show)
+
+data Account = Account
+  { id :: AccountId,
+    description :: [T.Text],
+    commodityId :: CommodityId,
+    balance :: Money
+  }
+
+-- A balance assertion is only valid when all transactions before it have been
+-- cleared and the balance of the account agrees with the amount in the
+-- assertion.
+data BalAssert = BalAssert
+  { account :: Account,
+    amount :: Integer,
+    labels :: Labels
+  }
+
+data Tx = Tx
+  { cleared :: Maybe Day,
+    commodityId :: CommodityId, -- the commodity w.r.t. which rates are calculated
+    debit :: M.Map AccountId Scalar,
+    credit :: M.Map AccountId Scalar,
+    labels :: Labels
+  }
+  deriving (Show, Generic)
+
+data SeqTx = SeqTx [Integer] Tx
+
+data LedgerEntry = TxEntry SeqTx | BalAssertEntry BalAssert
+
+data Ledger = Ledger [LedgerEntry]
-- 
cgit v1.2.3