pwncash/lib/Internal/Database/Model.hs

{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

module Internal.Database.Model where

import Database.Esqueleto.Experimental
import Database.Persist.TH
import Internal.Types
import RIO
import qualified RIO.Map as M
import qualified RIO.Text as T
import RIO.Time

share
  [mkPersist sqlSettings, mkMigrate "migrateAll"]
  [persistLowerCase|
CommitR sql=commits
    hash Int
    type ConfigType
    deriving Show Eq
CurrencyR sql=currencies
    symbol T.Text
    fullname T.Text
    deriving Show Eq
AccountR sql=accounts
    name T.Text
    fullpath T.Text
    desc T.Text
    deriving Show Eq
AccountPathR sql=account_paths
    parent AccountRId OnDeleteCascade
    child AccountRId OnDeleteCascade
    depth Int
    deriving Show Eq
TransactionR sql=transactions
    commit CommitRId OnDeleteCascade
    date Day
    description T.Text
    deriving Show Eq
SplitR sql=splits
    transaction TransactionRId OnDeleteCascade
    currency CurrencyRId OnDeleteCascade
    account AccountRId OnDeleteCascade
    memo T.Text
    value Rational
    deriving Show Eq
BudgetLabelR sql=budget_labels
    split SplitRId OnDeleteCascade
    budgetName T.Text
    deriving Show Eq
ExpenseBucketR sql=expense_buckets
    budgetLabel BudgetLabelRId OnDeleteCascade
    bucket ExpenseBucket
    deriving Show Eq
IncomeBucketR sql=income_buckets
    budgetLabel BudgetLabelRId OnDeleteCascade
    bucket IncomeBucket
    deriving Show Eq
|]

type AccountMap = M.Map AcntID (AccountRId, AcntSign, AcntType)

type CurrencyMap = M.Map CurID CurrencyRId

data DBState = DBState
  { kmCurrency :: !CurrencyMap
  , kmAccount :: !AccountMap
  , kmBudgetInterval :: !Bounds
  , kmStatementInterval :: !Bounds
  , kmNewCommits :: ![Int]
  , kmConfigDir :: !FilePath
  }

type MappingT m = ReaderT DBState (SqlPersistT m)

type KeySplit = Split AccountRId Rational CurrencyRId

type KeyTx = Tx KeySplit

type TreeR = Tree ([T.Text], AccountRId)

type Balances = M.Map AccountRId Rational

type BalanceM m = ReaderT (MVar Balances) m

class MonadUnliftIO m => MonadFinance m where
  askDBState :: (DBState -> a) -> m a

instance MonadUnliftIO m => MonadFinance (ReaderT DBState m) where
  askDBState = asks

class MonadUnliftIO m => MonadBalance m where
  askBalances :: m (MVar Balances)

  withBalances :: (Balances -> m a) -> m a
  withBalances f = do
    bs <- askBalances
    withMVar bs f

  modifyBalances :: (Balances -> m (Balances, a)) -> m a
  modifyBalances f = do
    bs <- askBalances
    modifyMVar bs f

  lookupBalance :: AccountRId -> m Rational
  lookupBalance i = withBalances $ return . fromMaybe 0 . M.lookup i

  addBalance :: AccountRId -> Rational -> m ()
  addBalance i v =
    modifyBalances $ return . (,()) . M.alter (Just . maybe v (v +)) i