diff --git a/hledger-lib/Hledger/Data/Balancing.hs b/hledger-lib/Hledger/Data/Balancing.hs index 6e24d5de4..fe6337e42 100644 --- a/hledger-lib/Hledger/Data/Balancing.hs +++ b/hledger-lib/Hledger/Data/Balancing.hs @@ -18,6 +18,8 @@ module Hledger.Data.Balancing , isTransactionBalanced , balanceTransaction , balanceTransactionHelper + -- * assertion validation +, checkAssertions -- * journal balancing , journalBalanceTransactions -- * tests @@ -146,6 +148,17 @@ transactionCheckBalanced BalancingOpts{commodity_styles_} t = errs isTransactionBalanced :: BalancingOpts -> Transaction -> Bool isTransactionBalanced bopts = null . transactionCheckBalanced bopts +-- | Verify that any assertions in this transaction hold +-- when included in the larger journal. +checkAssertions :: BalancingOpts -> Journal -> Transaction -> Either String Transaction +checkAssertions bopts j t = + if (ignore_assertions_ bopts) || noassertions t then Right t else do + j' <- journalStyleAmounts j + let newtxns = sortOn tdate (jtxns j' ++ [ t ]) + fmap (\_ -> t) $ journalBalanceTransactions defbalancingopts j'{jtxns = newtxns} + where + noassertions = all (isNothing . pbalanceassertion) . tpostings + -- | 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. @@ -1072,6 +1085,32 @@ tests_Balancing = ] + ,testGroup "checkAssertions" $ [ + testCase "simple assertion on same day" $ do + assertRight $ + checkAssertions defbalancingopts nulljournal{ jtxns = [ + transaction (fromGregorian 2025 01 01) [ vpost' "a" (usd 1) Nothing ] + ] } (transaction (fromGregorian 2025 01 01) [ vpost' "a" (usd 1) (balassert (usd 2)) ]) + + ,testCase "inclusive assertions" $ do + assertRight $ + checkAssertions defbalancingopts nulljournal{ jtxns = [ + transaction (fromGregorian 2025 01 01) [ vpost' "a:a" (usd 1) Nothing ] + ,transaction (fromGregorian 2025 01 02) [ vpost' "a:b" (usd 2) Nothing] + ,transaction (fromGregorian 2025 01 02) [ vpost' "a:c" (usd 5) Nothing] + ,transaction (fromGregorian 2025 01 03) [ vpost' "a:d" (eur 10) Nothing] + ] } (transaction (fromGregorian 2025 01 04) [ vpost' "a" (usd 2) (balassertParInc (usd 10))]) + + ,testCase "multicommodity assertion" $ do + assertRight $ + checkAssertions defbalancingopts nulljournal{ jtxns = [ + transaction (fromGregorian 2025 01 01) [ vpost' "a" (usd 1) Nothing ] + ,transaction (fromGregorian 2025 01 02) [ vpost' "a:b" (eur 2) Nothing ] + ,transaction (fromGregorian 2025 01 02) [ vpost' "a:c" (usd 5) Nothing ] + ,transaction (fromGregorian 2025 01 03) [ vpost' "a:b" (eur (-2)) Nothing ] + ] } (transaction (fromGregorian 2025 01 03) [ vpost' "a" (usd 2) (balassertTotInc (usd 8)) ]) + ] + ,testGroup "commodityStylesFromAmounts" $ [ -- Journal similar to the one on #1091: diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index 61dd3f727..7ef9a6a3d 100644 --- a/hledger/Hledger/Cli/Commands/Add.hs +++ b/hledger/Hledger/Cli/Commands/Add.hs @@ -36,7 +36,7 @@ import Safe (headDef, headMay, atMay) import System.Console.CmdArgs.Explicit (flagNone) import System.Console.Haskeline (runInputT, defaultSettings, setComplete) import System.Console.Haskeline.Completion (CompletionFunc, completeWord, isFinished, noCompletion, simpleCompletion) -import System.Console.Wizard (Wizard, defaultTo, line, output, retryMsg, linePrewritten, nonEmpty, parser, run) +import System.Console.Wizard (Wizard, defaultTo, line, output, outputLn, retryMsg, linePrewritten, nonEmpty, parser, run) import System.Console.Wizard.Haskeline import System.IO ( stderr, hPutStr, hPutStrLn ) import Text.Megaparsec @@ -231,16 +231,33 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _) confirmedTransactionWizard prevInput es{esPostings=init esPostings} (dropWhile notPrevAmountAndNotEnterDesc stack) EnterAmountAndComment txnParams account -> amountAndCommentWizard prevInput es >>= \case - Just (amt, comment) -> do + Just (amt, assertion, (comment, tags, pdate1, pdate2)) -> do + -- This check is necessary because we cons a ';' in the comment parser above, + -- and we don't want to add an empty comment here if it wasn't given. + let pcomment = if T.length comment == 1 then "" else comment let p = nullposting{paccount=T.pack $ stripbrackets account ,pamount=mixedAmount amt - ,pcomment=comment + ,pcomment=pcomment ,ptype=accountNamePostingType $ T.pack account + ,pbalanceassertion = assertion + ,pdate=pdate1 + ,pdate2=pdate2 + ,ptags=tags } amountAndCommentString = showAmount amt ++ 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} - confirmedTransactionWizard prevInput{prevAmountAndCmnt=prevAmountAndCmnt'} es' (EnterNewPosting txnParams (Just posting) : stack) + -- Include a dummy posting to balance the unfinished transation in assertion checking + dummytxn = nulltransaction{tpostings = esPostings ++ [p, post "" missingamt] + ,tdate = txnDate txnParams + ,tdescription = txnDesc txnParams } + validated = balanceTransaction defbalancingopts dummytxn >>= checkAssertions defbalancingopts esJournal + case validated of + Left err -> do + liftIO (hPutStrLn stderr err) + confirmedTransactionWizard prevInput es (EnterAmountAndComment txnParams account : stack) + Right _ -> + confirmedTransactionWizard prevInput{prevAmountAndCmnt=prevAmountAndCmnt'} es' (EnterNewPosting txnParams (Just posting) : stack) Nothing -> confirmedTransactionWizard prevInput es (drop 1 stack) EndStage t -> do @@ -324,7 +341,10 @@ accountWizard PrevInput{..} EntryState{..} = do | otherwise = Just t dbg' = id -- strace -amountAndCommentWizard PrevInput{..} EntryState{..} = do +type Comment = (Text, [Tag], Maybe Day, Maybe Day) + +amountAndCommentWizard :: PrevInput -> EntryState -> Wizard Haskeline (Maybe (Amount, Maybe BalanceAssertion, Comment)) +amountAndCommentWizard previnput@PrevInput{..} entrystate@EntryState{..} = do let pnum = length esPostings + 1 (mhistoricalp,followedhistoricalsofar) = case esSimilarTransaction of @@ -339,26 +359,36 @@ amountAndCommentWizard PrevInput{..} EntryState{..} = do | Just hp <- mhistoricalp, followedhistoricalsofar = showamt $ pamount hp | pnum > 1 && not (mixedAmountLooksZero balancingamt) = showamt balancingamtfirstcommodity | otherwise = "" - retryMsg "A valid hledger amount is required. Eg: 1, $2, 3 EUR, \"4 red apples\"." $ - parser parseAmountAndComment $ + retryMsg "A valid hledger amount is required. Eg: 1, $2, 3 EUR, \"4 red apples\"." $ + parser' parseAmountAndComment $ withCompletion (amountCompleter def) $ defaultTo' def $ nonEmpty $ linePrewritten (green' $ printf "Amount %d%s: " pnum (showDefault def)) (fromMaybe "" $ prevAmountAndCmnt `atMay` length esPostings) "" where - parseAmountAndComment s = if s == "<" then return Nothing else either (const Nothing) (return . Just) $ - runParser - (evalStateT (amountandcommentp <* eof) nodefcommodityj) - "" - (T.pack s) + -- Custom parser that combines with Wizard to use IO via outputLn + parser' f a = a >>= \input -> + case f input of + Left err -> do + outputLn (customErrorBundlePretty err) + amountAndCommentWizard previnput entrystate + Right res -> pure res + parseAmountAndComment s = + if s == "<" then Right Nothing else + Just <$> runParser + (evalStateT (amountandcommentp <* eof) nodefcommodityj) + "" + (T.pack s) nodefcommodityj = esJournal{jparsedefaultcommodity=Nothing} - amountandcommentp :: JournalParser Identity (Amount, Text) + amountandcommentp :: JournalParser Identity (Amount, Maybe BalanceAssertion, Comment) amountandcommentp = do a <- amountp lift skipNonNewlineSpaces - c <- T.pack <$> fromMaybe "" `fmap` optional (char ';' >> many anySingle) - -- eof - return (a,c) + assertion <- optional balanceassertionp + com <- T.pack <$> fromMaybe "" `fmap` optional (char ';' >> many anySingle) + case rtp (postingcommentp Nothing) (T.cons ';' com) of + Left err -> fail $ customErrorBundlePretty err + Right comment -> return $ (a, assertion, comment) balancingamt = maNegate . sumPostings $ filter isReal esPostings balancingamtfirstcommodity = mixed . take 1 $ amounts balancingamt showamt = wbUnpack . showMixedAmountB defaultFmt . mixedAmountSetPrecision diff --git a/hledger/hledger.m4.md b/hledger/hledger.m4.md index 3e6f2f816..1b62b0eee 100644 --- a/hledger/hledger.m4.md +++ b/hledger/hledger.m4.md @@ -1802,6 +1802,12 @@ Eg a [commodity directive](#commodity-directive) may limit the display precision, but this will not affect balance assertions. Balance assertion failure messages show exact amounts. +### Assertions and hledger add + +Balance assertions can be included in the amounts given in `add`. +All types of assertions are supported, and assertions can be used as +in a normal journal file. + ## Posting comments Text following `;`, at the end of a posting line, diff --git a/hledger/test/add.test b/hledger/test/add.test index 1becea2df..912aaef94 100644 --- a/hledger/test/add.test +++ b/hledger/test/add.test @@ -114,7 +114,96 @@ $ rm -f nosuch.journal; hledger -f nosuch.journal add; rm -f nosuch.journal > /Amount 3 \[-0.75\]:/ >2 // -## 10. shouldn't add decimals if there aren't any +## 10. Balance assertions with == + +< +2025-05-01 +x +a +50 USD +b +-50 USD == 50 USD +. +$ rm -f nosuch.journal; hledger -f nosuch.journal add; rm -f nosuch.journal +> // +>2 /Balance assertion failed in b/ + +## 11. Balance assertions with = + +< +2025-05-01 +x +a +\$10 +a +10 EUR +a +-10 EUR = 0 EUR +a +\$-10 = $0 +. +$ rm -f nosuch.journal; hledger -f nosuch.journal add; rm -f nosuch.journal +> /Save this transaction to the journal/ +>2 // + +## 12. Assertions with subaccounts + +< +2025-05-01 +x +a:b +1000 JPY +a +-500 JPY ==* 500 JPY +c +-500 JPY +. +$ rm -f nosuch.journal; hledger -f nosuch.journal add; rm -f nosuch.journal +> /Save this transaction to the journal/ +>2 // + +## 13. Assertions with posting dates + +< +2025-05-01 +x +a +50 USD ; date:2025-05-10 +b +-50 USD +. +y +2025-05-05 +x2 +a +10 USD == 10 USD +c +-10 USD +. +# Check the output with c to make sure we get to the final transaction display +# (anything generic is also in the first transaction) +$ rm -f nosuch.journal; hledger -f nosuch.journal add; rm -f nosuch.journal +> /c[[:space:]]+-10 USD/ +>2 // + +## 14. Multi-commodity subaccount assertions +< +2025-05-01 +x +a:b +50 EUR +a:c +500 MXN +a +-50 EUR =* 0 EUR +a +-500 MXN =* 0 MXN +. +$ rm -f nosuch.journal; hledger -f nosuch.journal add; rm -f nosuch.journal +> /Save this transaction to the journal/ +>2 // + +## 15. shouldn't add decimals if there aren't any ## printf '\n\na\n1\nb\n' | hledger -f /dev/null add # < # @@ -124,4 +213,3 @@ $ rm -f nosuch.journal; hledger -f nosuch.journal add; rm -f nosuch.journal # b # $ hledger -f /dev/null add # > /amount 2 \[-1\]/ -