ndwarshuis
/
pwncash
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ADD name for budgets

This commit is contained in:
Nathan Dwarshuis 2023-02-05 17:56:23 -05:00
parent 5c3874d4bd
commit b9a389454f
4 changed files with 10 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
dhall/Types.dhall
View File

@ -210,7 +210,7 @@ let Transfer =
, transCurrency : CurID , transCurrency : CurID
} }
let Budget = { income : List Income, transfers : List Transfer } let Budget = { name : Text, income : List Income, transfers : List Transfer }
in { CurID in { CurID
, AcntID , AcntID

2
dhall/common.dhall
View File

@ -4,7 +4,7 @@ let List/map =
let T = let T =
./Types.dhall ./Types.dhall
sha256:49fae993de77c82248b3a53a7237ee06542331e969b185cc943a56746247d4e1 sha256:b29c40e8680e3bd2992180b1165a42f6cde1198cdc7efa4fd115e9e25eef50ea
let nullSplit = let nullSplit =
\(a : T.SplitAcnt) -> \(a : T.SplitAcnt) ->

16
lib/Internal/Insert.hs
View File

@ -138,7 +138,7 @@ data BudgetTx = BudgetTx
, btFrom :: !(BudgetSplit IncomeBucket) , btFrom :: !(BudgetSplit IncomeBucket)
, btTo :: !(BudgetSplit ExpenseBucket) , btTo :: !(BudgetSplit ExpenseBucket)
, btValue :: !Rational , btValue :: !Rational
, btDesc :: !T.Text , btName :: !T.Text
} }
insertIncome :: MonadUnliftIO m => Income -> MappingT m [InsertError] insertIncome :: MonadUnliftIO m => Income -> MappingT m [InsertError]
@ -157,7 +157,7 @@ insertIncome i@Income {..} =
, btFrom = BudgetSplit incFrom $ Just PostTax , btFrom = BudgetSplit incFrom $ Just PostTax
, btTo = BudgetSplit incToBal Nothing , btTo = BudgetSplit incToBal Nothing
, btValue = balance , btValue = balance
, btDesc = "balance after deductions" , btName = "balance after deductions"
} }
fmap concat $ mapM insertBudgetTx $ bal : (pre ++ tax ++ post) fmap concat $ mapM insertBudgetTx $ bal : (pre ++ tax ++ post)
unlessLefts res $ return . concat unlessLefts res $ return . concat
@ -175,7 +175,7 @@ fromAllo meta from ib Allocation {..} = fmap (toBT alloPath) alloAmts
{ btFrom = BudgetSplit from ib { btFrom = BudgetSplit from ib
, btTo = BudgetSplit to $ Just alloBucket , btTo = BudgetSplit to $ Just alloBucket
, btValue = dec2Rat v , btValue = dec2Rat v
, btDesc = desc , btName = desc
, btMeta = meta , btMeta = meta
} }
@ -185,7 +185,7 @@ fromTax meta from Tax {taxAcnt = to, taxValue = v} =
{ btFrom = BudgetSplit from (Just IntraTax) { btFrom = BudgetSplit from (Just IntraTax)
, btTo = BudgetSplit to (Just Fixed) , btTo = BudgetSplit to (Just Fixed)
, btValue = dec2Rat v , btValue = dec2Rat v
, btDesc = "" , btName = ""
, btMeta = meta , btMeta = meta
} }
@ -223,20 +223,20 @@ insertTransfer t@Transfer {..} =
, btFrom = BudgetSplit transFrom Nothing , btFrom = BudgetSplit transFrom Nothing
, btTo = BudgetSplit transTo Nothing , btTo = BudgetSplit transTo Nothing
, btValue = dec2Rat v , btValue = dec2Rat v
, btDesc = desc , btName = desc
} }
insertBudgetTx :: MonadUnliftIO m => BudgetTx -> MappingT m [InsertError] insertBudgetTx :: MonadUnliftIO m => BudgetTx -> MappingT m [InsertError]
insertBudgetTx BudgetTx {..} = do insertBudgetTx BudgetTx {..} = do
res <- splitPair (bsAcnt btFrom) (bsAcnt btTo) (bmCur btMeta) btValue res <- splitPair (bsAcnt btFrom) (bsAcnt btTo) (bmCur btMeta) btValue
unlessLefts_ res $ \(sFrom, sTo) -> lift $ do 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 skFrom <- insertSplit k sFrom
bFrom <- insert $ BudgetLabelR skFrom "" bFrom <- insert $ BudgetLabelR skFrom btName
forM_ (bsBucket btFrom) $ \b -> forM_ (bsBucket btFrom) $ \b ->
insert_ $ IncomeBucketR bFrom b insert_ $ IncomeBucketR bFrom b
skTo <- insertSplit k sTo skTo <- insertSplit k sTo
bTo <- insert $ BudgetLabelR skTo "" bTo <- insert $ BudgetLabelR skTo btName
forM_ (bsBucket btTo) $ \b -> forM_ (bsBucket btTo) $ \b ->
insert_ $ ExpenseBucketR bTo b insert_ $ ExpenseBucketR bTo b

2
lib/Internal/Utils.hs
View File

@ -5,7 +5,6 @@
module Internal.Utils module Internal.Utils
( compareDate ( compareDate
-- , intervalMaybeBounds
, inBounds , inBounds
, expandBounds , expandBounds
, fmtRational , fmtRational
@ -25,7 +24,6 @@ module Internal.Utils
, unlessLefts_ , unlessLefts_
, unlessLeft , unlessLeft
, unlessLefts , unlessLefts
-- , inMaybeBounds
, acntPath2Text , acntPath2Text
, showT , showT
, lookupErr , lookupErr