diff --git a/dhall/Types.dhall b/dhall/Types.dhall index a4a8f03..f53f34b 100644 --- a/dhall/Types.dhall +++ b/dhall/Types.dhall @@ -202,16 +202,15 @@ let Income = , incToBal : AcntID } -let Expense = - { expFrom : AcntID - , expTo : AcntID - , expBucket : ExpenseBucket - , expAmounts : List TimeAmount - , expCurrency : CurID +let Transfer = + { transFrom : AcntID + , transTo : AcntID + , transBucket : ExpenseBucket + , transAmounts : List TimeAmount + , transCurrency : CurID } -let Budget = - { income : List Income, expenses : List Expense, manual : List Manual } +let Budget = { income : List Income, expenses : List Transfer } in { CurID , AcntID @@ -248,7 +247,7 @@ in { CurID , Import , Manual , Statement - , Expense + , Transfer , Income , IncomeBucket , ExpenseBucket diff --git a/dhall/common.dhall b/dhall/common.dhall index 206a113..519004b 100644 --- a/dhall/common.dhall +++ b/dhall/common.dhall @@ -4,7 +4,7 @@ let List/map = let T = ./Types.dhall - sha256:91a8e19048591cc6b7f72dc62f0d5d7d569864f4736b5649422c746904d03a52 + sha256:594817d5fd653b122372ca77a705effe76cbfdd774a6402142a0ff698475e77a let nullSplit = \(a : T.SplitAcnt) -> diff --git a/lib/Internal/Insert.hs b/lib/Internal/Insert.hs index e21c6b7..ad5b60f 100644 --- a/lib/Internal/Insert.hs +++ b/lib/Internal/Insert.hs @@ -89,9 +89,7 @@ mdyPatternMatches x p = case p of insertBudget :: MonadUnliftIO m => Budget -> MappingT m [InsertError] insertBudget Budget {income = is, expenses = es} = do es1 <- mapM insertIncome is - es2 <- mapM insertExpense es - -- es3 <- mapM insertBudgetManual ms - -- return $ concat $ es1 ++ es2 ++ es3 + es2 <- mapM insertTransfer es return $ concat $ es1 ++ es2 -- TODO this hashes twice (not that it really matters) @@ -195,7 +193,7 @@ balanceIncome , incTaxes = tax , incPosttax = post } - | bal < 0 = Left $ AllocationError undefined dp + | bal < 0 = Left $ IncomeError dp | otherwise = Right bal where bal = dec2Rat g - sum (sumAllocation <$> pre ++ post) - sumTaxes tax @@ -206,18 +204,18 @@ sumAllocation = sum . fmap (dec2Rat . amtValue) . alloAmts sumTaxes :: [Tax] -> Rational sumTaxes = sum . fmap (dec2Rat . taxValue) -insertExpense :: MonadUnliftIO m => Expense -> MappingT m [InsertError] -insertExpense e@Expense {..} = - fmap (concat . concat) $ whenHash CTExpense e [] $ \key -> do - forM expAmounts $ \(TimeAmount amt pat) -> +insertTransfer :: MonadUnliftIO m => Transfer -> MappingT m [InsertError] +insertTransfer t@Transfer {..} = + fmap (concat . concat) $ whenHash CTExpense t [] $ \key -> do + forM transAmounts $ \(TimeAmount amt pat) -> withDates pat $ \day -> insertBudgetTx $ budgetTx amt day key 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 { btMeta = meta d c - , btFrom = BudgetSplit expFrom Nothing - , btTo = BudgetSplit expTo Nothing + , btFrom = BudgetSplit transFrom Nothing + , btTo = BudgetSplit transTo Nothing , btValue = dec2Rat v , btDesc = desc } diff --git a/lib/Internal/Types.hs b/lib/Internal/Types.hs index 4e32063..c750674 100644 --- a/lib/Internal/Types.hs +++ b/lib/Internal/Types.hs @@ -61,7 +61,7 @@ makeHaskellTypesWith , SingleConstructor "TimeAmount" "TimeAmount" "(./dhall/Types.dhall).TimeAmount" , SingleConstructor "Allocation" "Allocation" "(./dhall/Types.dhall).Allocation" , 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" ] @@ -254,9 +254,9 @@ deriving instance Eq 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) @@ -526,7 +526,7 @@ data InsertError | ConversionError T.Text | LookupError LookupSuberr T.Text | BalanceError BalanceType CurID [RawSplit] - | AllocationError AllocationSuberr DatePat + | IncomeError DatePat | StatementError [TxRecord] [Match] deriving (Show) diff --git a/lib/Internal/Utils.hs b/lib/Internal/Utils.hs index da3feee..93a99c9 100644 --- a/lib/Internal/Utils.hs +++ b/lib/Internal/Utils.hs @@ -304,13 +304,8 @@ showError other = (: []) $ case other of idName CurField = "currency" matchName MatchNumeric = "numeric" matchName MatchText = "text" - (AllocationError t dp) -> T.concat [msg, ": datepattern=", showT dp] - where - 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" + (IncomeError dp) -> + T.append "Income allocations exceed total: datepattern=" $ showT dp (BalanceError t cur rss) -> T.unwords [ msg