ENH rename expense and make error sane

This commit is contained in:
Nathan Dwarshuis 2023-01-30 21:12:08 -05:00
parent 36c6a56f1b
commit 7a64ed77f8
5 changed files with 24 additions and 32 deletions

View File

@ -202,16 +202,15 @@ let Income =
, incToBal : AcntID , incToBal : AcntID
} }
let Expense = let Transfer =
{ expFrom : AcntID { transFrom : AcntID
, expTo : AcntID , transTo : AcntID
, expBucket : ExpenseBucket , transBucket : ExpenseBucket
, expAmounts : List TimeAmount , transAmounts : List TimeAmount
, expCurrency : CurID , transCurrency : CurID
} }
let Budget = let Budget = { income : List Income, expenses : List Transfer }
{ income : List Income, expenses : List Expense, manual : List Manual }
in { CurID in { CurID
, AcntID , AcntID
@ -248,7 +247,7 @@ in { CurID
, Import , Import
, Manual , Manual
, Statement , Statement
, Expense , Transfer
, Income , Income
, IncomeBucket , IncomeBucket
, ExpenseBucket , ExpenseBucket

View File

@ -4,7 +4,7 @@ let List/map =
let T = let T =
./Types.dhall ./Types.dhall
sha256:91a8e19048591cc6b7f72dc62f0d5d7d569864f4736b5649422c746904d03a52 sha256:594817d5fd653b122372ca77a705effe76cbfdd774a6402142a0ff698475e77a
let nullSplit = let nullSplit =
\(a : T.SplitAcnt) -> \(a : T.SplitAcnt) ->

View File

@ -89,9 +89,7 @@ mdyPatternMatches x p = case p of
insertBudget :: MonadUnliftIO m => Budget -> MappingT m [InsertError] insertBudget :: MonadUnliftIO m => Budget -> MappingT m [InsertError]
insertBudget Budget {income = is, expenses = es} = do insertBudget Budget {income = is, expenses = es} = do
es1 <- mapM insertIncome is es1 <- mapM insertIncome is
es2 <- mapM insertExpense es es2 <- mapM insertTransfer es
-- es3 <- mapM insertBudgetManual ms
-- return $ concat $ es1 ++ es2 ++ es3
return $ concat $ es1 ++ es2 return $ concat $ es1 ++ es2
-- TODO this hashes twice (not that it really matters) -- TODO this hashes twice (not that it really matters)
@ -195,7 +193,7 @@ balanceIncome
, incTaxes = tax , incTaxes = tax
, incPosttax = post , incPosttax = post
} }
| bal < 0 = Left $ AllocationError undefined dp | bal < 0 = Left $ IncomeError dp
| otherwise = Right bal | otherwise = Right bal
where where
bal = dec2Rat g - sum (sumAllocation <$> pre ++ post) - sumTaxes tax bal = dec2Rat g - sum (sumAllocation <$> pre ++ post) - sumTaxes tax
@ -206,18 +204,18 @@ sumAllocation = sum . fmap (dec2Rat . amtValue) . alloAmts
sumTaxes :: [Tax] -> Rational sumTaxes :: [Tax] -> Rational
sumTaxes = sum . fmap (dec2Rat . taxValue) sumTaxes = sum . fmap (dec2Rat . taxValue)
insertExpense :: MonadUnliftIO m => Expense -> MappingT m [InsertError] insertTransfer :: MonadUnliftIO m => Transfer -> MappingT m [InsertError]
insertExpense e@Expense {..} = insertTransfer t@Transfer {..} =
fmap (concat . concat) $ whenHash CTExpense e [] $ \key -> do fmap (concat . concat) $ whenHash CTExpense t [] $ \key -> do
forM expAmounts $ \(TimeAmount amt pat) -> forM transAmounts $ \(TimeAmount amt pat) ->
withDates pat $ \day -> insertBudgetTx $ budgetTx amt day key withDates pat $ \day -> insertBudgetTx $ budgetTx amt day key
where where
meta d c = BudgetMeta {bmWhen = d, bmCur = expCurrency, bmCommit = c} meta d c = BudgetMeta {bmWhen = d, bmCur = transCurrency, bmCommit = c}
budgetTx (Amount desc v) d c = budgetTx (Amount desc v) d c =
BudgetTx BudgetTx
{ btMeta = meta d c { btMeta = meta d c
, btFrom = BudgetSplit expFrom Nothing , btFrom = BudgetSplit transFrom Nothing
, btTo = BudgetSplit expTo Nothing , btTo = BudgetSplit transTo Nothing
, btValue = dec2Rat v , btValue = dec2Rat v
, btDesc = desc , btDesc = desc
} }

View File

@ -61,7 +61,7 @@ makeHaskellTypesWith
, SingleConstructor "TimeAmount" "TimeAmount" "(./dhall/Types.dhall).TimeAmount" , SingleConstructor "TimeAmount" "TimeAmount" "(./dhall/Types.dhall).TimeAmount"
, SingleConstructor "Allocation" "Allocation" "(./dhall/Types.dhall).Allocation" , SingleConstructor "Allocation" "Allocation" "(./dhall/Types.dhall).Allocation"
, SingleConstructor "Income" "Income" "(./dhall/Types.dhall).Income" , SingleConstructor "Income" "Income" "(./dhall/Types.dhall).Income"
, SingleConstructor "Expense" "Expense" "(./dhall/Types.dhall).Expense" , SingleConstructor "Transfer" "Transfer" "(./dhall/Types.dhall).Transfer"
, SingleConstructor "Budget" "Budget" "(./dhall/Types.dhall).Budget" , SingleConstructor "Budget" "Budget" "(./dhall/Types.dhall).Budget"
] ]
@ -254,9 +254,9 @@ deriving instance Eq TimeAmount
deriving instance Hashable TimeAmount deriving instance Hashable TimeAmount
deriving instance Eq Expense deriving instance Eq Transfer
deriving instance Hashable Expense deriving instance Hashable Transfer
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Statements (data from the past) -- Statements (data from the past)
@ -526,7 +526,7 @@ data InsertError
| ConversionError T.Text | ConversionError T.Text
| LookupError LookupSuberr T.Text | LookupError LookupSuberr T.Text
| BalanceError BalanceType CurID [RawSplit] | BalanceError BalanceType CurID [RawSplit]
| AllocationError AllocationSuberr DatePat | IncomeError DatePat
| StatementError [TxRecord] [Match] | StatementError [TxRecord] [Match]
deriving (Show) deriving (Show)

View File

@ -304,13 +304,8 @@ showError other = (: []) $ case other of
idName CurField = "currency" idName CurField = "currency"
matchName MatchNumeric = "numeric" matchName MatchNumeric = "numeric"
matchName MatchText = "text" matchName MatchText = "text"
(AllocationError t dp) -> T.concat [msg, ": datepattern=", showT dp] (IncomeError dp) ->
where T.append "Income allocations exceed total: datepattern=" $ showT dp
msg = case t of
NoAllocations -> "No post-tax allocations present"
ExceededTotal -> "Allocations exceed total income"
MissingBlank -> "No blank allocation to balance"
TooManyBlanks -> "Cannot balance multiple blank allocations"
(BalanceError t cur rss) -> (BalanceError t cur rss) ->
T.unwords T.unwords
[ msg [ msg