fix: process postings in date order when inferring balance assignments (fix #2025)

This commit is contained in:
Simon Michael 2023-04-27 17:15:21 -10:00
parent 9d0eb20ac5
commit 9ebcd9ec28
2 changed files with 38 additions and 8 deletions

View File

@ -33,8 +33,10 @@ import Control.Monad.Reader as R (ReaderT, reader, runReaderT, ask, asks)
import Control.Monad.ST (ST, runST) import Control.Monad.ST (ST, runST)
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import Data.Array.ST (STArray, getElems, newListArray, writeArray) import Data.Array.ST (STArray, getElems, newListArray, writeArray)
import Data.Bifunctor (second)
import Data.Foldable (asum) import Data.Foldable (asum)
import Data.Function ((&)) import Data.Function ((&))
import Data.Functor ((<&>))
import "base-compat" Data.Functor.Compat (void) import "base-compat" Data.Functor.Compat (void)
import qualified Data.HashTable.Class as H (toList) import qualified Data.HashTable.Class as H (toList)
import qualified Data.HashTable.ST.Cuckoo as H import qualified Data.HashTable.ST.Cuckoo as H
@ -504,9 +506,17 @@ balanceTransactionAndCheckAssertionsB (Left p@Posting{}) =
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
-- for each posting, infer its amount from the balance assignment if applicable, -- for each posting, in date order (though without disturbing their display order),
-- update the account's running balance and check the balance assertion if any -- 1. infer its amount from the balance assignment if applicable,
ps' <- mapM (addOrAssignAmountAndCheckAssertionB . postingStripPrices) ps -- 2. update the account's running balance, and
-- 3. check the balance assertion if any.
ps' <- ps
& zip [1..] -- attach original positions
& sortOn (postingDate.snd) -- sort by date
& mapM (addOrAssignAmountAndCheckAssertionB . second postingStripPrices) -- infer amount, check assertion on each one
<&> sortOn fst -- restore original order
<&> map snd -- discard positions
-- infer any remaining missing amounts, and make sure the transaction is now fully balanced -- infer any remaining missing amounts, and make sure the transaction is now fully balanced
styles <- R.reader bsStyles styles <- R.reader bsStyles
case balanceTransactionHelper defbalancingopts{commodity_styles_=styles} t{tpostings=ps'} of case balanceTransactionHelper defbalancingopts{commodity_styles_=styles} t{tpostings=ps'} of
@ -517,18 +527,20 @@ balanceTransactionAndCheckAssertionsB (Right t@Transaction{tpostings=ps}) = do
-- and save the balanced transaction. -- and save the balanced transaction.
updateTransactionB t' updateTransactionB t'
type NumberedPosting = (Integer, Posting)
-- | 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
-- reset the running balance to, the assigned balance. -- reset the running balance to, the assigned balance.
-- If it has a missing amount and no balance assignment, leave it for later. -- If it has a missing amount and no balance assignment, leave it for later.
-- Then test the balance assertion if any. -- Then test the balance assertion if any.
addOrAssignAmountAndCheckAssertionB :: Posting -> Balancing s Posting addOrAssignAmountAndCheckAssertionB :: NumberedPosting -> Balancing s NumberedPosting
addOrAssignAmountAndCheckAssertionB p@Posting{paccount=acc, pamount=amt, pbalanceassertion=mba} addOrAssignAmountAndCheckAssertionB (i,p@Posting{paccount=acc, pamount=amt, pbalanceassertion=mba})
-- an explicit posting amount -- an explicit posting amount
| hasAmount p = do | hasAmount p = do
newbal <- addToRunningBalanceB acc amt newbal <- addToRunningBalanceB acc amt
whenM (R.reader bsAssrt) $ checkBalanceAssertionB p newbal whenM (R.reader bsAssrt) $ checkBalanceAssertionB p newbal
return p return (i,p)
-- no explicit posting amount, but there is a balance assignment -- no explicit posting amount, but there is a balance assignment
| Just BalanceAssertion{baamount,batotal,bainclusive} <- mba = do | Just BalanceAssertion{baamount,batotal,bainclusive} <- mba = do
@ -542,10 +554,10 @@ addOrAssignAmountAndCheckAssertionB p@Posting{paccount=acc, pamount=amt, pbalanc
diff <- (if bainclusive then setInclusiveRunningBalanceB else setRunningBalanceB) acc newbal diff <- (if bainclusive then setInclusiveRunningBalanceB else setRunningBalanceB) acc newbal
let p' = p{pamount=filterMixedAmount (not . amountIsZero) diff, poriginal=Just $ originalPosting p} let p' = p{pamount=filterMixedAmount (not . amountIsZero) diff, poriginal=Just $ originalPosting p}
whenM (R.reader bsAssrt) $ checkBalanceAssertionB p' newbal whenM (R.reader bsAssrt) $ checkBalanceAssertionB p' newbal
return p' return (i,p')
-- no explicit posting amount, no balance assignment -- no explicit posting amount, no balance assignment
| otherwise = return p | otherwise = return (i,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
-- optionally check the posting's balance assertion if any. -- optionally check the posting's balance assertion if any.

View File

@ -50,3 +50,21 @@ end comment
$ hledger -f- register $ hledger -f- register
>2 /-:9:21/ >2 /-:9:21/
>= 1 >= 1
# 5. In this example, the second posting's later date causes the third posting to be processed
# before it, inferring a -1 amount, causing this transaction to be considered unbalanced. (#2025)
<
2023-01-01
Expenses 1
Assets -1 ; date: 2023-01-02
Assets = -1
$ hledger -f- print
>2 /
1 \| 2023-01-01
\| Expenses 1
\| Assets -1 ; date: 2023-01-02
\| Assets -1 = -1
This transaction is unbalanced.
/
>= 1