ENH rename expense and make error sane
This commit is contained in:
parent
36c6a56f1b
commit
7a64ed77f8
|
@ -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
|
||||||
|
|
|
@ -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) ->
|
||||||
|
|
|
@ -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
|
||||||
}
|
}
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue