diff --git a/hledger-lib/Hledger/Data/Errors.hs b/hledger-lib/Hledger/Data/Errors.hs index 44920423a..ec9b10d38 100644 --- a/hledger-lib/Hledger/Data/Errors.hs +++ b/hledger-lib/Hledger/Data/Errors.hs @@ -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 diff --git a/hledger-lib/Hledger/Data/JournalChecks.hs b/hledger-lib/Hledger/Data/JournalChecks.hs index e0edf7f96..ddb21ba41 100644 --- a/hledger-lib/Hledger/Data/JournalChecks.hs +++ b/hledger-lib/Hledger/Data/JournalChecks.hs @@ -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