imp: add: Verify balance assertions on each posting (#2355)

Author: reesmichael1

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 (t : jtxns j')
+    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:

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

hledger/hledger.m4.md

@@ -1803,6 +1803,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, 

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\]/
-