{-# 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 | AutoRoundSavingsTag deriving (Eq, Enum, Ord, Show)

data TextTag = DescTag | UserTag | CounterpartyNameTag | ReferenceTag | MandateIdTag | CreditorIdTag | OtherPartyTag | TransactionTag | TerminalTag | CardSeqNoTag | SavingsAccountTag 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]