diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index 6aaceceaf..59fd97b36 100644 --- a/hledger/Hledger/Cli/Commands/Add.hs +++ b/hledger/Hledger/Cli/Commands/Add.hs @@ -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 #-} {-# LANGUAGE FlexibleContexts #-} @@ -38,7 +38,7 @@ import Data.Text.Lazy.IO qualified as TL import Data.Time.Calendar (Day, toGregorian) import Data.Time.Format (formatTime, defaultTimeLocale) import Lens.Micro ((^.)) -import Safe (headDef, headMay, atMay) +import Safe (headDef, headMay, atMay, lastMay) import System.Console.CmdArgs.Explicit (flagNone) import System.Console.Haskeline (runInputT, defaultSettings, setComplete) import System.Console.Haskeline.Completion (CompletionFunc, completeWord, isFinished, noCompletion, simpleCompletion) @@ -209,11 +209,12 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _) ,tcomment=txnCmnt ,tpostings=esPostings } - case balanceTransaction defbalancingopts t of -- imprecise balancing (?) + bopts = balancingopts_ (inputopts_ esOpts) + case balanceTransactionInJournal t esJournal bopts of Right t' -> confirmedTransactionWizard prevInput es (EndStage t' : stack) 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 EnterNewPosting _ Nothing -> False _ -> True @@ -237,9 +238,10 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _) confirmedTransactionWizard prevInput es{esPostings=init esPostings} (dropWhile notPrevAmountAndNotEnterDesc stack) EnterAmountAndComment txnParams account -> amountAndCommentWizard prevInput es >>= \case - Just (amt, assertion, (comment, tags, pdate1, pdate2)) -> do - let p = nullposting{paccount=T.pack $ stripbrackets account - ,pamount=mixedAmount amt + Just (mamt, assertion, (comment, tags, pdate1, pdate2)) -> do + let mixedamt = maybe missingmixedamt mixedAmount mamt + p = nullposting{paccount=T.pack $ stripbrackets account + ,pamount=mixedamt ,pcomment=T.dropAround isNewline comment ,ptype=accountNamePostingType $ T.pack account ,pbalanceassertion = assertion @@ -247,7 +249,7 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _) ,pdate2=pdate2 ,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) es' = es{esPostings=esPostings++[p], esArgs=drop 1 esArgs} -- 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 ,tdescription = txnDesc txnParams } bopts = balancingopts_ (inputopts_ esOpts) - validated = balanceTransaction bopts dummytxn >>= transactionCheckAssertions bopts esJournal - case validated of + balanceassignment = mixedamt==missingmixedamt && isJust assertion + 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 liftIO (hPutStrLn stderr err) confirmedTransactionWizard prevInput es (EnterAmountAndComment txnParams account : stack) @@ -278,6 +289,23 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _) where 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 -- 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 "" @@ -352,7 +380,7 @@ accountWizard PrevInput{..} EntryState{..} = do 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 let pnum = length esPostings + 1 (mhistoricalp,followedhistoricalsofar) = @@ -389,16 +417,16 @@ amountAndCommentWizard previnput@PrevInput{..} entrystate@EntryState{..} = do "" (T.pack s) nodefcommodityj = esJournal{jparsedefaultcommodity=Nothing} - amountandcommentp :: JournalParser Identity (Amount, Maybe BalanceAssertion, Comment) + amountandcommentp :: JournalParser Identity (Maybe Amount, Maybe BalanceAssertion, Comment) amountandcommentp = do - a <- amountp + mamt <- optional amountp lift skipNonNewlineSpaces - assertion <- optional balanceassertionp + massertion <- optional balanceassertionp com <- T.pack <$> fromMaybe "" `fmap` optional (char ';' >> many anySingle) case rtp (postingcommentp (let (y,_,_) = toGregorian esDefDate in Just y)) (T.cons ';' com) of Left err -> fail $ customErrorBundlePretty err -- 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 balancingamtfirstcommodity = mixed . take 1 $ amounts balancingamt showamt = wbUnpack . showMixedAmountB defaultFmt . mixedAmountSetPrecision diff --git a/hledger/Hledger/Cli/Commands/Add.md b/hledger/Hledger/Cli/Commands/Add.md index d2c5610ee..254ee8fc9 100644 --- a/hledger/Hledger/Cli/Commands/Add.md +++ b/hledger/Hledger/Cli/Commands/Add.md @@ -60,23 +60,18 @@ There is a detailed tutorial at . ## add and balance assertions -Since hledger 1.43, whenever you enter a posting amount, -`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. +Since hledger 1.43, you can add a [balance assertion](#balance-assertions) by writing `AMOUNT = BALANCE` when asked for an amount. Eg `100 = 500`. -You can use `-I`/`--ignore-assertions` to disable assertion checking temporarily. - -You can also add a new balance assertion by writing it after an amount, eg `$100 = $500`. -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. +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 run `add` with `-I`/`--ignore-assertions` to disable balance assertion checking. ## add and balance assignments -You can't add a new balance assignment using `add`. -Also, existing balance assignments will not be recalculated during a `hledger add` session. -(Because by the time `add` runs, they have been converted to explicit amounts plus balance assertions.) +You can add a [balance assignment](#balance-assignments) by writing just `= BALANCE` when asked for an amount. +The missing amount will be calculated automatically. -This means that if you try to `add` a new posting which is dated earlier than an existing balance assignment, -it will be rejected (because it would break the corresponding assertion). -Unless you disable assertions temporarily with `hledger add -I`. +`add` normally won't let you add a new posting which is dated earlier than an existing balance assignment. +(Because when `add` runs, existing balance assignments have already been calculated and converted to explicit amounts plus balance assertions.) +You can work around this by disabling balance assertion checking with `-I`. diff --git a/hledger/test/add.test b/hledger/test/add.test index 8ae220fcb..5a1f4b688 100644 --- a/hledger/test/add.test +++ b/hledger/test/add.test @@ -75,20 +75,19 @@ $ printf 'D A1000.00\n' >t$$.j; hledger -f t$$.j add >/dev/null; cat t$$.j; rm > /a +1000/ >2 // -# ** 7. existing commodity with greater precision +# ** 7. adding with below-standard precision, saves the entered precision < -a -A1000.0 -b -. -$ 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/ +A2.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 // -# ** 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/ +# ** 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 # < # #