fix:add: check balance assertions more accurately; allow balance assignments [#2478]

Balance assertions are now checked more accurately, with awareness of
how everything is ordered in the journal.
Also, it's now possible to add balance assignments.
This commit is contained in:
Simon Michael 2025-11-16 21:25:14 -10:00
parent 4920d76a3a
commit f29fbbe9ea
3 changed files with 80 additions and 40 deletions

View File

@ -1,6 +1,6 @@
{-| {-|
A history-aware add command to help with data entry. A history-aware, tab-completing interactive add command to help with data entry.
|-} -}
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-unused-do-bind #-} {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-unused-do-bind #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
@ -38,7 +38,7 @@ import Data.Text.Lazy.IO qualified as TL
import Data.Time.Calendar (Day, toGregorian) import Data.Time.Calendar (Day, toGregorian)
import Data.Time.Format (formatTime, defaultTimeLocale) import Data.Time.Format (formatTime, defaultTimeLocale)
import Lens.Micro ((^.)) import Lens.Micro ((^.))
import Safe (headDef, headMay, atMay) import Safe (headDef, headMay, atMay, lastMay)
import System.Console.CmdArgs.Explicit (flagNone) import System.Console.CmdArgs.Explicit (flagNone)
import System.Console.Haskeline (runInputT, defaultSettings, setComplete) import System.Console.Haskeline (runInputT, defaultSettings, setComplete)
import System.Console.Haskeline.Completion (CompletionFunc, completeWord, isFinished, noCompletion, simpleCompletion) import System.Console.Haskeline.Completion (CompletionFunc, completeWord, isFinished, noCompletion, simpleCompletion)
@ -209,11 +209,12 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _)
,tcomment=txnCmnt ,tcomment=txnCmnt
,tpostings=esPostings ,tpostings=esPostings
} }
case balanceTransaction defbalancingopts t of -- imprecise balancing (?) bopts = balancingopts_ (inputopts_ esOpts)
case balanceTransactionInJournal t esJournal bopts of
Right t' -> Right t' ->
confirmedTransactionWizard prevInput es (EndStage t' : stack) confirmedTransactionWizard prevInput es (EndStage t' : stack)
Left err -> do Left err -> do
liftIO (hPutStrLn stderr $ "\n" ++ (capitalize err) ++ "please re-enter.") liftIO (hPutStrLn stderr $ "\n" ++ (capitalize err) ++ ", please re-enter.")
let notFirstEnterPost stage = case stage of let notFirstEnterPost stage = case stage of
EnterNewPosting _ Nothing -> False EnterNewPosting _ Nothing -> False
_ -> True _ -> True
@ -237,9 +238,10 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _)
confirmedTransactionWizard prevInput es{esPostings=init esPostings} (dropWhile notPrevAmountAndNotEnterDesc stack) confirmedTransactionWizard prevInput es{esPostings=init esPostings} (dropWhile notPrevAmountAndNotEnterDesc stack)
EnterAmountAndComment txnParams account -> amountAndCommentWizard prevInput es >>= \case EnterAmountAndComment txnParams account -> amountAndCommentWizard prevInput es >>= \case
Just (amt, assertion, (comment, tags, pdate1, pdate2)) -> do Just (mamt, assertion, (comment, tags, pdate1, pdate2)) -> do
let p = nullposting{paccount=T.pack $ stripbrackets account let mixedamt = maybe missingmixedamt mixedAmount mamt
,pamount=mixedAmount amt p = nullposting{paccount=T.pack $ stripbrackets account
,pamount=mixedamt
,pcomment=T.dropAround isNewline comment ,pcomment=T.dropAround isNewline comment
,ptype=accountNamePostingType $ T.pack account ,ptype=accountNamePostingType $ T.pack account
,pbalanceassertion = assertion ,pbalanceassertion = assertion
@ -247,7 +249,7 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _)
,pdate2=pdate2 ,pdate2=pdate2
,ptags=tags ,ptags=tags
} }
amountAndCommentString = showAmount amt ++ T.unpack (if T.null comment then "" else " ;" <> comment) amountAndCommentString = showMixedAmountOneLine mixedamt ++ T.unpack (if T.null comment then "" else " ;" <> comment)
prevAmountAndCmnt' = replaceNthOrAppend (length esPostings) amountAndCommentString (prevAmountAndCmnt prevInput) prevAmountAndCmnt' = replaceNthOrAppend (length esPostings) amountAndCommentString (prevAmountAndCmnt prevInput)
es' = es{esPostings=esPostings++[p], esArgs=drop 1 esArgs} es' = es{esPostings=esPostings++[p], esArgs=drop 1 esArgs}
-- Include a dummy posting to balance the unfinished transation in assertion checking -- Include a dummy posting to balance the unfinished transation in assertion checking
@ -255,8 +257,17 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _)
,tdate = txnDate txnParams ,tdate = txnDate txnParams
,tdescription = txnDesc txnParams } ,tdescription = txnDesc txnParams }
bopts = balancingopts_ (inputopts_ esOpts) bopts = balancingopts_ (inputopts_ esOpts)
validated = balanceTransaction bopts dummytxn >>= transactionCheckAssertions bopts esJournal balanceassignment = mixedamt==missingmixedamt && isJust assertion
case validated of etxn
-- If the new posting is doing a balance assignment,
-- don't attempt to balance the transaction or check assertions yet
| balanceassignment = Right dummytxn
-- Otherwise, balance the transaction in context of the whole journal,
-- maybe filling its balance assignments if any,
-- and maybe checking all the journal's balance assertions.
| otherwise = balanceTransactionInJournal dummytxn esJournal bopts
case etxn of
Left err -> do Left err -> do
liftIO (hPutStrLn stderr err) liftIO (hPutStrLn stderr err)
confirmedTransactionWizard prevInput es (EnterAmountAndComment txnParams account : stack) confirmedTransactionWizard prevInput es (EnterAmountAndComment txnParams account : stack)
@ -278,6 +289,23 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _)
where where
replaceNthOrAppend n newElem xs = take n xs ++ [newElem] ++ drop (n + 1) xs replaceNthOrAppend n newElem xs = take n xs ++ [newElem] ++ drop (n + 1) xs
-- | Balance and check a transaction with awareness of the whole journal it will be added to.
-- This means add it to the journal, balance it, calculate any balance assignments in it,
-- then maybe check all the journal's balance assertions,
-- then return the now fully balanced and checked transaction, or an error message.
balanceTransactionInJournal :: Transaction -> Journal -> BalancingOpts -> Either String Transaction
balanceTransactionInJournal t j bopts = do
-- Add the transaction at the end of the journal, as the add command will.
let j' = j{jtxns = jtxns j ++ [t]}
-- Try to balance and check the whole journal, and specifically the new transaction.
Journal{jtxns=ts} <- journalBalanceTransactions bopts j'
-- Extract the balanced & checked transaction.
maybe
(Left "confirmedTransactionWizard: unexpected empty journal") -- should not happen
Right
(lastMay ts)
-- | A workaround we seem to need for #2410 right now: wizards' input-reading functions disrupt ANSI codes -- | A workaround we seem to need for #2410 right now: wizards' input-reading functions disrupt ANSI codes
-- somehow, so these variants first print the ANSI coded prompt as ordinary output, then do the input with no prompt. -- somehow, so these variants first print the ANSI coded prompt as ordinary output, then do the input with no prompt.
line' prompt = output prompt >> line "" line' prompt = output prompt >> line ""
@ -352,7 +380,7 @@ accountWizard PrevInput{..} EntryState{..} = do
type Comment = (Text, [Tag], Maybe Day, Maybe Day) type Comment = (Text, [Tag], Maybe Day, Maybe Day)
amountAndCommentWizard :: PrevInput -> EntryState -> Wizard Haskeline (Maybe (Amount, Maybe BalanceAssertion, Comment)) amountAndCommentWizard :: PrevInput -> EntryState -> Wizard Haskeline (Maybe (Maybe Amount, Maybe BalanceAssertion, Comment))
amountAndCommentWizard previnput@PrevInput{..} entrystate@EntryState{..} = do amountAndCommentWizard previnput@PrevInput{..} entrystate@EntryState{..} = do
let pnum = length esPostings + 1 let pnum = length esPostings + 1
(mhistoricalp,followedhistoricalsofar) = (mhistoricalp,followedhistoricalsofar) =
@ -389,16 +417,16 @@ amountAndCommentWizard previnput@PrevInput{..} entrystate@EntryState{..} = do
"" ""
(T.pack s) (T.pack s)
nodefcommodityj = esJournal{jparsedefaultcommodity=Nothing} nodefcommodityj = esJournal{jparsedefaultcommodity=Nothing}
amountandcommentp :: JournalParser Identity (Amount, Maybe BalanceAssertion, Comment) amountandcommentp :: JournalParser Identity (Maybe Amount, Maybe BalanceAssertion, Comment)
amountandcommentp = do amountandcommentp = do
a <- amountp mamt <- optional amountp
lift skipNonNewlineSpaces lift skipNonNewlineSpaces
assertion <- optional balanceassertionp massertion <- optional balanceassertionp
com <- T.pack <$> fromMaybe "" `fmap` optional (char ';' >> many anySingle) com <- T.pack <$> fromMaybe "" `fmap` optional (char ';' >> many anySingle)
case rtp (postingcommentp (let (y,_,_) = toGregorian esDefDate in Just y)) (T.cons ';' com) of case rtp (postingcommentp (let (y,_,_) = toGregorian esDefDate in Just y)) (T.cons ';' com) of
Left err -> fail $ customErrorBundlePretty err Left err -> fail $ customErrorBundlePretty err
-- Keep our original comment string from the user to add to the journal -- Keep our original comment string from the user to add to the journal
Right (_, tags, date1', date2') -> return $ (a, assertion, (com, tags, date1', date2')) Right (_, tags, date1', date2') -> return $ (mamt, massertion, (com, tags, date1', date2'))
balancingamt = maNegate . sumPostings $ filter isReal esPostings balancingamt = maNegate . sumPostings $ filter isReal esPostings
balancingamtfirstcommodity = mixed . take 1 $ amounts balancingamt balancingamtfirstcommodity = mixed . take 1 $ amounts balancingamt
showamt = wbUnpack . showMixedAmountB defaultFmt . mixedAmountSetPrecision showamt = wbUnpack . showMixedAmountB defaultFmt . mixedAmountSetPrecision

View File

@ -60,23 +60,18 @@ There is a detailed tutorial at <https://hledger.org/add.html>.
## add and balance assertions ## add and balance assertions
Since hledger 1.43, whenever you enter a posting amount, Since hledger 1.43, you can add a [balance assertion](#balance-assertions) by writing `AMOUNT = BALANCE` when asked for an amount. Eg `100 = 500`.
`add` will re-check all [balance assertions](#balance-assertions) in the journal,
and if any of them fail, it will report the problem and ask for the amount again.
You can use `-I`/`--ignore-assertions` to disable assertion checking temporarily. Also, each time you enter a new amount, hledger re-checks all balance assertions in the journal
and rejects the new amount if it would make any of them fail.
You can also add a new balance assertion by writing it after an amount, eg `$100 = $500`. You can run `add` with `-I`/`--ignore-assertions` to disable balance assertion checking.
The new transaction's date, and the new posting's posting date if any (entered in a comment following the amount),
will influence how the new balance assertion is checked.
## add and balance assignments ## add and balance assignments
You can't add a new balance assignment using `add`. You can add a [balance assignment](#balance-assignments) by writing just `= BALANCE` when asked for an amount.
Also, existing balance assignments will not be recalculated during a `hledger add` session. The missing amount will be calculated automatically.
(Because by the time `add` runs, they have been converted to explicit amounts plus balance assertions.)
This means that if you try to `add` a new posting which is dated earlier than an existing balance assignment, `add` normally won't let you add a new posting which is dated earlier than an existing balance assignment.
it will be rejected (because it would break the corresponding assertion). (Because when `add` runs, existing balance assignments have already been calculated and converted to explicit amounts plus balance assertions.)
Unless you disable assertions temporarily with `hledger add -I`. You can work around this by disabling balance assertion checking with `-I`.

View File

@ -75,20 +75,19 @@ $ printf 'D A1000.00\n' >t$$.j; hledger -f t$$.j add >/dev/null; cat t$$.j; rm
> /a +1000/ > /a +1000/
>2 // >2 //
# ** 7. existing commodity with greater precision # ** 7. adding with below-standard precision, saves the entered precision
< <
a
A1000.0
b
. A2.0
$ printf '2010/1/1\n a A1000.00\n b\n' >t$$.j; hledger -f t$$.j add >/dev/null; cat t$$.j; rm -f t$$.j
> /a +A1000\.0/
$ printf '2010-01-01\n (a) A1.00\n' >t$$.j; hledger -f t$$.j add >/dev/null; cat t$$.j; rm -f t$$.j
> /\(a\) +A2\.0/
>2 // >2 //
# ** 8. existing commodity with less precision # ** 8. adding with above-standard precision, saves the entered precision
< <
@ -265,9 +264,27 @@ $ rm -f nosuch.$$.journal; hledger -f nosuch.$$.journal add; rm -f nosuch.$$.jo
> // > //
>2 /Balance assertion failed in a/ >2 /Balance assertion failed in a/
# ** 19. add's balance assertion checking is aware of how things are ordered in the journal [#2478].
# So a 1 is accepted here without raising a balance assertion error.
<
## 18. shouldn't add decimals if there aren't any
## printf '\n\na\n1\nb\n' | hledger -f /dev/null add (a)
1
$ cp add-2478.j add-2478.$$.j; hledger -f add-2478.$$.j add >/dev/null 2>&1; rm -f add-2478.$$.j
# ** 20. balance assignments can be added, and are aware of the whole journal.
<
(a)
= 5
$ printf '2025-01-01\n (a) 1\n' >t$$.j; hledger -f t$$.j add 2>&1; rm -f t$$.j
> /^ +\(a\) +4 = 5/
# ** . shouldn't add decimals if there aren't any
# printf '\n\na\n1\nb\n' | hledger -f /dev/null add
# < # <
# #
# #