imp: check recentassertions: try to make the error message clearer

This commit is contained in:
Simon Michael 2024-11-02 18:05:53 -10:00
parent 090f001eee
commit 326acbf93b
3 changed files with 34 additions and 34 deletions

View File

@ -33,11 +33,11 @@ import Hledger.Data.Errors
import Hledger.Data.Journal import Hledger.Data.Journal
import Hledger.Data.JournalChecks.Ordereddates import Hledger.Data.JournalChecks.Ordereddates
import Hledger.Data.JournalChecks.Uniqueleafnames import Hledger.Data.JournalChecks.Uniqueleafnames
import Hledger.Data.Posting (isVirtual, postingDate, transactionAllTags, conversionPostingTagName, costPostingTagName) import Hledger.Data.Posting (isVirtual, postingDate, transactionAllTags, conversionPostingTagName, costPostingTagName, postingAsLines)
import Hledger.Data.Types import Hledger.Data.Types
import Hledger.Data.Amount (amountIsZero, amountsRaw, missingamt, amounts) import Hledger.Data.Amount (amountIsZero, amountsRaw, missingamt, oneLineFmt, showMixedAmountWith)
import Hledger.Data.Transaction (transactionPayee, showTransactionLineFirstPart, partitionAndCheckConversionPostings) import Hledger.Data.Transaction (transactionPayee, showTransactionLineFirstPart, partitionAndCheckConversionPostings)
import Data.Time (Day, diffDays) import Data.Time (diffDays)
import Hledger.Utils import Hledger.Utils
import Data.Ord import Data.Ord
import Hledger.Data.Dates (showDate) import Hledger.Data.Dates (showDate)
@ -264,11 +264,10 @@ maxlag = 7
-- | Check that accounts with balance assertions have no posting more -- | Check that accounts with balance assertions have no posting more
-- than maxlag days after their latest balance assertion. -- than maxlag days after their latest balance assertion.
-- Today's date is provided for error messages. journalCheckRecentAssertions :: Journal -> Either String ()
journalCheckRecentAssertions :: Day -> Journal -> Either String () journalCheckRecentAssertions j =
journalCheckRecentAssertions today j =
let acctps = groupOn paccount $ sortOn paccount $ journalPostings j let acctps = groupOn paccount $ sortOn paccount $ journalPostings j
in case mapMaybe (findRecentAssertionError today) acctps of in case mapMaybe findRecentAssertionError acctps of
[] -> Right () [] -> Right ()
firsterr:_ -> Left firsterr firsterr:_ -> Left firsterr
@ -277,8 +276,8 @@ journalCheckRecentAssertions today j =
-- and if any postings are >maxlag days later than the assertion, -- and if any postings are >maxlag days later than the assertion,
-- return an error message identifying the first of them. -- return an error message identifying the first of them.
-- Postings on the same date will be handled in parse order (hopefully). -- Postings on the same date will be handled in parse order (hopefully).
findRecentAssertionError :: Day -> [Posting] -> Maybe String findRecentAssertionError :: [Posting] -> Maybe String
findRecentAssertionError today ps = do findRecentAssertionError ps = do
let rps = sortOn (Data.Ord.Down . postingDate) ps let rps = sortOn (Data.Ord.Down . postingDate) ps
let (afterlatestassertrps, untillatestassertrps) = span (isNothing.pbalanceassertion) rps let (afterlatestassertrps, untillatestassertrps) = span (isNothing.pbalanceassertion) rps
latestassertdate <- postingDate <$> headMay untillatestassertrps latestassertdate <- postingDate <$> headMay untillatestassertrps
@ -287,36 +286,39 @@ findRecentAssertionError today ps = do
let lag = diffDays (postingDate firsterrorp) latestassertdate let lag = diffDays (postingDate firsterrorp) latestassertdate
let acct = paccount firsterrorp let acct = paccount firsterrorp
let (f,l,_mcols,ex) = makePostingAccountErrorExcerpt firsterrorp let (f,l,_mcols,ex) = makePostingAccountErrorExcerpt firsterrorp
let comm = -- let comm =
case map acommodity $ amounts $ pamount firsterrorp of -- case map acommodity $ amounts $ pamount firsterrorp of
[] -> "" -- [] -> ""
(t:_) | T.length t == 1 -> t -- (t:_) | T.length t == 1 -> t
(t:_) -> t <> " " -- (t:_) -> t <> " "
Just $ chomp $ printf Just $ chomp $ printf
(unlines [ (unlines [
"%s:%d:", "%s:%d:",
"%s\n", "%s\n",
"The recentassertions check is enabled, so accounts with balance assertions must", -- "The recentassertions check is enabled, so accounts with balance assertions must",
"have a balance assertion within %d days of their latest posting.", -- "have a balance assertion within %d days of their latest posting.",
"The recentassertions check is enabled, so accounts with balance assertions",
"must have a recent one, not more than %d days older than their latest posting.",
"In account: %s",
"the last assertion was on %s, %d days before this latest posting.",
"Consider adding a new balance assertion to the above posting. Eg:",
"", "",
"In %s,", "%s = BALANCE"
"this posting is %d days later than the balance assertion on %s.",
"",
"Consider adding a more recent balance assertion for this account. Eg:",
"",
"%s\n %s %s0 = %sAMT"
]) ])
f f
l l
(textChomp ex) (textChomp ex)
maxlag maxlag
(bold' $ T.unpack acct) (bold' $ T.unpack acct)
lag
(showDate latestassertdate) (showDate latestassertdate)
(show today) lag
acct (showposting firsterrorp)
comm where
comm showposting p =
headDef "" $ first3 $ postingAsLines False True acctw amtw p{pcomment=""}
where
acctw = T.length $ paccount p
amtw = length $ showMixedAmountWith oneLineFmt $ pamount p
-- -- | Print the last balance assertion date & status of all accounts with balance assertions. -- -- | Print the last balance assertion date & status of all accounts with balance assertions.
-- printAccountLastAssertions :: Day -> [BalanceAssertionInfo] -> IO () -- printAccountLastAssertions :: Day -> [BalanceAssertionInfo] -> IO ()

View File

@ -93,7 +93,6 @@ parseCheckArgument s =
-- on this journal with these options. -- on this journal with these options.
runCheck :: CliOpts -> Journal -> (Check,[String]) -> IO () runCheck :: CliOpts -> Journal -> (Check,[String]) -> IO ()
runCheck _opts j (chck,_) = do runCheck _opts j (chck,_) = do
d <- getCurrentDay
let let
results = case chck of results = case chck of
-- these checks are assumed to have passed earlier during journal parsing (if enabled): -- these checks are assumed to have passed earlier during journal parsing (if enabled):
@ -105,7 +104,7 @@ runCheck _opts j (chck,_) = do
Commodities -> journalCheckCommodities j Commodities -> journalCheckCommodities j
Ordereddates -> journalCheckOrdereddates j Ordereddates -> journalCheckOrdereddates j
Payees -> journalCheckPayees j Payees -> journalCheckPayees j
Recentassertions -> journalCheckRecentAssertions d j Recentassertions -> journalCheckRecentAssertions j
Tags -> journalCheckTags j Tags -> journalCheckTags j
Uniqueleafnames -> journalCheckUniqueleafnames j Uniqueleafnames -> journalCheckUniqueleafnames j

View File

@ -4,9 +4,8 @@ $$$ hledger check recentassertions -f recentassertions.j
18 \| a 0 18 \| a 0
\| \^ \| \^
The recentassertions check is enabled, so accounts with balance assertions must The recentassertions check is enabled, so accounts with balance assertions
have a balance assertion within 7 days of their latest posting. must have a recent one, not more than 7 days older than their latest posting.
In account: a
In a, the last assertion was on 20/
this posting is 8 days later than/
>>>= 1 >>>= 1