pwncash/lib/Internal/Budget.hs

571 lines
18 KiB
Haskell
Raw Normal View History

2023-05-29 15:56:15 -04:00
module Internal.Budget (insertBudget) where
2023-05-07 20:29:33 -04:00
import Control.Monad.Except
import Data.Foldable
2023-05-07 20:29:33 -04:00
import Database.Persist.Monad
2023-05-29 15:56:15 -04:00
import Internal.Database.Ops
import Internal.Types.Main
import Internal.Utils
import RIO hiding (to)
2023-02-12 16:23:32 -05:00
import qualified RIO.List as L
import qualified RIO.Map as M
2023-02-12 21:52:41 -05:00
import qualified RIO.NonEmpty as NE
import qualified RIO.Text as T
import RIO.Time
2023-05-29 16:11:19 -04:00
-- each budget (designated at the top level by a 'name') is processed in the
-- following steps
-- 1. expand all transactions given the desired date range and date patterns for
-- each directive in the budget
-- 2. sort all transactions by date
-- 3. propagate all balances forward, and while doing so assign values to each
-- transaction (some of which depend on the 'current' balance of the
-- target account)
2023-05-29 16:36:59 -04:00
-- 4. assign shadow transactions
2023-05-29 16:11:19 -04:00
-- 5. insert all transactions
2023-05-13 13:53:43 -04:00
insertBudget
:: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
=> Budget
2023-05-16 23:12:29 -04:00
-> m ()
insertBudget
b@Budget
2023-04-30 23:28:16 -04:00
{ bgtLabel
, bgtIncomes
, bgtTransfers
, bgtShadowTransfers
, bgtPretax
, bgtTax
, bgtPosttax
2023-05-29 13:09:17 -04:00
, bgtInterval
} =
2023-05-16 23:12:29 -04:00
whenHash CTBudget b () $ \key -> do
2023-05-29 17:14:01 -04:00
(intAllos, _) <- combineError intAlloRes acntRes (,)
2023-05-29 13:09:17 -04:00
let res1 = mapErrors (insertIncome key bgtLabel intAllos bgtInterval) bgtIncomes
let res2 = expandTransfers key bgtLabel bgtInterval bgtTransfers
2023-05-07 20:29:33 -04:00
txs <- combineError (concat <$> res1) res2 (++)
m <- askDBState kmCurrency
shadow <- liftExcept $ addShadowTransfers m bgtShadowTransfers txs
2023-05-13 13:53:43 -04:00
void $ mapErrors insertBudgetTx $ balanceTransfers $ txs ++ shadow
where
2023-05-29 17:14:01 -04:00
acntRes = mapErrors isNotIncomeAcnt alloAcnts
intAlloRes = combineError3 pre_ tax_ post_ (,,)
2023-05-07 20:29:33 -04:00
pre_ = sortAllos bgtPretax
tax_ = sortAllos bgtTax
post_ = sortAllos bgtPosttax
2023-05-29 17:14:01 -04:00
sortAllos = liftExcept . mapErrors sortAllo
alloAcnts =
(alloAcnt <$> bgtPretax)
++ (alloAcnt <$> bgtTax)
++ (alloAcnt <$> bgtPosttax)
balanceTransfers :: [UnbalancedTransfer] -> [BalancedTransfer]
2023-05-29 13:09:17 -04:00
balanceTransfers = snd . L.mapAccumR go M.empty . reverse . L.sortOn ftWhen
2023-02-12 22:18:31 -05:00
where
2023-05-29 13:09:17 -04:00
go bals f@FlatTransfer {ftFrom, ftTo, ftValue = UnbalancedValue {cvValue, cvType}} =
let balTo = M.findWithDefault 0 ftTo bals
2023-05-16 23:12:29 -04:00
x = amtToMove balTo cvType cvValue
2023-05-29 13:09:17 -04:00
bals' = mapAdd_ ftTo x $ mapAdd_ ftFrom (-x) bals
in (bals', f {ftValue = x})
2023-02-12 22:18:31 -05:00
-- TODO might need to query signs to make this intuitive; as it is this will
-- probably work, but for credit accounts I might need to supply a negative
-- target value
amtToMove _ BTFixed x = x
amtToMove bal BTPercent x = -(x / 100 * bal)
amtToMove bal BTTarget x = x - bal
2023-05-29 15:56:15 -04:00
-- TODO this seems too general for this module
mapAdd_ :: (Ord k, Num v) => k -> v -> M.Map k v -> M.Map k v
2023-05-16 23:12:29 -04:00
mapAdd_ k v = M.alter (maybe (Just v) (Just . (+ v))) k
2023-02-12 22:18:31 -05:00
2023-05-29 15:56:15 -04:00
insertBudgetTx
:: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
=> BalancedTransfer
-> m ()
insertBudgetTx FlatTransfer {ftFrom, ftTo, ftMeta, ftCur, ftValue, ftDesc, ftWhen} = do
((sFrom, sTo), exchange) <- entryPair ftFrom ftTo ftCur ftValue
insertPair sFrom sTo
forM_ exchange $ uncurry insertPair
where
insertPair from to = do
k <- insert $ TransactionR (bmCommit ftMeta) ftWhen ftDesc
insertBudgetLabel k from
insertBudgetLabel k to
2023-05-29 16:11:19 -04:00
insertBudgetLabel k entry = do
sk <- insertEntry k entry
2023-05-29 15:56:15 -04:00
insert_ $ BudgetLabelR sk $ bmName ftMeta
2023-05-29 15:56:15 -04:00
entryPair
:: (MonadInsertError m, MonadFinance m)
=> TaggedAcnt
-> TaggedAcnt
-> BudgetCurrency
-> Rational
2023-05-29 16:11:19 -04:00
-> m (EntryPair, Maybe EntryPair)
2023-05-29 15:56:15 -04:00
entryPair from to cur val = case cur of
NoX curid -> (,Nothing) <$> pair curid from to val
X Exchange {xFromCur, xToCur, xAcnt, xRate} -> do
let middle = TaggedAcnt xAcnt []
let res1 = pair xFromCur from middle val
let res2 = pair xToCur middle to (val * roundPrecision 3 xRate)
combineError res1 res2 $ \a b -> (a, Just b)
where
pair curid from_ to_ v = do
2023-05-29 16:11:19 -04:00
let s1 = entry curid from_ (-v)
let s2 = entry curid to_ v
2023-05-29 15:56:15 -04:00
combineError s1 s2 (,)
2023-05-29 16:11:19 -04:00
entry c TaggedAcnt {taAcnt, taTags} v =
resolveEntry $
2023-05-29 15:56:15 -04:00
Entry
{ eAcnt = taAcnt
, eValue = v
, eComment = ""
, eCurrency = c
, eTags = taTags
}
2023-05-29 15:56:15 -04:00
sortAllo :: MultiAllocation v -> InsertExcept (DaySpanAllocation v)
sortAllo a@Allocation {alloAmts = as} = do
bs <- foldSpan [] $ L.sortOn amtWhen as
return $ a {alloAmts = reverse bs}
where
foldSpan acc [] = return acc
foldSpan acc (x : xs) = do
let start = amtWhen x
res <- case xs of
[] -> resolveDaySpan start
(y : _) -> resolveDaySpan_ (intStart $ amtWhen y) start
foldSpan (x {amtWhen = res} : acc) xs
2023-05-29 15:56:15 -04:00
--------------------------------------------------------------------------------
-- Income
2023-02-12 16:52:42 -05:00
2023-05-29 17:06:38 -04:00
-- TODO this will scan the interval allocations fully each time
-- iteration which is a total waste, but the fix requires turning this
-- loop into a fold which I don't feel like doing now :(
insertIncome
2023-05-29 13:09:17 -04:00
:: (MonadInsertError m, MonadFinance m)
=> CommitRId
-> T.Text
-> IntAllocations
2023-05-29 13:09:17 -04:00
-> Maybe Interval
-> Income
2023-05-07 20:29:33 -04:00
-> m [UnbalancedTransfer]
2023-02-12 16:23:32 -05:00
insertIncome
key
2023-02-12 16:23:32 -05:00
name
(intPre, intTax, intPost)
2023-05-29 13:09:17 -04:00
localInterval
2023-05-14 19:20:10 -04:00
Income
{ incWhen
, incCurrency
, incFrom
, incPretax
, incPosttax
, incTaxes
, incToBal
, incGross
, incPayPeriod
2023-05-29 17:06:38 -04:00
} =
combineErrorM
(combineError incRes nonIncRes (,))
(combineError precRes dayRes (,))
$ \_ (precision, days) -> do
let gross = roundPrecision precision incGross
concat <$> foldDays (allocate precision gross) start days
where
2023-05-29 17:06:38 -04:00
incRes = isIncomeAcnt $ taAcnt incFrom
nonIncRes =
mapErrors isNotIncomeAcnt $
taAcnt incToBal
: (alloAcnt <$> incPretax)
++ (alloAcnt <$> incTaxes)
++ (alloAcnt <$> incPosttax)
precRes = lookupCurrencyPrec incCurrency
dayRes = askDays incWhen localInterval
2023-05-14 19:20:10 -04:00
start = fromGregorian' $ pStart incPayPeriod
pType' = pType incPayPeriod
meta = BudgetMeta key name
flatPre = concatMap flattenAllo incPretax
flatTax = concatMap flattenAllo incTaxes
flatPost = concatMap flattenAllo incPosttax
sumAllos = sum . fmap faValue
-- TODO ensure these are all the "correct" accounts
2023-05-14 19:20:10 -04:00
allocate precision gross prevDay day = do
scaler <- liftExcept $ periodScaler pType' prevDay day
let (preDeductions, pre) =
2023-05-04 21:48:21 -04:00
allocatePre precision gross $
flatPre ++ concatMap (selectAllos day) intPre
tax =
2023-05-14 19:20:10 -04:00
allocateTax precision gross preDeductions scaler $
flatTax ++ concatMap (selectAllos day) intTax
2023-05-18 00:26:55 -04:00
aftertaxGross = gross - sumAllos (tax ++ pre)
post =
2023-05-04 21:48:21 -04:00
allocatePost precision aftertaxGross $
flatPost ++ concatMap (selectAllos day) intPost
balance = aftertaxGross - sumAllos post
bal =
FlatTransfer
2023-05-29 13:09:17 -04:00
{ ftMeta = meta
, ftWhen = day
, ftFrom = incFrom
, ftCur = NoX incCurrency
, ftTo = incToBal
, ftValue = UnbalancedValue BTFixed balance
, ftDesc = "balance after deductions"
}
in if balance < 0
2023-05-07 20:29:33 -04:00
then throwError $ InsertException [IncomeError day name balance]
else return (bal : fmap (allo2Trans meta day incFrom) (pre ++ tax ++ post))
2023-05-14 19:20:10 -04:00
periodScaler
:: PeriodType
-> Day
-> Day
-> InsertExcept PeriodScaler
2023-05-29 16:36:59 -04:00
periodScaler pt prev cur = return scale
2023-05-14 19:20:10 -04:00
where
2023-05-29 16:36:59 -04:00
n = fromIntegral $ workingDays wds prev cur
2023-05-16 23:12:29 -04:00
wds = case pt of
Hourly HourlyPeriod {hpWorkingDays} -> hpWorkingDays
Daily ds -> ds
2023-05-29 16:36:59 -04:00
scale precision x = case pt of
2023-05-14 19:20:10 -04:00
Hourly HourlyPeriod {hpAnnualHours, hpDailyHours} ->
fromRational (rnd $ x / fromIntegral hpAnnualHours)
* fromIntegral hpDailyHours
* n
Daily _ -> x * n / 365.25
where
rnd = roundPrecision precision
2023-05-29 16:36:59 -04:00
-- ASSUME start < end
workingDays :: [Weekday] -> Day -> Day -> Natural
workingDays wds start end = fromIntegral $ daysFull + daysTail
2023-05-16 23:12:29 -04:00
where
interval = diffDays end start
2023-05-29 16:36:59 -04:00
(nFull, nPart) = divMod interval 7
daysFull = fromIntegral (length wds') * nFull
daysTail = fromIntegral $ length $ takeWhile (< nPart) wds'
2023-05-16 23:12:29 -04:00
startDay = dayOfWeek start
wds' = L.sort $ (\x -> diff (fromWeekday x) startDay) <$> L.nub wds
diff a b = fromIntegral $ mod (fromEnum a - fromEnum b) 7
-- ASSUME days is a sorted list
2023-05-29 15:56:15 -04:00
foldDays
:: MonadInsertError m
=> (Day -> Day -> m a)
-> Day
-> [Day]
-> m [a]
foldDays f start days = case NE.nonEmpty days of
Nothing -> return []
Just ds
| any (start >) ds ->
throwError $
InsertException [PeriodError start $ minimum ds]
| otherwise ->
combineErrors $
snd $
L.mapAccumL (\prevDay day -> (day, f prevDay day)) start days
2023-05-29 15:56:15 -04:00
2023-05-29 17:06:38 -04:00
isIncomeAcnt :: (MonadInsertError m, MonadFinance m) => AcntID -> m ()
isIncomeAcnt = checkAcntType IncomeT
isNotIncomeAcnt :: (MonadInsertError m, MonadFinance m) => AcntID -> m ()
isNotIncomeAcnt = checkAcntTypes (AssetT :| [EquityT, ExpenseT, LiabilityT])
2023-05-29 15:56:15 -04:00
checkAcntType
:: (MonadInsertError m, MonadFinance m)
=> AcntType
-> AcntID
2023-05-29 17:06:38 -04:00
-> m ()
2023-05-29 15:56:15 -04:00
checkAcntType t = checkAcntTypes (t :| [])
checkAcntTypes
:: (MonadInsertError m, MonadFinance m)
=> NE.NonEmpty AcntType
-> AcntID
2023-05-29 17:06:38 -04:00
-> m ()
checkAcntTypes ts i = void $ go =<< lookupAccountType i
where
2023-05-29 15:56:15 -04:00
go t
| t `L.elem` ts = return i
| otherwise = throwError $ InsertException [AccountError i ts]
flattenAllo :: SingleAllocation v -> [FlatAllocation v]
flattenAllo Allocation {alloAmts, alloCur, alloTo} = fmap go alloAmts
where
go Amount {amtValue, amtDesc} =
FlatAllocation
{ faCur = NoX alloCur
, faTo = alloTo
, faValue = amtValue
, faDesc = amtDesc
}
-- ASSUME allocations are sorted
selectAllos :: Day -> DaySpanAllocation v -> [FlatAllocation v]
selectAllos day Allocation {alloAmts, alloCur, alloTo} =
go <$> filter ((`inDaySpan` day) . amtWhen) alloAmts
where
go Amount {amtValue, amtDesc} =
FlatAllocation
{ faCur = NoX alloCur
, faTo = alloTo
, faValue = amtValue
, faDesc = amtDesc
}
allo2Trans
:: BudgetMeta
-> Day
2023-02-26 22:53:12 -05:00
-> TaggedAcnt
-> FlatAllocation Rational
-> UnbalancedTransfer
allo2Trans meta day from FlatAllocation {faValue, faTo, faDesc, faCur} =
FlatTransfer
2023-05-29 13:09:17 -04:00
{ ftMeta = meta
, ftWhen = day
, ftFrom = from
, ftCur = faCur
, ftTo = faTo
, ftValue = UnbalancedValue BTFixed faValue
, ftDesc = faDesc
}
2023-05-29 15:56:15 -04:00
allocatePre
:: Natural
-> Rational
-> [FlatAllocation PretaxValue]
-> (M.Map T.Text Rational, [FlatAllocation Rational])
allocatePre precision gross = L.mapAccumR go M.empty
where
go m f@FlatAllocation {faValue} =
let c = preCategory faValue
p = preValue faValue
v =
if prePercent faValue
then (roundPrecision 3 p / 100) * gross
else roundPrecision precision p
in (mapAdd_ c v m, f {faValue = v})
allocateTax
2023-05-04 21:48:21 -04:00
:: Natural
-> Rational
-> M.Map T.Text Rational
2023-05-14 19:20:10 -04:00
-> PeriodScaler
-> [FlatAllocation TaxValue]
-> [FlatAllocation Rational]
2023-05-14 19:20:10 -04:00
allocateTax precision gross preDeds f = fmap (fmap go)
where
go TaxValue {tvCategories, tvMethod} =
2023-05-14 19:20:10 -04:00
let agi = gross - sum (mapMaybe (`M.lookup` preDeds) tvCategories)
in case tvMethod of
2023-05-16 23:12:29 -04:00
TMPercent p ->
roundPrecision precision $
fromRational $
roundPrecision 3 p / 100 * agi
2023-04-30 23:28:16 -04:00
TMBracket TaxProgression {tpDeductible, tpBrackets} ->
2023-05-14 19:20:10 -04:00
let taxDed = roundPrecision precision $ f precision tpDeductible
in foldBracket f precision (agi - taxDed) tpBrackets
2023-05-16 23:12:29 -04:00
-- | Compute effective tax percentage of a bracket
-- The algorithm can be thought of in three phases:
-- 1. Find the highest tax bracket by looping backward until the AGI is less
-- than the bracket limit
-- 2. Computing the tax in the top bracket by subtracting the AGI from the
-- bracket limit and multiplying by the tax percentage.
-- 3. Adding all lower brackets, which are just the limit of the bracket less
-- the amount of the lower bracket times the percentage.
--
-- In reality, this can all be done with one loop, but it isn't clear these
-- three steps are implemented from this alone.
2023-05-14 19:20:10 -04:00
foldBracket :: PeriodScaler -> Natural -> Rational -> [TaxBracket] -> Rational
foldBracket f precision agi bs = fst $ foldr go (0, agi) $ L.sortOn tbLowerLimit bs
where
2023-05-16 23:12:29 -04:00
go TaxBracket {tbLowerLimit, tbPercent} a@(acc, remain) =
2023-05-14 19:20:10 -04:00
let l = roundPrecision precision $ f precision tbLowerLimit
2023-05-08 00:12:01 -04:00
p = roundPrecision 3 tbPercent / 100
2023-05-16 23:12:29 -04:00
in if remain >= l then (acc + p * (remain - l), l) else a
2023-05-29 15:56:15 -04:00
allocatePost
:: Natural
-> Rational
-> [FlatAllocation PosttaxValue]
-> [FlatAllocation Rational]
allocatePost precision aftertax = fmap (fmap go)
where
2023-05-29 15:56:15 -04:00
go PosttaxValue {postValue, postPercent} =
let v = postValue
in if postPercent
then aftertax * roundPrecision 3 v / 100
else roundPrecision precision v
2022-12-11 17:51:11 -05:00
2023-05-29 15:56:15 -04:00
--------------------------------------------------------------------------------
2023-05-29 16:11:19 -04:00
-- Standalone Transfer
2022-12-11 17:51:11 -05:00
2023-02-12 22:18:31 -05:00
expandTransfers
2023-05-07 20:29:33 -04:00
:: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
=> CommitRId
-> T.Text
2023-05-29 13:09:17 -04:00
-> Maybe Interval
-> [BudgetTransfer]
2023-05-07 20:29:33 -04:00
-> m [UnbalancedTransfer]
2023-05-29 13:09:17 -04:00
expandTransfers key name localInterval ts = do
txs <-
fmap (L.sortOn ftWhen . concat) $
combineErrors $
fmap (expandTransfer key name) ts
case localInterval of
Nothing -> return txs
Just i -> do
2023-05-29 15:56:15 -04:00
bounds <- liftExcept $ resolveDaySpan i
return $ filter (inDaySpan bounds . ftWhen) txs
2023-05-04 21:48:21 -04:00
expandTransfer
2023-05-07 20:29:33 -04:00
:: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
=> CommitRId
-> T.Text
-> BudgetTransfer
2023-05-07 20:29:33 -04:00
-> m [UnbalancedTransfer]
2023-05-04 21:48:21 -04:00
expandTransfer key name Transfer {transAmounts, transTo, transCurrency, transFrom} = do
2023-05-07 20:29:33 -04:00
precision <- lookupCurrencyPrec $ initialCurrency transCurrency
fmap concat $ combineErrors $ fmap (go precision) transAmounts
where
go
precision
Amount
{ amtWhen = pat
, amtValue = BudgetTransferValue {btVal = v, btType = y}
, amtDesc = desc
} =
withDates pat $ \day -> do
let meta = BudgetMeta {bmCommit = key, bmName = name}
return
FlatTransfer
2023-05-29 13:09:17 -04:00
{ ftMeta = meta
, ftWhen = day
, ftCur = transCurrency
, ftFrom = transFrom
, ftTo = transTo
, ftValue = UnbalancedValue y $ roundPrecision precision v
, ftDesc = desc
2023-05-07 20:29:33 -04:00
}
2023-05-29 15:56:15 -04:00
withDates
:: (MonadSqlQuery m, MonadFinance m, MonadInsertError m)
=> DatePat
-> (Day -> m a)
-> m [a]
withDates dp f = do
bounds <- askDBState kmBudgetInterval
days <- liftExcept $ expandDatePat bounds dp
combineErrors $ fmap f days
2023-02-12 22:18:31 -05:00
2022-12-11 17:51:11 -05:00
--------------------------------------------------------------------------------
2023-05-29 15:56:15 -04:00
-- shadow transfers
2023-05-13 13:53:43 -04:00
2023-05-29 15:56:15 -04:00
-- TODO this is going to be O(n*m), which might be a problem?
addShadowTransfers
:: CurrencyMap
-> [ShadowTransfer]
-> [UnbalancedTransfer]
-> InsertExcept [UnbalancedTransfer]
addShadowTransfers cm ms txs =
fmap catMaybes $
combineErrors $
fmap (uncurry (fromShadow cm)) $
[(t, m) | t <- txs, m <- ms]
2022-12-11 17:51:11 -05:00
2023-05-29 15:56:15 -04:00
fromShadow
:: CurrencyMap
-> UnbalancedTransfer
-> ShadowTransfer
-> InsertExcept (Maybe UnbalancedTransfer)
fromShadow cm tx t@ShadowTransfer {stFrom, stTo, stDesc, stRatio, stCurrency, stType} = do
res <- shadowMatches (stMatch t) tx
v <- roundPrecisionCur (initialCurrency stCurrency) cm stRatio
return $
if not res
then Nothing
else
Just $
FlatTransfer
{ ftMeta = ftMeta tx
, ftWhen = ftWhen tx
, ftCur = stCurrency
, ftFrom = stFrom
, ftTo = stTo
, ftValue = UnbalancedValue stType $ v * cvValue (ftValue tx)
, ftDesc = stDesc
}
2022-12-11 17:51:11 -05:00
2023-05-29 15:56:15 -04:00
shadowMatches :: TransferMatcher -> UnbalancedTransfer -> InsertExcept Bool
shadowMatches TransferMatcher {tmFrom, tmTo, tmDate, tmVal} tx = do
valRes <- valMatches tmVal $ cvValue $ ftValue tx
return $
memberMaybe (taAcnt $ ftFrom tx) tmFrom
&& memberMaybe (taAcnt $ ftTo tx) tmTo
&& maybe True (`dateMatches` ftWhen tx) tmDate
&& valRes
2022-12-11 17:51:11 -05:00
where
2023-05-29 15:56:15 -04:00
memberMaybe x AcntSet {asList, asInclude} =
(if asInclude then id else not) $ x `elem` asList
2022-12-11 17:51:11 -05:00
2023-05-29 15:56:15 -04:00
--------------------------------------------------------------------------------
-- random
2023-01-28 22:55:07 -05:00
2023-05-29 15:56:15 -04:00
initialCurrency :: BudgetCurrency -> CurID
initialCurrency (NoX c) = c
initialCurrency (X Exchange {xFromCur = c}) = c
2022-12-11 17:51:11 -05:00
2023-05-29 17:06:38 -04:00
alloAcnt :: Allocation w v -> AcntID
alloAcnt = taAcnt . alloTo
2023-05-29 15:56:15 -04:00
data UnbalancedValue = UnbalancedValue
{ cvType :: !BudgetTransferType
, cvValue :: !Rational
}
deriving (Show)
2023-01-28 22:55:07 -05:00
2023-05-29 15:56:15 -04:00
type UnbalancedTransfer = FlatTransfer UnbalancedValue
2023-02-12 21:52:41 -05:00
2023-05-29 15:56:15 -04:00
type BalancedTransfer = FlatTransfer Rational
2023-01-28 22:55:07 -05:00
2023-05-29 15:56:15 -04:00
data FlatTransfer v = FlatTransfer
{ ftFrom :: !TaggedAcnt
, ftTo :: !TaggedAcnt
, ftValue :: !v
, ftWhen :: !Day
, ftDesc :: !T.Text
, ftMeta :: !BudgetMeta
, ftCur :: !BudgetCurrency
}
deriving (Show)
2023-01-28 22:55:07 -05:00
2023-05-29 15:56:15 -04:00
data BudgetMeta = BudgetMeta
{ bmCommit :: !CommitRId
, bmName :: !T.Text
}
deriving (Show)
2023-01-28 22:55:07 -05:00
2023-05-29 15:56:15 -04:00
type IntAllocations =
( [DaySpanAllocation PretaxValue]
, [DaySpanAllocation TaxValue]
, [DaySpanAllocation PosttaxValue]
)
2023-02-12 16:52:42 -05:00
2023-05-29 15:56:15 -04:00
type DaySpanAllocation = Allocation DaySpan
2023-05-04 21:48:21 -04:00
2023-05-29 16:11:19 -04:00
type EntryPair = (KeyEntry, KeyEntry)
2023-05-04 21:48:21 -04:00
2023-05-29 15:56:15 -04:00
type PeriodScaler = Natural -> Double -> Double
2023-05-07 20:29:33 -04:00
2023-05-29 15:56:15 -04:00
data FlatAllocation v = FlatAllocation
{ faValue :: !v
, faDesc :: !T.Text
, faTo :: !TaggedAcnt
, faCur :: !BudgetCurrency
}
deriving (Functor, Show)