ADD name for budgets
This commit is contained in:
parent
5c3874d4bd
commit
b9a389454f
|
@ -210,7 +210,7 @@ let Transfer =
|
|||
, transCurrency : CurID
|
||||
}
|
||||
|
||||
let Budget = { income : List Income, transfers : List Transfer }
|
||||
let Budget = { name : Text, income : List Income, transfers : List Transfer }
|
||||
|
||||
in { CurID
|
||||
, AcntID
|
||||
|
|
|
@ -4,7 +4,7 @@ let List/map =
|
|||
|
||||
let T =
|
||||
./Types.dhall
|
||||
sha256:49fae993de77c82248b3a53a7237ee06542331e969b185cc943a56746247d4e1
|
||||
sha256:b29c40e8680e3bd2992180b1165a42f6cde1198cdc7efa4fd115e9e25eef50ea
|
||||
|
||||
let nullSplit =
|
||||
\(a : T.SplitAcnt) ->
|
||||
|
|
|
@ -138,7 +138,7 @@ data BudgetTx = BudgetTx
|
|||
, btFrom :: !(BudgetSplit IncomeBucket)
|
||||
, btTo :: !(BudgetSplit ExpenseBucket)
|
||||
, btValue :: !Rational
|
||||
, btDesc :: !T.Text
|
||||
, btName :: !T.Text
|
||||
}
|
||||
|
||||
insertIncome :: MonadUnliftIO m => Income -> MappingT m [InsertError]
|
||||
|
@ -157,7 +157,7 @@ insertIncome i@Income {..} =
|
|||
, btFrom = BudgetSplit incFrom $ Just PostTax
|
||||
, btTo = BudgetSplit incToBal Nothing
|
||||
, btValue = balance
|
||||
, btDesc = "balance after deductions"
|
||||
, btName = "balance after deductions"
|
||||
}
|
||||
fmap concat $ mapM insertBudgetTx $ bal : (pre ++ tax ++ post)
|
||||
unlessLefts res $ return . concat
|
||||
|
@ -175,7 +175,7 @@ fromAllo meta from ib Allocation {..} = fmap (toBT alloPath) alloAmts
|
|||
{ btFrom = BudgetSplit from ib
|
||||
, btTo = BudgetSplit to $ Just alloBucket
|
||||
, btValue = dec2Rat v
|
||||
, btDesc = desc
|
||||
, btName = desc
|
||||
, btMeta = meta
|
||||
}
|
||||
|
||||
|
@ -185,7 +185,7 @@ fromTax meta from Tax {taxAcnt = to, taxValue = v} =
|
|||
{ btFrom = BudgetSplit from (Just IntraTax)
|
||||
, btTo = BudgetSplit to (Just Fixed)
|
||||
, btValue = dec2Rat v
|
||||
, btDesc = ""
|
||||
, btName = ""
|
||||
, btMeta = meta
|
||||
}
|
||||
|
||||
|
@ -223,20 +223,20 @@ insertTransfer t@Transfer {..} =
|
|||
, btFrom = BudgetSplit transFrom Nothing
|
||||
, btTo = BudgetSplit transTo Nothing
|
||||
, btValue = dec2Rat v
|
||||
, btDesc = desc
|
||||
, btName = desc
|
||||
}
|
||||
|
||||
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
|
||||
k <- insert $ TransactionR (bmCommit btMeta) (bmWhen btMeta) btName
|
||||
skFrom <- insertSplit k sFrom
|
||||
bFrom <- insert $ BudgetLabelR skFrom ""
|
||||
bFrom <- insert $ BudgetLabelR skFrom btName
|
||||
forM_ (bsBucket btFrom) $ \b ->
|
||||
insert_ $ IncomeBucketR bFrom b
|
||||
skTo <- insertSplit k sTo
|
||||
bTo <- insert $ BudgetLabelR skTo ""
|
||||
bTo <- insert $ BudgetLabelR skTo btName
|
||||
forM_ (bsBucket btTo) $ \b ->
|
||||
insert_ $ ExpenseBucketR bTo b
|
||||
|
||||
|
|
|
@ -5,7 +5,6 @@
|
|||
|
||||
module Internal.Utils
|
||||
( compareDate
|
||||
-- , intervalMaybeBounds
|
||||
, inBounds
|
||||
, expandBounds
|
||||
, fmtRational
|
||||
|
@ -25,7 +24,6 @@ module Internal.Utils
|
|||
, unlessLefts_
|
||||
, unlessLeft
|
||||
, unlessLefts
|
||||
-- , inMaybeBounds
|
||||
, acntPath2Text
|
||||
, showT
|
||||
, lookupErr
|
||||
|
|
Loading…
Reference in New Issue