ENH use stratified buckets for budget tagging
This commit is contained in:
parent
a6d9f959f1
commit
36c6a56f1b
|
|
@ -174,45 +174,44 @@ let Import =
|
|||
|
||||
let Statement = < StmtManual : Manual | StmtImport : Import >
|
||||
|
||||
let Bucket = < Fixed | Investment | Savings | Guiltless >
|
||||
let ExpenseBucket = < Fixed | Investment | Savings | Guiltless >
|
||||
|
||||
let Amount = \(v : Type) -> { amtValue : v, amtDesc : Text }
|
||||
let IncomeBucket = < PreTax | IntraTax | PostTax >
|
||||
|
||||
let TimeAmount = { taWhen : DatePat, taAmt : Amount Decimal }
|
||||
let Amount = { amtValue : Decimal, amtDesc : Text }
|
||||
|
||||
let TimeAmount = { taWhen : DatePat, taAmt : Amount }
|
||||
|
||||
let Tax = { taxAcnt : AcntID, taxValue : Decimal }
|
||||
|
||||
let Allocation =
|
||||
\(v : Type) ->
|
||||
{ alloPath : AcntID
|
||||
, alloBucket : Bucket
|
||||
, alloAmts : List (Amount v)
|
||||
, alloBucket : ExpenseBucket
|
||||
, alloAmts : List Amount
|
||||
, alloCurrency : CurID
|
||||
}
|
||||
|
||||
let PreAllocation = Allocation Decimal
|
||||
|
||||
let PostAllocation = Allocation (Optional Decimal)
|
||||
|
||||
let Income =
|
||||
{ incGross : Decimal
|
||||
, incCurrency : CurID
|
||||
, incWhen : DatePat
|
||||
, incAccount : AcntID
|
||||
, incPretax : List PreAllocation
|
||||
, incFrom : AcntID
|
||||
, incPretax : List Allocation
|
||||
, incTaxes : List Tax
|
||||
, incPosttax : List PostAllocation
|
||||
, incPosttax : List Allocation
|
||||
, incToBal : AcntID
|
||||
}
|
||||
|
||||
let Expense =
|
||||
{ expFrom : AcntID
|
||||
, expTo : AcntID
|
||||
, expBucket : Bucket
|
||||
, expBucket : ExpenseBucket
|
||||
, expAmounts : List TimeAmount
|
||||
, expCurrency : CurID
|
||||
}
|
||||
|
||||
let Budget = { income : List Income, expenses : List Expense }
|
||||
let Budget =
|
||||
{ income : List Income, expenses : List Expense, manual : List Manual }
|
||||
|
||||
in { CurID
|
||||
, AcntID
|
||||
|
|
@ -251,12 +250,11 @@ in { CurID
|
|||
, Statement
|
||||
, Expense
|
||||
, Income
|
||||
, Bucket
|
||||
, IncomeBucket
|
||||
, ExpenseBucket
|
||||
, Budget
|
||||
, Tax
|
||||
, Allocation
|
||||
, PreAllocation
|
||||
, PostAllocation
|
||||
, Amount
|
||||
, TimeAmount
|
||||
}
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ let List/map =
|
|||
|
||||
let T =
|
||||
./Types.dhall
|
||||
sha256:dfbc39a5fe5f4b78b86dc5d4def8de689ff800b6ee506c7a63d573c0be02e976
|
||||
sha256:91a8e19048591cc6b7f72dc62f0d5d7d569864f4736b5649422c746904d03a52
|
||||
|
||||
let nullSplit =
|
||||
\(a : T.SplitAcnt) ->
|
||||
|
|
|
|||
|
|
@ -51,7 +51,6 @@ TransactionR sql=transactions
|
|||
commit CommitRId OnDeleteCascade
|
||||
date Day
|
||||
description T.Text
|
||||
bucket T.Text Maybe
|
||||
deriving Show Eq
|
||||
SplitR sql=splits
|
||||
transaction TransactionRId OnDeleteCascade
|
||||
|
|
@ -60,6 +59,15 @@ SplitR sql=splits
|
|||
memo T.Text
|
||||
value Rational
|
||||
deriving Show Eq
|
||||
BudgetLabelR
|
||||
split SplitRId
|
||||
name T.Text
|
||||
ExpenseBucketR
|
||||
budgetLabel BudgetLabelRId
|
||||
bucket T.Text
|
||||
IncomeBucketR
|
||||
budgetLabel BudgetLabelRId
|
||||
bucket T.Text
|
||||
|]
|
||||
|
||||
type AccountMap = M.Map AcntID (AccountRId, AcntSign)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
|
||||
module Internal.Insert
|
||||
|
|
@ -90,6 +90,8 @@ insertBudget :: MonadUnliftIO m => Budget -> MappingT m [InsertError]
|
|||
insertBudget Budget {income = is, expenses = es} = do
|
||||
es1 <- mapM insertIncome is
|
||||
es2 <- mapM insertExpense es
|
||||
-- es3 <- mapM insertBudgetManual ms
|
||||
-- return $ concat $ es1 ++ es2 ++ es3
|
||||
return $ concat $ es1 ++ es2
|
||||
|
||||
-- TODO this hashes twice (not that it really matters)
|
||||
|
|
@ -105,27 +107,86 @@ whenHash t o def f = do
|
|||
hs <- asks kmNewCommits
|
||||
if h `elem` hs then f =<< lift (insert $ CommitR h t) else return def
|
||||
|
||||
insertIncome :: MonadUnliftIO m => Income -> MappingT m [InsertError]
|
||||
insertIncome
|
||||
i@Income
|
||||
{ incCurrency = cur
|
||||
, incWhen = dp
|
||||
, incAccount = from
|
||||
, incTaxes = taxes
|
||||
} =
|
||||
whenHash CTIncome i [] $ \c ->
|
||||
unlessLeft (balanceIncome i) $ \balanced -> do
|
||||
bounds <- (liftIO . resolveBounds) =<< asks kmBudgetInterval
|
||||
fmap concat $ forM (expandDatePat bounds dp) $ \day -> do
|
||||
-- TODO why are these separate?
|
||||
nontaxRes <- alloTxs concat (allocationToTx from day) balanced
|
||||
taxRes <- alloTxs (fmap (,Fixed)) (taxToTx from day cur) taxes
|
||||
unlessLefts_ (concatEithers2 nontaxRes taxRes (++)) $ \txs ->
|
||||
lift $ mapM_ (\(t, b) -> insertTxBucket (Just b) c t) txs
|
||||
where
|
||||
alloTxs squish toTx = fmap (fmap squish . concatEithersL) . mapM toTx
|
||||
-- TODO allow currency conversions here
|
||||
data BudgetSplit b = BudgetSplit
|
||||
{ bsAcnt :: AcntID
|
||||
, bsBucket :: Maybe b
|
||||
}
|
||||
|
||||
balanceIncome :: Income -> EitherErr [BalAllocation]
|
||||
data BudgetMeta = BudgetMeta
|
||||
{ bmCommit :: Key CommitR
|
||||
, bmWhen :: Day
|
||||
, bmCur :: CurID
|
||||
}
|
||||
|
||||
data BudgetTx = BudgetTx
|
||||
{ btMeta :: BudgetMeta
|
||||
, btFrom :: BudgetSplit IncomeBucket
|
||||
, btTo :: BudgetSplit ExpenseBucket
|
||||
, btValue :: Rational
|
||||
, btDesc :: T.Text
|
||||
}
|
||||
|
||||
insertIncome :: MonadUnliftIO m => Income -> MappingT m [InsertError]
|
||||
insertIncome i@Income {..} =
|
||||
whenHash CTIncome i [] $ \c ->
|
||||
unlessLeft (balanceIncome i) $ \balance ->
|
||||
fmap concat $ withDates incWhen $ \day -> do
|
||||
let meta = BudgetMeta c day incCurrency
|
||||
let fromAllos b = concatMap (fromAllo meta incFrom (Just b))
|
||||
let pre = fromAllos PreTax incPretax
|
||||
let tax = fmap (fromTax meta incFrom) incTaxes
|
||||
let post = fromAllos PostTax incPosttax
|
||||
let bal =
|
||||
BudgetTx
|
||||
{ btMeta = meta
|
||||
, btFrom = BudgetSplit incFrom $ Just PostTax
|
||||
, btTo = BudgetSplit incToBal Nothing
|
||||
, btValue = balance
|
||||
, btDesc = "balance after deductions"
|
||||
}
|
||||
fmap concat $ mapM insertBudgetTx $ bal : (pre ++ tax ++ post)
|
||||
|
||||
fromAllo
|
||||
:: BudgetMeta
|
||||
-> AcntID
|
||||
-> Maybe IncomeBucket
|
||||
-> Allocation
|
||||
-> [BudgetTx]
|
||||
fromAllo meta from ib Allocation {..} = fmap (toBT alloPath) alloAmts
|
||||
where
|
||||
toBT to (Amount desc v) =
|
||||
BudgetTx
|
||||
{ btFrom = BudgetSplit from ib
|
||||
, btTo = BudgetSplit to $ Just alloBucket
|
||||
, btValue = dec2Rat v
|
||||
, btDesc = desc
|
||||
, btMeta = meta
|
||||
}
|
||||
|
||||
fromTax :: BudgetMeta -> AcntID -> Tax -> BudgetTx
|
||||
fromTax meta from Tax {taxAcnt = to, taxValue = v} =
|
||||
BudgetTx
|
||||
{ btFrom = BudgetSplit from (Just IntraTax)
|
||||
, btTo = BudgetSplit to (Just Fixed)
|
||||
, btValue = dec2Rat v
|
||||
, btDesc = ""
|
||||
, btMeta = meta
|
||||
}
|
||||
|
||||
withDates
|
||||
:: MonadUnliftIO m
|
||||
=> DatePat
|
||||
-> (Day -> MappingT m a)
|
||||
-> MappingT m [a]
|
||||
withDates dp f = do
|
||||
bounds <- askBounds
|
||||
mapM f (expandDatePat bounds dp)
|
||||
|
||||
askBounds :: MonadUnliftIO m => MappingT m Bounds
|
||||
askBounds = (liftIO . resolveBounds) =<< asks kmBudgetInterval
|
||||
|
||||
balanceIncome :: Income -> EitherErr Rational
|
||||
balanceIncome
|
||||
Income
|
||||
{ incGross = g
|
||||
|
|
@ -133,122 +194,33 @@ balanceIncome
|
|||
, incPretax = pre
|
||||
, incTaxes = tax
|
||||
, incPosttax = post
|
||||
} = (preRat ++) <$> balancePostTax dp bal postRat
|
||||
}
|
||||
| bal < 0 = Left $ AllocationError undefined dp
|
||||
| otherwise = Right bal
|
||||
where
|
||||
preRat = mapAlloAmts dec2Rat <$> pre
|
||||
postRat = mapAlloAmts (fmap dec2Rat) <$> post
|
||||
bal = dec2Rat g - (sumAllocations preRat + sumTaxes tax)
|
||||
bal = dec2Rat g - sum (sumAllocation <$> pre ++ post) - sumTaxes tax
|
||||
|
||||
mapAlloAmts :: (a -> b) -> Allocation a -> Allocation b
|
||||
mapAlloAmts f a@Allocation {alloAmts = as} = a {alloAmts = fmap f <$> as}
|
||||
|
||||
sumAllocations :: [BalAllocation] -> Rational
|
||||
sumAllocations = sum . concatMap (fmap amtValue . alloAmts)
|
||||
sumAllocation :: Allocation -> Rational
|
||||
sumAllocation = sum . fmap (dec2Rat . amtValue) . alloAmts
|
||||
|
||||
sumTaxes :: [Tax] -> Rational
|
||||
sumTaxes = sum . fmap (dec2Rat . taxValue)
|
||||
|
||||
balancePostTax :: DatePat -> Rational -> [RawAllocation] -> EitherErr [BalAllocation]
|
||||
balancePostTax dp bal as
|
||||
| null as = err NoAllocations
|
||||
| otherwise = case partitionEithers $ fmap hasVal as of
|
||||
([([empty], nonmissing)], bs) ->
|
||||
let s = bal - sumAllocations (nonmissing : bs)
|
||||
in if s < 0
|
||||
then err ExceededTotal
|
||||
else Right $ mapAmts (empty {amtValue = s} :) nonmissing : bs
|
||||
([], _) -> err MissingBlank
|
||||
_ -> err TooManyBlanks
|
||||
where
|
||||
hasVal a@Allocation {alloAmts = xs} =
|
||||
case partitionEithers $ fmap maybeAmt xs of
|
||||
([], bs) -> Right a {alloAmts = bs}
|
||||
(unbal, bs) -> Left (unbal, a {alloAmts = bs})
|
||||
maybeAmt a@Amount {amtValue = Just v} = Right a {amtValue = v}
|
||||
maybeAmt a = Left a
|
||||
err t = Left $ AllocationError t dp
|
||||
|
||||
-- TODO lens reinvention
|
||||
mapAmts :: ([Amount a] -> [Amount b]) -> Allocation a -> Allocation b
|
||||
mapAmts f a@Allocation {alloAmts = xs} = a {alloAmts = f xs}
|
||||
|
||||
allocationToTx
|
||||
:: MonadUnliftIO m
|
||||
=> AcntID
|
||||
-> Day
|
||||
-> BalAllocation
|
||||
-> MappingT m (EitherErrs [(KeyTx, Bucket)])
|
||||
allocationToTx
|
||||
from
|
||||
day
|
||||
Allocation
|
||||
{ alloPath = to
|
||||
, alloBucket = b
|
||||
, alloCurrency = cur
|
||||
, alloAmts = as
|
||||
} =
|
||||
second (fmap (,b)) . concatEithersL <$> mapM (transferToTx day from to cur) as
|
||||
|
||||
taxToTx
|
||||
:: MonadUnliftIO m
|
||||
=> AcntID
|
||||
-> Day
|
||||
-> T.Text
|
||||
-> Tax
|
||||
-> MappingT m (EitherErrs KeyTx)
|
||||
taxToTx from day cur Tax {taxAcnt = to, taxValue = v} =
|
||||
txPair day from to cur (dec2Rat v) ""
|
||||
|
||||
transferToTx
|
||||
:: MonadUnliftIO m
|
||||
=> Day
|
||||
-> AcntID
|
||||
-> AcntID
|
||||
-> T.Text
|
||||
-> BalAmount
|
||||
-> MappingT m (EitherErrs KeyTx)
|
||||
transferToTx day from to cur Amount {amtValue = v, amtDesc = d} =
|
||||
txPair day from to cur v d
|
||||
|
||||
insertExpense :: MonadUnliftIO m => Expense -> MappingT m [InsertError]
|
||||
insertExpense
|
||||
e@Expense
|
||||
{ expFrom = from
|
||||
, expTo = to
|
||||
, expCurrency = cur
|
||||
, expBucket = buc
|
||||
, expAmounts = as
|
||||
} = do
|
||||
whenHash CTExpense e [] $ \key -> concat <$> mapM (go key) as
|
||||
insertExpense e@Expense {..} =
|
||||
fmap (concat . concat) $ whenHash CTExpense e [] $ \key -> do
|
||||
forM expAmounts $ \(TimeAmount amt pat) ->
|
||||
withDates pat $ \day -> insertBudgetTx $ budgetTx amt day key
|
||||
where
|
||||
go key amt = do
|
||||
res <- timeAmountToTx from to cur amt
|
||||
unlessLefts_ res $
|
||||
lift . mapM_ (insertTxBucket (Just buc) key)
|
||||
|
||||
timeAmountToTx
|
||||
:: MonadUnliftIO m
|
||||
=> AcntID
|
||||
-> AcntID
|
||||
-> CurID
|
||||
-> TimeAmount
|
||||
-> MappingT m (EitherErrs [KeyTx])
|
||||
timeAmountToTx
|
||||
from
|
||||
to
|
||||
cur
|
||||
TimeAmount
|
||||
{ taWhen = dp
|
||||
, taAmt =
|
||||
Amount
|
||||
{ amtValue = v
|
||||
, amtDesc = d
|
||||
meta d c = BudgetMeta {bmWhen = d, bmCur = expCurrency, bmCommit = c}
|
||||
budgetTx (Amount desc v) d c =
|
||||
BudgetTx
|
||||
{ btMeta = meta d c
|
||||
, btFrom = BudgetSplit expFrom Nothing
|
||||
, btTo = BudgetSplit expTo Nothing
|
||||
, btValue = dec2Rat v
|
||||
, btDesc = desc
|
||||
}
|
||||
} = do
|
||||
bounds <- (liftIO . resolveBounds) =<< asks kmBudgetInterval
|
||||
concatEithersL <$> mapM tx (expandDatePat bounds dp)
|
||||
where
|
||||
tx day = txPair day from to cur (dec2Rat v) d
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- statements
|
||||
|
|
@ -302,7 +274,7 @@ txPair
|
|||
=> Day
|
||||
-> AcntID
|
||||
-> AcntID
|
||||
-> T.Text
|
||||
-> CurID
|
||||
-> Rational
|
||||
-> T.Text
|
||||
-> MappingT m (EitherErrs KeyTx)
|
||||
|
|
@ -317,6 +289,35 @@ txPair day from to cur val desc = resolveTx tx
|
|||
, txSplits = [split from (-val), split to val]
|
||||
}
|
||||
|
||||
splitPair
|
||||
:: MonadUnliftIO m
|
||||
=> AcntID
|
||||
-> AcntID
|
||||
-> CurID
|
||||
-> Rational
|
||||
-> MappingT m (EitherErrs (KeySplit, KeySplit))
|
||||
splitPair from to cur val = do
|
||||
s1 <- split from (-val)
|
||||
s2 <- split to val
|
||||
return $ concatEithers2 s1 s2 (,)
|
||||
where
|
||||
split a v =
|
||||
resolveSplit $
|
||||
Split
|
||||
{ sAcnt = a
|
||||
, sValue = v
|
||||
, sComment = ""
|
||||
, sCurrency = cur
|
||||
}
|
||||
|
||||
-- tx =
|
||||
-- Tx
|
||||
-- { txDescr = desc
|
||||
-- , txDate = day
|
||||
-- , txTags = []
|
||||
-- , txSplits = [split from (-val), split to val]
|
||||
-- }
|
||||
|
||||
resolveTx :: MonadUnliftIO m => BalTx -> MappingT m (EitherErrs KeyTx)
|
||||
resolveTx t@Tx {txSplits = ss} = do
|
||||
res <- concatEithersL <$> mapM resolveSplit ss
|
||||
|
|
@ -339,17 +340,55 @@ resolveSplit s@Split {sAcnt = p, sCurrency = c, sValue = v} = do
|
|||
-- return $ case (aid, cid, sign) of
|
||||
-- _ -> Nothing
|
||||
|
||||
insertTxBucket :: MonadUnliftIO m => Maybe Bucket -> Key CommitR -> KeyTx -> SqlPersistT m ()
|
||||
insertTxBucket b c Tx {txDate = d, txDescr = e, txSplits = ss} = do
|
||||
k <- insert $ TransactionR c d e (fmap (T.pack . show) b)
|
||||
-- insertTax
|
||||
-- :: MonadUnliftIO m
|
||||
-- => AcntID
|
||||
-- -> CurID
|
||||
-- -> Day
|
||||
-- -> Key CommitR
|
||||
-- -> Tax
|
||||
-- -> MappingT m [InsertError]
|
||||
-- insertTax from cur day commit Tax {taxAcnt = to, taxValue = amnt} =
|
||||
-- insertBudgetValue IntraTax Fixed from to cur commit day "" $ dec2Rat amnt
|
||||
|
||||
-- insertAllocation
|
||||
-- :: MonadUnliftIO m
|
||||
-- => AcntID
|
||||
-- -> CurID
|
||||
-- -> IncomeBucket
|
||||
-- -> Day
|
||||
-- -> Key CommitR
|
||||
-- -> Allocation Decimal
|
||||
-- -> MappingT m [InsertError]
|
||||
-- insertAllocation from cur ib d c (Allocation to xb as _) = concat <$> mapM go as
|
||||
-- where
|
||||
-- go (Amount v desc) = insertBudgetValue ib xb from to cur c d desc $ dec2Rat v
|
||||
|
||||
insertBudgetTx :: MonadUnliftIO m => BudgetTx -> MappingT m [InsertError]
|
||||
insertBudgetTx BudgetTx {..} = do
|
||||
res <- splitPair (bsAcnt btFrom) (bsAcnt btTo) (bmCur btMeta) btValue
|
||||
unlessLefts_ res $ \(sFrom, sTo) -> lift $ do
|
||||
k <- insert $ TransactionR (bmCommit btMeta) (bmWhen btMeta) btDesc
|
||||
skFrom <- insertSplit k sFrom
|
||||
bFrom <- insert $ BudgetLabelR skFrom ""
|
||||
forM_ (bsBucket btFrom) $ \b ->
|
||||
insert_ $ IncomeBucketR bFrom $ showT b
|
||||
skTo <- insertSplit k sTo
|
||||
bTo <- insert $ BudgetLabelR skTo ""
|
||||
forM_ (bsBucket btTo) $ \b ->
|
||||
insert_ $ ExpenseBucketR bTo $ showT b
|
||||
|
||||
insertTxBucket :: MonadUnliftIO m => Key CommitR -> KeyTx -> SqlPersistT m ()
|
||||
insertTxBucket c Tx {txDate = d, txDescr = e, txSplits = ss} = do
|
||||
k <- insert $ TransactionR c d e
|
||||
mapM_ (insertSplit k) ss
|
||||
|
||||
insertTx :: MonadUnliftIO m => Key CommitR -> KeyTx -> SqlPersistT m ()
|
||||
insertTx = insertTxBucket Nothing
|
||||
insertTx = insertTxBucket
|
||||
|
||||
insertSplit :: MonadUnliftIO m => Key TransactionR -> KeySplit -> SqlPersistT m ()
|
||||
insertSplit :: MonadUnliftIO m => Key TransactionR -> KeySplit -> SqlPersistT m (Key SplitR)
|
||||
insertSplit t Split {sAcnt = aid, sCurrency = cid, sValue = v, sComment = c} = do
|
||||
insert_ $ SplitR t cid aid c v
|
||||
insert $ SplitR t cid aid c v
|
||||
|
||||
lookupAccount :: MonadUnliftIO m => AcntID -> MappingT m (EitherErr (Key AccountR, AcntSign))
|
||||
lookupAccount p = lookupErr (DBKey AcntField) p <$> asks kmAccount
|
||||
|
|
|
|||
|
|
@ -24,12 +24,11 @@ import Dhall.TH
|
|||
import Language.Haskell.TH.Syntax (Lift)
|
||||
import RIO
|
||||
import qualified RIO.Map as M
|
||||
-- import RIO.State
|
||||
import qualified RIO.Text as T
|
||||
import RIO.Time
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- YAML CONFIG
|
||||
-- DHALL CONFIG
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
makeHaskellTypesWith
|
||||
|
|
@ -43,7 +42,8 @@ makeHaskellTypesWith
|
|||
, MultipleConstructors "MatchYMD" "(./dhall/Types.dhall).MatchYMD"
|
||||
, MultipleConstructors "MatchDate" "(./dhall/Types.dhall).MatchDate"
|
||||
, MultipleConstructors "SplitNum" "(./dhall/Types.dhall).SplitNum"
|
||||
, MultipleConstructors "Bucket" "(./dhall/Types.dhall).Bucket"
|
||||
, MultipleConstructors "ExpenseBucket" "(./dhall/Types.dhall).ExpenseBucket"
|
||||
, MultipleConstructors "IncomeBucket" "(./dhall/Types.dhall).IncomeBucket"
|
||||
, SingleConstructor "Currency" "Currency" "(./dhall/Types.dhall).Currency"
|
||||
, SingleConstructor "Gregorian" "Gregorian" "(./dhall/Types.dhall).Gregorian"
|
||||
, SingleConstructor "GregorianM" "GregorianM" "(./dhall/Types.dhall).GregorianM"
|
||||
|
|
@ -57,6 +57,12 @@ makeHaskellTypesWith
|
|||
, SingleConstructor "MatchVal" "MatchVal" "(./dhall/Types.dhall).MatchVal.Type"
|
||||
, SingleConstructor "Manual" "Manual" "(./dhall/Types.dhall).Manual"
|
||||
, SingleConstructor "Tax" "Tax" "(./dhall/Types.dhall).Tax"
|
||||
, SingleConstructor "Amount" "Amount" "(./dhall/Types.dhall).Amount"
|
||||
, SingleConstructor "TimeAmount" "TimeAmount" "(./dhall/Types.dhall).TimeAmount"
|
||||
, SingleConstructor "Allocation" "Allocation" "(./dhall/Types.dhall).Allocation"
|
||||
, SingleConstructor "Income" "Income" "(./dhall/Types.dhall).Income"
|
||||
, SingleConstructor "Expense" "Expense" "(./dhall/Types.dhall).Expense"
|
||||
, SingleConstructor "Budget" "Budget" "(./dhall/Types.dhall).Budget"
|
||||
]
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
|
|
@ -216,61 +222,41 @@ deriving instance Hashable DatePat
|
|||
--------------------------------------------------------------------------------
|
||||
-- Budget (projecting into the future)
|
||||
|
||||
data Income = Income
|
||||
{ incGross :: !Decimal
|
||||
, incCurrency :: !CurID
|
||||
, incWhen :: !DatePat
|
||||
, incAccount :: !AcntID
|
||||
, incPretax :: ![Allocation Decimal]
|
||||
, incTaxes :: ![Tax]
|
||||
, incPosttax :: ![Allocation (Maybe Decimal)]
|
||||
}
|
||||
deriving (Eq, Hashable, Generic, FromDhall)
|
||||
deriving instance Eq Income
|
||||
|
||||
data Budget = Budget
|
||||
{ income :: ![Income]
|
||||
, expenses :: ![Expense]
|
||||
}
|
||||
deriving (Generic, FromDhall)
|
||||
deriving instance Hashable Income
|
||||
|
||||
deriving instance Eq Tax
|
||||
|
||||
deriving instance Hashable Tax
|
||||
|
||||
data Amount v = Amount
|
||||
{ amtValue :: !v
|
||||
, amtDesc :: !T.Text
|
||||
}
|
||||
deriving (Functor, Foldable, Traversable, Eq, Hashable, Generic, FromDhall)
|
||||
deriving instance Eq Amount
|
||||
|
||||
data Allocation v = Allocation
|
||||
{ alloPath :: !AcntID
|
||||
, alloBucket :: !Bucket
|
||||
, alloAmts :: ![Amount v]
|
||||
, alloCurrency :: !CurID
|
||||
}
|
||||
deriving (Eq, Hashable, Generic, FromDhall)
|
||||
deriving instance Hashable Amount
|
||||
|
||||
deriving instance Eq Bucket
|
||||
deriving instance Eq Allocation
|
||||
|
||||
deriving instance Hashable Bucket
|
||||
deriving instance Hashable Allocation
|
||||
|
||||
deriving instance Show Bucket
|
||||
deriving instance Eq IncomeBucket
|
||||
|
||||
data TimeAmount = TimeAmount
|
||||
{ taWhen :: !DatePat
|
||||
, taAmt :: Amount Decimal
|
||||
}
|
||||
deriving (Eq, Hashable, Generic, FromDhall)
|
||||
deriving instance Hashable IncomeBucket
|
||||
|
||||
data Expense = Expense
|
||||
{ expFrom :: !AcntID
|
||||
, expTo :: !AcntID
|
||||
, expBucket :: !Bucket
|
||||
, expAmounts :: ![TimeAmount]
|
||||
, expCurrency :: !CurID
|
||||
}
|
||||
deriving (Eq, Hashable, Generic, FromDhall)
|
||||
deriving instance Show IncomeBucket
|
||||
|
||||
deriving instance Eq ExpenseBucket
|
||||
|
||||
deriving instance Hashable ExpenseBucket
|
||||
|
||||
deriving instance Show ExpenseBucket
|
||||
|
||||
deriving instance Eq TimeAmount
|
||||
|
||||
deriving instance Hashable TimeAmount
|
||||
|
||||
deriving instance Eq Expense
|
||||
|
||||
deriving instance Hashable Expense
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Statements (data from the past)
|
||||
|
|
@ -502,14 +488,6 @@ accountSign IncomeT = Credit
|
|||
accountSign LiabilityT = Credit
|
||||
accountSign EquityT = Credit
|
||||
|
||||
type RawAmount = Amount (Maybe Rational)
|
||||
|
||||
type BalAmount = Amount Rational
|
||||
|
||||
type RawAllocation = Allocation (Maybe Rational)
|
||||
|
||||
type BalAllocation = Allocation Rational
|
||||
|
||||
type RawSplit = Split AcntID (Maybe Rational) CurID
|
||||
|
||||
type BalSplit = Split AcntID Rational CurID
|
||||
|
|
|
|||
Loading…
Reference in New Issue