diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index d5920fe22..b6a59db39 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -1,5 +1,6 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} @@ -78,18 +79,22 @@ where import Control.Applicative (Const(..)) import Control.Monad import Control.Monad.Except +import Control.Monad.Extra import Control.Monad.Reader as R import Control.Monad.ST import Data.Array.ST +import Data.Function ((&)) import Data.Functor.Identity (Identity(..)) import qualified Data.HashTable.ST.Cuckoo as H import Data.List import Data.List.Extra (groupSort) +import qualified Data.Map as M import Data.Maybe #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif import qualified Data.Semigroup as Sem +import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T import Safe (headMay, headDef) @@ -97,8 +102,6 @@ import Data.Time.Calendar import Data.Tree import System.Time (ClockTime(TOD)) import Text.Printf -import qualified Data.Map as M -import qualified Data.Set as S import Hledger.Utils import Hledger.Data.Types @@ -567,6 +570,55 @@ journalModifyTransactions j = j{ jtxns = modifyTransactions (jtxnmodifiers j) (j journalCheckBalanceAssertions :: Journal -> Maybe String journalCheckBalanceAssertions = either Just (const Nothing) . journalBalanceTransactions True +-- "Transaction balancing" - inferring missing amounts and checking transaction balancedness and balance assertions + +-- | Monad used for statefully balancing/amount-inferring/assertion-checking +-- a sequence of transactions. +-- Perhaps can be simplified, or would a different ordering of layers make sense ? +-- If you see a way, let us know. +type Balancing s = ReaderT (BalancingState s) (ExceptT String (ST s)) + +-- | The state used while balancing a sequence of transactions. +data BalancingState s = BalancingState { + -- read only + bsStyles :: Maybe (M.Map CommoditySymbol AmountStyle) -- ^ commodity display styles + ,bsUnassignable :: S.Set AccountName -- ^ accounts in which balance assignments may not be used + ,bsAssrt :: Bool -- ^ whether to check balance assertions + -- mutable + ,bsBalances :: H.HashTable s AccountName MixedAmount -- ^ running account balances, initially empty + ,bsTransactions :: STArray s Integer Transaction -- ^ the transactions being balanced + } + +-- | Access the current balancing state, and possibly modify the mutable bits, +-- lifting through the Except and Reader layers into the Balancing monad. +withB :: (BalancingState s -> ST s a) -> Balancing s a +withB f = ask >>= lift . lift . f + +-- | Get an account's running balance so far. +getAmountB :: AccountName -> Balancing s MixedAmount +getAmountB acc = withB $ \BalancingState{bsBalances} -> do + fromMaybe 0 <$> H.lookup bsBalances acc + +-- | Add an amount to an account's running balance, and return the new running balance. +addAmountB :: AccountName -> MixedAmount -> Balancing s MixedAmount +addAmountB acc amt = withB $ \BalancingState{bsBalances} -> do + old <- fromMaybe 0 <$> H.lookup bsBalances acc + let new = old + amt + H.insert bsBalances acc new + return new + +-- | Set an account's running balance to this amount, and return the difference from the old. +setAmountB :: AccountName -> MixedAmount -> Balancing s MixedAmount +setAmountB acc amt = withB $ \BalancingState{bsBalances} -> do + old <- fromMaybe 0 <$> H.lookup bsBalances acc + H.insert bsBalances acc amt + return $ amt - old + +-- | Update (overwrite) this transaction with a new one. +storeTransactionB :: Transaction -> Balancing s () +storeTransactionB t = withB $ \BalancingState{bsTransactions} -> + void $ writeArray bsTransactions (tindex t) t + -- | Infer any missing amounts (to satisfy balance assignments and -- to balance transactions) and check that all transactions balance -- and (optional) all balance assertions pass. Or return an error message @@ -577,171 +629,137 @@ journalCheckBalanceAssertions = either Just (const Nothing) . journalBalanceTran -- This does multiple things because amount inferring, balance assignments, -- balance assertions and posting dates are interdependent. -- --- Overview, 20190216: +-- This can be simplified further. Overview as of 20190219: -- @ --- ****** parseAndFinaliseJournal['] [[Cli/Utils.hs]], journalAddForecast [[Common.hs]], budgetJournal [[BudgetReport.hs]], tests [[BalanceReport.hs]] +-- ****** parseAndFinaliseJournal['] (Cli/Utils.hs), journalAddForecast (Common.hs), budgetJournal (BudgetReport.hs), tests (BalanceReport.hs) -- ******* journalBalanceTransactions -- ******** runST -- ********* runExceptT +-- ********** balanceTransaction (Transaction.hs) +-- *********** balanceTransactionHelper -- ********** runReaderT --- *********** balanceNoAssignmentTransactionB --- ************ balanceTransactionB [[Transaction.hs]] --- ************* balanceTransactionHelper --- ************** inferBalancingAmount --- *********** balanceAssignmentTransactionAndOrCheckAssertionsB --- ************ addAmountAndCheckBalanceAssertionB --- ************* addToBalanceB --- ************ inferFromAssignmentB --- ************ balanceTransactionB [[Transaction.hs]] --- ************* balanceTransactionHelper --- ************ addToBalanceB --- ****** uiCheckBalanceAssertions d ui@UIState{aopts=UIOpts{cliopts_=copts}, ajournal=j} [[ErrorScreen.hs]] +-- *********** balanceTransactionAndCheckAssertionsB +-- ************ addAmountAndCheckAssertionB +-- ************ addOrAssignAmountAndCheckAssertionB +-- ************ balanceTransactionHelper (Transaction.hs) +-- ****** uiCheckBalanceAssertions d ui@UIState{aopts=UIOpts{cliopts_=copts}, ajournal=j} (ErrorScreen.hs) -- ******* journalCheckBalanceAssertions -- ******** journalBalanceTransactions --- ****** transactionWizard, postingsBalanced [[Add.hs]], tests [[Transaction.hs]] --- ******* balanceTransaction +-- ****** transactionWizard, postingsBalanced (Add.hs), tests (Transaction.hs) +-- ******* balanceTransaction (Transaction.hs) XXX hledger add won't allow balance assignments + missing amount ? -- @ journalBalanceTransactions :: Bool -> Journal -> Either String Journal journalBalanceTransactions assrt j' = let -- ensure transactions are numbered, so we can store them by number j@Journal{jtxns=ts} = journalNumberTransactions j' - styles = journalCommodityStyles j + -- display precisions used in balanced checking + styles = Just $ journalCommodityStyles j -- balance assignments will not be allowed on these txnmodifieraccts = S.fromList $ map paccount $ concatMap tmpostingrules $ jtxnmodifiers j in runST $ do - bals <- H.newSized (length $ journalAccountNamesUsed j) - txns <- newListArray (1, genericLength ts) ts + -- We'll update a mutable array of transactions as we balance them, + -- not strictly necessary but avoids a sort at the end I think. + balancedtxns <- newListArray (1, genericLength ts) ts + + -- Infer missing posting amounts, check transactions are balanced, + -- and check balance assertions. This is done in two passes: runExceptT $ do - flip runReaderT (BalancingState styles txnmodifieraccts assrt bals txns) $ do - -- Fill in missing posting amounts, check transactions are balanced, - -- and check balance assertions. This is done in two passes: - -- 1. Balance the transactions which don't have balance assignments, - -- and collect their postings, plus the still-unbalanced transactions, in date order. - sortedpsandts <- sortOn (either postingDate tdate) . concat <$> - mapM' balanceNoAssignmentTransactionB (jtxns j) - -- 2. Step through these, keeping running account balances, - -- performing balance assignments in and balancing the remaining transactions, - -- and checking balance assertions. This last could be a separate pass - -- but perhaps it's more efficient to do all at once. - void $ mapM' balanceAssignmentTransactionAndOrCheckAssertionsB sortedpsandts - ts' <- lift $ getElems txns + + -- 1. Balance the transactions which don't have balance assignments. + let (noassignmenttxns, withassignmenttxns) = partition (null . assignmentPostings) ts + noassignmenttxns' <- forM noassignmenttxns $ \t -> + either throwError (\t -> lift (writeArray balancedtxns (tindex t) t) >> return t) $ + balanceTransaction styles t + + -- 2. Step through the postings of those transactions, and the remaining transactions, in date order, + let sortedpsandts :: [Either Posting Transaction] = + sortOn (either postingDate tdate) $ + map Left (concatMap tpostings noassignmenttxns') ++ + map Right withassignmenttxns + -- keeping running account balances, + runningbals <- lift $ H.newSized (length $ journalAccountNamesUsed j) + flip runReaderT (BalancingState styles txnmodifieraccts assrt runningbals balancedtxns) $ do + -- performing balance assignments in, and balancing, the remaining transactions, + -- and checking balance assertions as each posting is processed. + void $ mapM' balanceTransactionAndCheckAssertionsB sortedpsandts + + ts' <- lift $ getElems balancedtxns return j{jtxns=ts'} --- | If this transaction has no balance assignments, balance and store it --- and return its postings. If it can't be balanced, an error will be thrown. --- --- It it has balance assignments, return it unchanged. If any posting has both --- a balance assignment and a custom date, an error will be thrown. --- -balanceNoAssignmentTransactionB :: Transaction -> Balancing s [Either Posting Transaction] -balanceNoAssignmentTransactionB t - | null (assignmentPostings t) = do - styles <- R.reader bsStyles - t' <- lift $ ExceptT $ return $ balanceTransaction (Just styles) t - storeTransactionB t' - return [Left $ removePrices p | p <- tpostings t'] +-- | This function is called statefully on each of a date-ordered sequence of +-- 1. fully explicit postings from already-balanced transactions and +-- 2. not-yet-balanced transactions containing balance assignments. +-- It executes balance assignments and finishes balancing the transactions, +-- and checks balance assertions on each posting as it goes. +-- An error will be thrown if a transaction can't be balanced +-- or if an illegal balance assignment is found (cf checkIllegalBalanceAssignment). +-- Transaction prices are removed, which helps eg balance-assertions.test: 15. Mix different commodities and assignments. +-- This stores the balanced transactions in case 2 but not in case 1. +balanceTransactionAndCheckAssertionsB :: Either Posting Transaction -> Balancing s () - | otherwise = do - when (any (isJust . pdate) $ tpostings t) $ -- XXX check more carefully that date and assignment are on same posting ? - throwError $ - unlines $ - [ "postings may not have both a custom date and a balance assignment." - , "Write the posting amount explicitly, or remove the posting date:\n" - , showTransaction t - ] - return [Right $ t {tpostings = removePrices <$> tpostings t}] +balanceTransactionAndCheckAssertionsB (Left p@Posting{}) = + -- update the account's running balance and check the balance assertion if any + void $ addAmountAndCheckAssertionB $ removePrices p --- | This function is called in turn on each item in a date-ordered sequence --- of postings (from already-balanced transactions) or transactions --- (not yet balanced, because containing balance assignments). --- It applies balance assignments and balances the unbalanced transactions, --- and checks any balance assertion(s). --- --- For a posting: update the account's running balance, and --- check the balance assertion if any. --- --- For a transaction: for each posting, --- --- - if it has a missing amount and a balance assignment, infer the amount --- --- - update the account's running balance --- --- - check the balance assertion if any --- --- Then balance the transaction, so that any remaining missing amount is inferred. --- And if that happened, also update *that* account's running balance. XXX and check the assertion ? --- And store the transaction. --- --- Will throw an error if a transaction can't be balanced, --- or if an illegal balance assignment is found (cf checkIllegalBalanceAssignment). --- -balanceAssignmentTransactionAndOrCheckAssertionsB :: Either Posting Transaction -> Balancing s () -balanceAssignmentTransactionAndOrCheckAssertionsB (Left p) = do - checkIllegalBalanceAssignmentB p - void $ addAmountAndCheckBalanceAssertionB return p -balanceAssignmentTransactionAndOrCheckAssertionsB (Right t@Transaction{tpostings=ps}) = do +balanceTransactionAndCheckAssertionsB (Right t@Transaction{tpostings=ps}) = do + -- make sure we can handle the balance assignments mapM_ checkIllegalBalanceAssignmentB ps - ps' <- forM ps $ addAmountAndCheckBalanceAssertionB inferFromAssignmentB + -- for each posting, infer its amount from the balance assignment if applicable, + -- update the account's running balance and check the balance assertion if any + ps' <- forM ps $ \p -> pure (removePrices p) >>= addOrAssignAmountAndCheckAssertionB + -- infer any remaining missing amounts, and make sure the transaction is now fully balanced styles <- R.reader bsStyles - storeTransactionB =<< - balanceTransactionB (fmap void . addToBalanceB) (Just styles) t{tpostings=ps'} + case balanceTransactionHelper styles t{tpostings=ps'} of + Left err -> throwError err + Right (t', inferredacctsandamts) -> do + -- for each amount just inferred, update the running balance + mapM_ (uncurry addAmountB) inferredacctsandamts + -- and save the balanced transaction. + storeTransactionB t' --- | Throw an error if this posting is trying to do a balance assignment and --- the account does not allow balance assignments (because it is referenced --- by a transaction modifier). -checkIllegalBalanceAssignmentB :: Posting -> Balancing s () -checkIllegalBalanceAssignmentB p = do - unassignable <- R.asks bsUnassignable - when (isAssignment p && paccount p `S.member` unassignable) $ - throwError $ - unlines $ - [ "cannot assign amount to account " - , "" - , " " ++ T.unpack (paccount p) - , "" - , "because it is also included in transaction modifiers." - ] +-- | If this posting has an explicit amount, add it to the account's running balance. +-- If it has a missing amount and a balance assignment, infer the amount from, and +-- reset the running balance to, the assigned balance. +-- If it has a missing amount and no balance assignment, leave it for later. +-- Then test the balance assertion if any. +addOrAssignAmountAndCheckAssertionB :: Posting -> Balancing s Posting +addOrAssignAmountAndCheckAssertionB p@Posting{paccount=acc, pamount=amt, pbalanceassertion=mba} + | hasAmount p = do + newbal <- addAmountB acc amt + whenM (R.reader bsAssrt) $ checkBalanceAssertionB p newbal + return p + | Nothing <- mba = return p + | Just BalanceAssertion{baamount,batotal} <- mba = do + (diff,newbal) <- case batotal of + True -> do + -- a total balance assignment + let newbal = Mixed [baamount] + diff <- setAmountB acc newbal + return (diff,newbal) + False -> do + -- a partial balance assignment + oldbalothercommodities <- filterMixedAmount ((acommodity baamount /=) . acommodity) <$> getAmountB acc + let assignedbalthiscommodity = Mixed [baamount] + newbal = oldbalothercommodities + assignedbalthiscommodity + diff <- setAmountB acc newbal + return (diff,newbal) + let p' = p{pamount=diff, porigin=Just $ originalPosting p} + whenM (R.reader bsAssrt) $ checkBalanceAssertionB p' newbal + return p' --- | If this posting has a missing amount and a balance assignment, use --- the running account balance to infer the amount required to satisfy --- the assignment. -inferFromAssignmentB :: Posting -> Balancing s Posting -inferFromAssignmentB p@Posting{paccount=acc} = - case pbalanceassertion p of - Nothing -> return p - Just ba | batotal ba -> do - diff <- setAccountRunningBalance acc $ Mixed [baamount ba] - return $ setPostingAmount diff p - Just ba -> do - oldbal <- fromMaybe 0 <$> liftB (\bs -> H.lookup (bsBalances bs) acc) - let amt = baamount ba - newbal = filterMixedAmount ((/=acommodity amt).acommodity) oldbal + Mixed [amt] - diff <- setAccountRunningBalance acc newbal - return $ setPostingAmount diff p - where - setPostingAmount a p = p{pamount=a, porigin=Just $ originalPosting p} - -- | Set the account's running balance, and return the difference from the old. - setAccountRunningBalance :: AccountName -> MixedAmount -> Balancing s MixedAmount - setAccountRunningBalance acc amt = liftB $ \BalancingState{bsBalances=bals} -> do - old <- fromMaybe 0 <$> H.lookup bals acc - H.insert bals acc amt - return $ amt - old - --- | Adds a posting's amount to the posting's account's running balance, and --- checks the posting's balance assertion if any. Or if the posting has no --- amount, runs the supplied fallback action. -addAmountAndCheckBalanceAssertionB :: - (Posting -> Balancing s Posting) -- ^ fallback action XXX why ? - -> Posting - -> Balancing s Posting -addAmountAndCheckBalanceAssertionB _ p | hasAmount p = do - newAmt <- addToBalanceB (paccount p) (pamount p) - assrt <- R.reader bsAssrt - when assrt $ checkBalanceAssertionB p newAmt +-- | Add the posting's amount to its account's running balance, and +-- optionally check the posting's balance assertion if any. +-- The posting is expected to have an explicit amount (otherwise this does nothing). +-- Adding and checking balance assertions are tightly paired because we +-- need to see the balance as it stands after each individual posting. +addAmountAndCheckAssertionB :: Posting -> Balancing s Posting +addAmountAndCheckAssertionB p | hasAmount p = do + newbal <- addAmountB (paccount p) (pamount p) + whenM (R.reader bsAssrt) $ checkBalanceAssertionB p newbal return p -addAmountAndCheckBalanceAssertionB fallback p = fallback p +addAmountAndCheckAssertionB p = return p -- | Check a posting's balance assertion against the given actual balance, and -- return an error if the assertion is not satisfied. @@ -766,22 +784,21 @@ checkBalanceAssertionB _ _ = return () -- subaccount-inclusive balance; otherwise, with the subaccount-exclusive balance. checkBalanceAssertionOneCommodityB :: Posting -> Amount -> MixedAmount -> Balancing s () checkBalanceAssertionOneCommodityB p@Posting{paccount=assertedacct} assertedamt actualbal = do - -- sum the running balances of this account and any subaccounts seen so far - bals <- R.asks bsBalances - actualibal <- liftB $ const $ H.foldM - (\bal (acc, amt) -> return $ - if assertedacct==acc || assertedacct `isAccountNamePrefixOf` acc - then bal + amt - else bal) - 0 - bals + let isinclusive = maybe False bainclusive $ pbalanceassertion p + actualbal' <- + if isinclusive + then + -- sum the running balances of this account and any of its subaccounts seen so far + withB $ \BalancingState{bsBalances} -> + H.foldM + (\ibal (acc, amt) -> return $ ibal + + if assertedacct==acc || assertedacct `isAccountNamePrefixOf` acc then amt else 0) + 0 + bsBalances + else return actualbal let - isinclusive = maybe False bainclusive $ pbalanceassertion p - actualbal' - | isinclusive = actualibal - | otherwise = actualbal assertedcomm = acommodity assertedamt - actualbalincomm = headDef 0 $ amounts $ filterMixedAmountByCommodity assertedcomm actualbal' + actualbalincomm = headDef 0 $ amounts $ filterMixedAmountByCommodity assertedcomm $ actualbal' pass = aquantity -- traceWith (("asserted:"++).showAmountDebug) @@ -823,6 +840,47 @@ checkBalanceAssertionOneCommodityB p@Posting{paccount=assertedacct} assertedamt when (not pass) $ throwError errmsg +-- | Throw an error if this posting is trying to do an illegal balance assignment. +checkIllegalBalanceAssignmentB :: Posting -> Balancing s () +checkIllegalBalanceAssignmentB p = do + checkBalanceAssignmentPostingDateB p + checkBalanceAssignmentUnassignableAccountB p + +-- XXX these should show position. annotateErrorWithTransaction t ? + +-- | Throw an error if this posting is trying to do a balance assignment and +-- has a custom posting date (which makes amount inference too hard/impossible). +checkBalanceAssignmentPostingDateB :: Posting -> Balancing s () +checkBalanceAssignmentPostingDateB p = + when (hasBalanceAssignment p && isJust (pdate p)) $ + throwError $ unlines $ + ["postings which are balance assignments may not have a custom date." + ,"Please write the posting amount explicitly, or remove the posting date:" + ,"" + ,maybe (unlines $ showPostingLines p) showTransaction $ ptransaction p + ] + +-- | Throw an error if this posting is trying to do a balance assignment and +-- the account does not allow balance assignments (eg because it is referenced +-- by a transaction modifier, which might generate additional postings to it). +checkBalanceAssignmentUnassignableAccountB :: Posting -> Balancing s () +checkBalanceAssignmentUnassignableAccountB p = do + unassignable <- R.asks bsUnassignable + when (hasBalanceAssignment p && paccount p `S.member` unassignable) $ + throwError $ unlines $ + ["balance assignments cannot be used with accounts which are" + ,"posted to by transaction modifier rules (auto postings)." + ,"Please write the posting amount explicitly, or remove the rule." + ,"" + ,"account: "++T.unpack (paccount p) + ,"" + ,"transaction:" + ,"" + ,maybe (unlines $ showPostingLines p) showTransaction $ ptransaction p + ] + +-- + -- | Choose and apply a consistent display format to the posting -- amounts in each commodity. Each commodity's format is specified by -- a commodity format directive, or otherwise inferred from posting @@ -1190,4 +1248,24 @@ tests_Journal = tests "Journal" [ ,test "expenses" $ expectEq (namesfrom journalExpenseAccountQuery) ["expenses","expenses:food","expenses:supplies"] ] + ,test "journalBalanceTransactions" $ do + let ej = journalBalanceTransactions True $ + nulljournal{ jtxns = [ + txnTieKnot $ nulltransaction{ + tdate=parsedate "2019/01/01", + tpostings=[ + nullposting{ + ptype=VirtualPosting + ,paccount="a" + ,pamount=missingmixedamt + ,pbalanceassertion=Just nullassertion{baamount=num 1} + } + ], + tprecedingcomment="" + } + ] + } + expectRight ej + let Right j = ej + (jtxns j & head & tpostings & head & pamount) `is` Mixed [num 1] ] diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 2c2594f84..dd9e1e2cf 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -25,7 +25,7 @@ module Hledger.Data.Posting ( isVirtual, isBalancedVirtual, isEmptyPosting, - isAssignment, + hasBalanceAssignment, hasAmount, postingAllTags, transactionAllTags, @@ -144,8 +144,8 @@ isBalancedVirtual p = ptype p == BalancedVirtualPosting hasAmount :: Posting -> Bool hasAmount = (/= missingmixedamt) . pamount -isAssignment :: Posting -> Bool -isAssignment p = not (hasAmount p) && isJust (pbalanceassertion p) +hasBalanceAssignment :: Posting -> Bool +hasBalanceAssignment p = not (hasAmount p) && isJust (pbalanceassertion p) -- | Sorted unique account names referenced by these postings. accountNamesFromPostings :: [Posting] -> [AccountName] diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index a1d5e5895..becf506e1 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -28,12 +28,7 @@ module Hledger.Data.Transaction ( transactionsPostings, isTransactionBalanced, balanceTransaction, - Balancing, - BalancingState(..), - addToBalanceB, - storeTransactionB, - liftB, - balanceTransactionB, + balanceTransactionHelper, -- nonzerobalanceerror, -- * date operations transactionDate2, @@ -49,18 +44,12 @@ module Hledger.Data.Transaction ( sourceFilePath, sourceFirstLine, showGenericSourcePos, + annotateErrorWithTransaction, -- * tests tests_Transaction ) where import Data.List -import Control.Monad.Except -import Control.Monad.Reader (ReaderT, ask) -import Control.Monad.ST -import Data.Array.ST -import qualified Data.HashTable.ST.Cuckoo as HT -import qualified Data.Map as M -import qualified Data.Set as S import Data.Maybe import Data.Text (Text) import qualified Data.Text as T @@ -308,7 +297,7 @@ realPostings :: Transaction -> [Posting] realPostings = filter isReal . tpostings assignmentPostings :: Transaction -> [Posting] -assignmentPostings = filter isAssignment . tpostings +assignmentPostings = filter hasBalanceAssignment . tpostings virtualPostings :: Transaction -> [Posting] virtualPostings = filter isVirtual . tpostings @@ -341,69 +330,28 @@ isTransactionBalanced styles t = bvsum' = canonicalise $ costOfMixedAmount bvsum canonicalise = maybe id canonicaliseMixedAmount styles --- | Monad used for statefully "balancing" a sequence of transactions. -type Balancing s = ReaderT (BalancingState s) (ExceptT String (ST s)) - --- | The state used while balancing a sequence of transactions. -data BalancingState s = BalancingState { - -- read only - bsStyles :: M.Map CommoditySymbol AmountStyle -- ^ commodity display styles - ,bsUnassignable :: S.Set AccountName -- ^ accounts in which balance assignments may not be used - ,bsAssrt :: Bool -- ^ whether to check balance assertions - -- mutable - ,bsBalances :: HT.HashTable s AccountName MixedAmount -- ^ running account balances, initially empty - ,bsTransactions :: STArray s Integer Transaction -- ^ the transactions being balanced - } - --- | Lift a BalancingState mutator through the Except and Reader --- layers into the Balancing monad. -liftB :: (BalancingState s -> ST s a) -> Balancing s a -liftB f = ask >>= lift . lift . f - --- | Add this amount to this account's running balance, --- and return the new running balance. -addToBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount -addToBalanceB acc amt = liftB $ \BalancingState{bsBalances=bals} -> do - b <- maybe amt (+amt) <$> HT.lookup bals acc - HT.insert bals acc b - return b - --- | Update (overwrite) this transaction with a new one. -storeTransactionB :: Transaction -> Balancing s () -storeTransactionB t = liftB $ \bs -> - void $ writeArray (bsTransactions bs) (tindex t) t - - --- | Balance this transaction, ensuring that its postings sum to 0, +-- | Balance this transaction, ensuring that its postings +-- (and its balanced virtual postings) sum to 0, -- by inferring a missing amount or conversion price(s) if needed. --- Or if balancing is not possible, because of unbalanced amounts or --- more than one missing amount, returns an error message. --- Note this function may be unable to balance some transactions --- that journalBalanceTransactions/balanceTransactionB can balance --- (eg ones with balance assignments). --- Whether postings "sum to 0" depends on commodity display precisions, --- so those can optionally be provided. +-- Or if balancing is not possible, because the amounts don't sum to 0 or +-- because there's more than one missing amount, return an error message. +-- +-- Transactions with balance assignments can have more than one +-- missing amount; to balance those you should use the more powerful +-- journalBalanceTransactions. +-- +-- The "sum to 0" test is done using commodity display precisions, +-- if provided, so that the result agrees with the numbers users can see. +-- balanceTransaction :: Maybe (Map.Map CommoditySymbol AmountStyle) -- ^ commodity display styles -> Transaction -> Either String Transaction balanceTransaction mstyles = fmap fst . balanceTransactionHelper mstyles --- | Like balanceTransaction, but when inferring amounts it will also --- use the given state update function to update running account balances. --- Used when balancing a sequence of transactions (see journalBalanceTransactions). -balanceTransactionB :: - (AccountName -> MixedAmount -> Balancing s ()) -- ^ function to update running balances - -> Maybe (Map.Map CommoditySymbol AmountStyle) -- ^ commodity display styles - -> Transaction - -> Balancing s Transaction -balanceTransactionB updatebalsfn mstyles t = do - case balanceTransactionHelper mstyles t of - Left err -> throwError err - Right (t', inferredacctsandamts) -> do - mapM_ (uncurry updatebalsfn) inferredacctsandamts - return t' - +-- | Helper used by balanceTransaction and balanceTransactionWithBalanceAssignmentAndCheckAssertionsB; +-- use one of those instead. It also returns a list of accounts +-- and amounts that were inferred. balanceTransactionHelper :: Maybe (Map.Map CommoditySymbol AmountStyle) -- ^ commodity display styles -> Transaction @@ -413,7 +361,7 @@ balanceTransactionHelper mstyles t = do inferBalancingAmount (fromMaybe Map.empty mstyles) $ inferBalancingPrices t if isTransactionBalanced mstyles t' then Right (txnTieKnot t', inferredamtsandaccts) - else Left $ annotateErrorWithTxn t' $ nonzerobalanceerror t' + else Left $ annotateErrorWithTransaction t' $ nonzerobalanceerror t' where nonzerobalanceerror :: Transaction -> String @@ -428,8 +376,8 @@ balanceTransactionHelper mstyles t = do ++ showMixedAmount (costOfMixedAmount bvsum) sep = if not (null rmsg) && not (null bvmsg) then "; " else "" :: String -annotateErrorWithTxn :: Transaction -> String -> String -annotateErrorWithTxn t s = intercalate "\n" [showGenericSourcePos $ tsourcepos t, s, showTransactionUnelided t] +annotateErrorWithTransaction :: Transaction -> String -> String +annotateErrorWithTransaction t s = intercalate "\n" [showGenericSourcePos $ tsourcepos t, s, showTransactionUnelided t] -- | Infer up to one missing amount for this transactions's real postings, and -- likewise for its balanced virtual postings, if needed; or return an error @@ -445,9 +393,9 @@ inferBalancingAmount :: -> Either String (Transaction, [(AccountName, MixedAmount)]) inferBalancingAmount styles t@Transaction{tpostings=ps} | length amountlessrealps > 1 - = Left $ annotateErrorWithTxn t "could not balance this transaction - can't have more than one real posting with no amount (remember to put 2 or more spaces before amounts)" + = Left $ annotateErrorWithTransaction t "could not balance this transaction - can't have more than one real posting with no amount (remember to put 2 or more spaces before amounts)" | length amountlessbvps > 1 - = Left $ annotateErrorWithTxn t "could not balance this transaction - can't have more than one balanced virtual posting with no amount (remember to put 2 or more spaces before amounts)" + = Left $ annotateErrorWithTransaction t "could not balance this transaction - can't have more than one balanced virtual posting with no amount (remember to put 2 or more spaces before amounts)" | otherwise = let psandinferredamts = map inferamount ps inferredacctsandamts = [(paccount p, amt) | (p, Just amt) <- psandinferredamts] diff --git a/tests/journal/auto-postings.test b/tests/journal/auto-postings.test index 032d5258b..d642c8039 100644 --- a/tests/journal/auto-postings.test +++ b/tests/journal/auto-postings.test @@ -162,7 +162,7 @@ $ hledger -f- print --auto -x # 9. $ hledger print -f- --auto ->2 /cannot assign amount to account/ +>2 /cannot be used with accounts which are/ >=1 diff --git a/tests/journal/balance-assertions.test b/tests/journal/balance-assertions.test index 7024cfcd7..bf22e8c53 100755 --- a/tests/journal/balance-assertions.test +++ b/tests/journal/balance-assertions.test @@ -231,27 +231,10 @@ hledger -f - stats a $1 =$1 b =$-1 ; date:2012/1/1 ->>>2 /postings may not have both a custom date and a balance assignment/ +>>>2 /balance assignments may not have a custom date/ >>>=1 -# 13. Having both assignments and posting dates is not supported. -hledger -f - stats -<<< - -2013/1/1 - a 1 = -2 - b - c = 5 - -2014/1/1 - a -3 = -3 ; date:2012/1/1 - d = 3 - - ->>>2 /postings may not have both a custom date and a balance assignment/ ->>>=1 - -# 14. Posting Date +# 13. Posting Date hledger -f - stats <<< @@ -276,7 +259,7 @@ hledger -f - stats >>>2 >>>=0 -# 15. Mix different commodities +# 14. Mix different commodities hledger -f - stats <<< 2016/1/1 @@ -290,7 +273,7 @@ hledger -f - stats >>>2 >>>=0 -# 16. Mix different commodities and assignments +# 15. Mix different commodities and assignments hledger -f - stats <<< 2016/1/1 @@ -311,7 +294,7 @@ hledger -f - stats >>>2 >>>=0 -# 17. Total assertions (==) parse correctly +# 16. Total assertions (==) parse correctly hledger -f - stats <<< 2016/1/1 @@ -324,7 +307,7 @@ hledger -f - stats >>>2 >>>=0 -# 18. Total assertions consider entire multicommodity amount +# 17. Total assertions consider entire multicommodity amount hledger -f - stats <<< 2016/1/1 @@ -340,7 +323,7 @@ hledger -f - stats >>>2 /balance assertion.*line 10, column 15/ >>>=1 -# 19. Mix different commodities and total assignments +# 18. Mix different commodities and total assignments hledger -f - stats <<< 2016/1/1 @@ -359,7 +342,7 @@ hledger -f - stats >>>2 >>>=0 -# 20. Balance assertions may have a price, but it's ignored +# 19. Balance assertions may have a price, but it's ignored hledger -f- print <<< 2019/01/01 @@ -370,7 +353,7 @@ hledger -f- print >>>=0 -# 21. Balance assignments may have a price, and it's used for the posting amount. +# 20. Balance assignments may have a price, and it's used for the posting amount. # But not shown as part of the balance assertion in the resulting posting. hledger -f- print --explicit <<< @@ -382,7 +365,7 @@ hledger -f- print --explicit >>>=0 -# 22. close generates balance assertions without prices +# 21. close generates balance assertions without prices hledger -f- close -e 2019/1/2 <<< 2019/01/01 @@ -398,7 +381,7 @@ hledger -f- close -e 2019/1/2 >>>=0 -# 23. The exact amounts are compared; display precision does not affect assertions. +# 22. The exact amounts are compared; display precision does not affect assertions. hledger -f- print <<< commodity $1000.00 @@ -413,7 +396,7 @@ commodity $1000.00 >>>2 >>>=0 -# 24. This fails +# 23. This fails hledger -f- print <<< commodity $1000.00 @@ -427,7 +410,7 @@ commodity $1000.00 >>>2 /difference: 0\.004/ >>>=1 -# 25. This fails +# 24. This fails hledger -f- print <<< commodity $1000.00 @@ -441,7 +424,7 @@ commodity $1000.00 >>>2 /difference: 0\.0001/ >>>=1 -# 26. Inclusive assertions include balances from subaccounts. +# 25. Inclusive assertions include balances from subaccounts. hledger -f- print <<< 2019/1/1