slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

;refactor transaction balancing/checking (#1207)

Browse Source
This commit is contained in:
Simon Michael 2020-03-04 21:42:06 -08:00
parent 9b349d9d41
commit 5ed6fe586a
1 changed files with 61 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

113
hledger-lib/Hledger/Data/Journal.hs
View File

@ -585,7 +585,29 @@ journalModifyTransactions j = j{ jtxns = modifyTransactions (jtxnmodifiers j) (j
journalCheckBalanceAssertions :: Journal -> Maybe String journalCheckBalanceAssertions :: Journal -> Maybe String
journalCheckBalanceAssertions = either Just (const Nothing) . journalBalanceTransactions True journalCheckBalanceAssertions = either Just (const Nothing) . journalBalanceTransactions True
-- "Transaction balancing" - inferring missing amounts and checking transaction balancedness and balance assertions -- "Transaction balancing", including: inferring missing amounts,
-- applying balance assignments, checking transaction balancedness,
-- checking balance assertions, respecting posting dates. These things
-- are all interdependent.
-- WARN tricky algorithm and code ahead.
--
-- Code overview as of 20190219, this could/should be simplified/documented more:
-- parseAndFinaliseJournal['] (Cli/Utils.hs), journalAddForecast (Common.hs), budgetJournal (BudgetReport.hs), tests (BalanceReport.hs)
-- journalBalanceTransactions
-- runST
-- runExceptT
-- balanceTransaction (Transaction.hs)
-- balanceTransactionHelper
-- runReaderT
-- 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 (Transaction.hs) XXX hledger add won't allow balance assignments + missing amount ?
-- | Monad used for statefully balancing/amount-inferring/assertion-checking -- | Monad used for statefully balancing/amount-inferring/assertion-checking
-- a sequence of transactions. -- a sequence of transactions.
@ -601,37 +623,40 @@ data BalancingState s = BalancingState {
,bsAssrt :: Bool -- ^ whether to check balance assertions ,bsAssrt :: Bool -- ^ whether to check balance assertions
-- mutable -- mutable
,bsBalances :: H.HashTable s AccountName MixedAmount -- ^ running account balances, initially empty ,bsBalances :: H.HashTable s AccountName MixedAmount -- ^ running account balances, initially empty
,bsTransactions :: STArray s Integer Transaction -- ^ the transactions being balanced ,bsTransactions :: STArray s Integer Transaction -- ^ a mutable array of the transactions being balanced
-- (for efficiency ? journalBalanceTransactions says: not strictly necessary but avoids a sort at the end I think)
} }
-- | Access the current balancing state, and possibly modify the mutable bits, -- | Access the current balancing state, and possibly modify the mutable bits,
-- lifting through the Except and Reader layers into the Balancing monad. -- lifting through the Except and Reader layers into the Balancing monad.
withB :: (BalancingState s -> ST s a) -> Balancing s a withRunningBalance :: (BalancingState s -> ST s a) -> Balancing s a
withB f = ask >>= lift . lift . f withRunningBalance f = ask >>= lift . lift . f
-- | Get an account's running balance so far. -- | Get this account's current running balance (exclusive).
getAmountB :: AccountName -> Balancing s MixedAmount getRunningBalanceB :: AccountName -> Balancing s MixedAmount
getAmountB acc = withB $ \BalancingState{bsBalances} -> do getRunningBalanceB acc = withRunningBalance $ \BalancingState{bsBalances} -> do
fromMaybe 0 <$> H.lookup bsBalances acc fromMaybe 0 <$> H.lookup bsBalances acc
-- | Add an amount to an account's running balance, and return the new running balance. -- | Add this amount to this account's running balance,
addAmountB :: AccountName -> MixedAmount -> Balancing s MixedAmount -- and return the new running balance (exclusive).
addAmountB acc amt = withB $ \BalancingState{bsBalances} -> do addToRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
addToRunningBalanceB acc amt = withRunningBalance $ \BalancingState{bsBalances} -> do
old <- fromMaybe 0 <$> H.lookup bsBalances acc old <- fromMaybe 0 <$> H.lookup bsBalances acc
let new = old + amt let new = old + amt
H.insert bsBalances acc new H.insert bsBalances acc new
return new return new
-- | Set an account's running balance to this amount, and return the difference from the old. -- | Set this account's running balance (exclusive) to this amount,
setAmountB :: AccountName -> MixedAmount -> Balancing s MixedAmount -- and return the difference from the previous value.
setAmountB acc amt = withB $ \BalancingState{bsBalances} -> do setRunningBalanceB :: AccountName -> MixedAmount -> Balancing s MixedAmount
setRunningBalanceB acc amt = withRunningBalance $ \BalancingState{bsBalances} -> do
old <- fromMaybe 0 <$> H.lookup bsBalances acc old <- fromMaybe 0 <$> H.lookup bsBalances acc
H.insert bsBalances acc amt H.insert bsBalances acc amt
return $ amt - old return $ amt - old
-- | Update (overwrite) this transaction with a new one. -- | Update (overwrite) this transaction in the balancing state.
storeTransactionB :: Transaction -> Balancing s () updateTransactionB :: Transaction -> Balancing s ()
storeTransactionB t = withB $ \BalancingState{bsTransactions} -> updateTransactionB t = withRunningBalance $ \BalancingState{bsTransactions} ->
void $ writeArray bsTransactions (tindex t) t void $ writeArray bsTransactions (tindex t) t
-- | Infer any missing amounts (to satisfy balance assignments and -- | Infer any missing amounts (to satisfy balance assignments and
@ -639,30 +664,11 @@ storeTransactionB t = withB $ \BalancingState{bsTransactions} ->
-- and (optional) all balance assertions pass. Or return an error message -- and (optional) all balance assertions pass. Or return an error message
-- (just the first error encountered). -- (just the first error encountered).
-- --
-- Assumes journalInferCommodityStyles has been called, since those affect transaction balancing. -- Assumes journalInferCommodityStyles has been called, since those
-- affect transaction balancing.
-- --
-- This does multiple things because amount inferring, balance assignments, -- This does multiple things at once because amount inferring, balance
-- balance assertions and posting dates are interdependent. -- assignments, balance assertions and posting dates are interdependent.
--
-- This can be simplified further. Overview as of 20190219:
-- @
-- ****** parseAndFinaliseJournal['] (Cli/Utils.hs), journalAddForecast (Common.hs), budgetJournal (BudgetReport.hs), tests (BalanceReport.hs)
-- ******* journalBalanceTransactions
-- ******** runST
-- ********* runExceptT
-- ********** balanceTransaction (Transaction.hs)
-- *********** balanceTransactionHelper
-- ********** runReaderT
-- *********** 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 (Transaction.hs) XXX hledger add won't allow balance assignments + missing amount ?
-- @
journalBalanceTransactions :: Bool -> Journal -> Either String Journal journalBalanceTransactions :: Bool -> Journal -> Either String Journal
journalBalanceTransactions assrt j' = journalBalanceTransactions assrt j' =
let let
@ -714,11 +720,9 @@ journalBalanceTransactions assrt j' =
-- Transaction prices are removed, which helps eg balance-assertions.test: 15. Mix different commodities and assignments. -- 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. -- This stores the balanced transactions in case 2 but not in case 1.
balanceTransactionAndCheckAssertionsB :: Either Posting Transaction -> Balancing s () balanceTransactionAndCheckAssertionsB :: Either Posting Transaction -> Balancing s ()
balanceTransactionAndCheckAssertionsB (Left p@Posting{}) = balanceTransactionAndCheckAssertionsB (Left p@Posting{}) =
-- update the account's running balance and check the balance assertion if any -- update the account's running balance and check the balance assertion if any
void $ addAmountAndCheckAssertionB $ removePrices p void $ addAmountAndCheckAssertionB $ removePrices p
balanceTransactionAndCheckAssertionsB (Right t@Transaction{tpostings=ps}) = do balanceTransactionAndCheckAssertionsB (Right t@Transaction{tpostings=ps}) = do
-- make sure we can handle the balance assignments -- make sure we can handle the balance assignments
mapM_ checkIllegalBalanceAssignmentB ps mapM_ checkIllegalBalanceAssignmentB ps
@ -731,9 +735,9 @@ balanceTransactionAndCheckAssertionsB (Right t@Transaction{tpostings=ps}) = do
Left err -> throwError err Left err -> throwError err
Right (t', inferredacctsandamts) -> do Right (t', inferredacctsandamts) -> do
-- for each amount just inferred, update the running balance -- for each amount just inferred, update the running balance
mapM_ (uncurry addAmountB) inferredacctsandamts mapM_ (uncurry addToRunningBalanceB) inferredacctsandamts
-- and save the balanced transaction. -- and save the balanced transaction.
storeTransactionB t' updateTransactionB t'
-- | If this posting has an explicit amount, add it to the account's running balance. -- | 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 -- If it has a missing amount and a balance assignment, infer the amount from, and
@ -742,28 +746,32 @@ balanceTransactionAndCheckAssertionsB (Right t@Transaction{tpostings=ps}) = do
-- Then test the balance assertion if any. -- Then test the balance assertion if any.
addOrAssignAmountAndCheckAssertionB :: Posting -> Balancing s Posting addOrAssignAmountAndCheckAssertionB :: Posting -> Balancing s Posting
addOrAssignAmountAndCheckAssertionB p@Posting{paccount=acc, pamount=amt, pbalanceassertion=mba} addOrAssignAmountAndCheckAssertionB p@Posting{paccount=acc, pamount=amt, pbalanceassertion=mba}
-- an explicit posting amount
| hasAmount p = do | hasAmount p = do
newbal <- addAmountB acc amt newbal <- addToRunningBalanceB acc amt
whenM (R.reader bsAssrt) $ checkBalanceAssertionB p newbal whenM (R.reader bsAssrt) $ checkBalanceAssertionB p newbal
return p return p
-- no explicit posting amount, but there is a balance assignment
| Just BalanceAssertion{baamount,batotal} <- mba = do | Just BalanceAssertion{baamount,batotal} <- mba = do
(diff,newbal) <- case batotal of (diff,newbal) <- case batotal of
-- a total balance assignment (==, all commodities)
True -> do True -> do
-- a total balance assignment
let newbal = Mixed [baamount] let newbal = Mixed [baamount]
diff <- setAmountB acc newbal diff <- setRunningBalanceB acc newbal
return (diff,newbal) return (diff,newbal)
-- a partial balance assignment (=, one commodity)
False -> do False -> do
-- a partial balance assignment oldbalothercommodities <- filterMixedAmount ((acommodity baamount /=) . acommodity) <$> getRunningBalanceB acc
oldbalothercommodities <- filterMixedAmount ((acommodity baamount /=) . acommodity) <$> getAmountB acc
let assignedbalthiscommodity = Mixed [baamount] let assignedbalthiscommodity = Mixed [baamount]
newbal = oldbalothercommodities + assignedbalthiscommodity newbal = oldbalothercommodities + assignedbalthiscommodity
diff <- setAmountB acc newbal diff <- setRunningBalanceB acc newbal
return (diff,newbal) return (diff,newbal)
let p' = p{pamount=diff, poriginal=Just $ originalPosting p} let p' = p{pamount=diff, poriginal=Just $ originalPosting p}
whenM (R.reader bsAssrt) $ checkBalanceAssertionB p' newbal whenM (R.reader bsAssrt) $ checkBalanceAssertionB p' newbal
return p' return p'
-- no amount, no balance assertion (GHC 7 doesn't like Nothing <- mba here)
-- no explicit posting amount, no balance assignment
| otherwise = return p | otherwise = return p
-- | Add the posting's amount to its account's running balance, and -- | Add the posting's amount to its account's running balance, and
@ -773,7 +781,7 @@ addOrAssignAmountAndCheckAssertionB p@Posting{paccount=acc, pamount=amt, pbalanc
-- need to see the balance as it stands after each individual posting. -- need to see the balance as it stands after each individual posting.
addAmountAndCheckAssertionB :: Posting -> Balancing s Posting addAmountAndCheckAssertionB :: Posting -> Balancing s Posting
addAmountAndCheckAssertionB p | hasAmount p = do addAmountAndCheckAssertionB p | hasAmount p = do
newbal <- addAmountB (paccount p) (pamount p) newbal <- addToRunningBalanceB (paccount p) (pamount p)
whenM (R.reader bsAssrt) $ checkBalanceAssertionB p newbal whenM (R.reader bsAssrt) $ checkBalanceAssertionB p newbal
return p return p
addAmountAndCheckAssertionB p = return p addAmountAndCheckAssertionB p = return p
@ -806,7 +814,8 @@ checkBalanceAssertionOneCommodityB p@Posting{paccount=assertedacct} assertedamt
if isinclusive if isinclusive
then then
-- sum the running balances of this account and any of its subaccounts seen so far -- sum the running balances of this account and any of its subaccounts seen so far
withB $ \BalancingState{bsBalances} -> -- XXX something wrong here, #1207
withRunningBalance $ \BalancingState{bsBalances} ->
H.foldM H.foldM
(\ibal (acc, amt) -> return $ ibal + (\ibal (acc, amt) -> return $ ibal +
if assertedacct==acc || assertedacct `isAccountNamePrefixOf` acc then amt else 0) if assertedacct==acc || assertedacct `isAccountNamePrefixOf` acc then amt else 0)