slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

imp: check commodities: also check commodities used in P directives [#2280]

Browse Source
This commit is contained in:
Simon Michael 2024-11-02 15:03:57 -10:00
parent c66e901d8b
commit d6080c5ff1
2 changed files with 68 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
hledger-lib/Hledger/Data/Errors.hs
View File

@ -7,6 +7,7 @@ Helpers for making error messages.
module Hledger.Data.Errors (
makeAccountTagErrorExcerpt,
makePriceDirectiveErrorExcerpt,
makeTransactionErrorExcerpt,
makePostingErrorExcerpt,
makePostingAccountErrorExcerpt,
@ -27,6 +28,9 @@ import Hledger.Utils
import Data.Maybe
import Safe (headMay)
import Hledger.Data.Posting (isVirtual)
import Hledger.Data.Dates (showDate)
import Hledger.Data.Amount (showCommoditySymbol, showAmount)
-- | Given an account name and its account directive, and a problem tag within the latter:
-- render it as a megaparsec-style excerpt, showing the original line number and
@ -38,10 +42,10 @@ makeAccountTagErrorExcerpt :: (AccountName, AccountDeclarationInfo) -> TagName -
makeAccountTagErrorExcerpt (a, adi) _t = (f, l, merrcols, ex)
-- XXX findtxnerrorcolumns is awkward, I don't think this is the final form
where
(SourcePos f pos _) = adisourcepos adi
SourcePos f pos _ = adisourcepos adi
l = unPos pos
txt = showAccountDirective (a, adi) & textChomp & (<>"\n")
ex = decorateTagErrorExcerpt l merrcols txt
ex = decorateExcerpt l merrcols txt
-- Calculate columns which will help highlight the region in the excerpt
-- (but won't exactly match the real data, so won't be shown in the main error line)
merrcols = Nothing
@ -55,9 +59,10 @@ showAccountDirective (a, AccountDeclarationInfo{..}) =
"account " <> a
<> (if not $ T.null adicomment then " ; " <> adicomment else "")
-- | Add megaparsec-style left margin, line number, and optional column marker(s).
decorateTagErrorExcerpt :: Int -> Maybe (Int, Maybe Int) -> Text -> Text
decorateTagErrorExcerpt l mcols txt =
-- | Decorate a data excerpt with megaparsec-style left margin, line number,
-- and marker/underline for the column(s) if known, for inclusion in an error message.
decorateExcerpt :: Int -> Maybe (Int, Maybe Int) -> Text -> Text
decorateExcerpt l mcols txt =
T.unlines $ ls' <> colmarkerline <> map (lineprefix<>) ms
where
(ls,ms) = splitAt 1 $ T.lines txt
@ -70,7 +75,27 @@ decorateTagErrorExcerpt l mcols txt =
lineprefix = T.replicate marginw " " <> "| "
where marginw = length (show l) + 1
_showAccountDirective = undefined
-- | Given a problem price directive,
-- and maybe a function to calculate the error region's column(s) (currently ignored):
-- generate a megaparsec-style error message with highlighted excerpt.
-- Returns the source file path, line number, column(s) if known, and the rendered excerpt,
-- or as much of these as possible.
-- Columns will be accurate for the rendered error message, not for the original journal entry.
makePriceDirectiveErrorExcerpt :: PriceDirective -> Maybe (PriceDirective -> Text -> Maybe (Int, Maybe Int)) -> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makePriceDirectiveErrorExcerpt pd _finderrorcolumns = (file, line, merrcols, excerpt)
where
SourcePos file pos _ = pdsourcepos pd
line = unPos pos
merrcols = Nothing
excerpt = decorateExcerpt line merrcols $ showPriceDirective pd <> "\n"
showPriceDirective :: PriceDirective -> Text
showPriceDirective PriceDirective{..} = T.unwords [
"P"
,showDate pddate
,showCommoditySymbol pdcommodity
,T.pack $ showAmount pdamount
]
-- | Given a problem transaction and a function calculating the best
-- column(s) for marking the error region:
@ -83,7 +108,7 @@ makeTransactionErrorExcerpt :: Transaction -> (Transaction -> Maybe (Int, Maybe
makeTransactionErrorExcerpt t findtxnerrorcolumns = (f, tl, merrcols, ex)
-- XXX findtxnerrorcolumns is awkward, I don't think this is the final form
where
(SourcePos f tpos _) = fst $ tsourcepos t
SourcePos f tpos _ = fst $ tsourcepos t
tl = unPos tpos
txntxt = showTransaction t & textChomp & (<>"\n")
merrcols = findtxnerrorcolumns t

63
hledger-lib/Hledger/Data/JournalChecks.hs
View File

@ -77,44 +77,53 @@ journalCheckAccounts j = mapM_ checkacct (journalPostings j)
journalCheckBalanceAssertions :: Journal -> Either String ()
journalCheckBalanceAssertions = fmap (const ()) . journalBalanceTransactions defbalancingopts
-- | Check that all the commodities used in this journal's postings have been declared
-- by commodity directives, returning an error message otherwise.
-- | Check that all the commodities used in this journal's postings and P directives
-- have been declared by commodity directives, returning an error message otherwise.
journalCheckCommodities :: Journal -> Either String ()
journalCheckCommodities j = mapM_ checkcommodities (journalPostings j)
journalCheckCommodities j = do
mapM_ checkPriceDirectiveCommodities $ jpricedirectives j
mapM_ checkPostingCommodities $ journalPostings j
where
checkcommodities p =
case findundeclaredcomm p of
Nothing -> Right ()
Just (comm, _) ->
Left $ printf (unlines [
"%s:%d:"
,"%s"
,"Strict commodity checking is enabled, and"
,"commodity %s has not been declared."
,"Consider adding a commodity directive. Examples:"
,""
,"commodity %s1000.00"
,"commodity 1.000,00 %s"
]) f l ex (show comm) comm comm
firstUndeclaredOf comms = find (`M.notMember` jcommodities j) comms
errmsg = unlines [
"%s:%d:"
,"%s"
,"Strict commodity checking is enabled, and"
,"commodity %s has not been declared."
,"Consider adding a commodity directive. Examples:"
,""
,"commodity %s1000.00"
,"commodity 1.000,00 %s"
]
checkPriceDirectiveCommodities pd@PriceDirective{pdcommodity=c, pdamount=amt} =
case firstUndeclaredOf [c, acommodity amt] of
Nothing -> Right ()
Just comm -> Left $ printf errmsg f l ex (show comm) comm comm
where (f,l,_mcols,ex) = makePriceDirectiveErrorExcerpt pd Nothing
checkPostingCommodities p =
case firstundeclaredcomm p of
Nothing -> Right ()
Just (comm, _inpostingamt) -> Left $ printf errmsg f l ex (show comm) comm comm
where
(f,l,_mcols,ex) = makePostingErrorExcerpt p finderrcols
where
-- Find the first undeclared commodity symbol in this posting's amount
-- or balance assertion amount, if any. The boolean will be true if
-- the undeclared symbol was in the posting amount.
findundeclaredcomm :: Posting -> Maybe (CommoditySymbol, Bool)
findundeclaredcomm Posting{pamount=amt,pbalanceassertion} =
case (findundeclared postingcomms, findundeclared assertioncomms) of
-- Find the first undeclared commodity symbol in this posting's amount or balance assertion amount, if any.
-- and whether it was in the posting amount.
-- XXX The latter is currently unused, could be used to refine the error highlighting ?
firstundeclaredcomm :: Posting -> Maybe (CommoditySymbol, Bool)
firstundeclaredcomm Posting{pamount=amt,pbalanceassertion} =
case (firstUndeclaredOf postingcomms, firstUndeclaredOf assertioncomms) of
(Just c, _) -> Just (c, True)
(_, Just c) -> Just (c, False)
_ -> Nothing
where
assertioncomms = [acommodity a | Just a <- [baamount <$> pbalanceassertion]]
postingcomms = map acommodity $ filter (not . isIgnorable) $ amountsRaw amt
where
-- Ignore missing amounts and zero amounts without commodity (#1767)
isIgnorable a = (T.null (acommodity a) && amountIsZero a) || a == missingamt
assertioncomms = [acommodity a | Just a <- [baamount <$> pbalanceassertion]]
findundeclared = find (`M.notMember` jcommodities j)
isIgnorable a = a==missingamt || (amountIsZero a && T.null (acommodity a)) -- #1767
-- Calculate columns suitable for highlighting the excerpt.
-- We won't show these in the main error line as they aren't