From 792434ca7d44cf3684a85827a3c0768fd12dc3b2 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Fri, 22 Apr 2022 12:55:16 -1000 Subject: [PATCH] imp: check: payees: use the standard error format (#1436) --- hledger-lib/Hledger/Data/Transaction.hs | 17 ++++--- hledger-lib/Hledger/Read/Common.hs | 66 ++++++++++++++++++------- 2 files changed, 59 insertions(+), 24 deletions(-) diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 15de153bd..4ce0ce0d7 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -41,6 +41,7 @@ module Hledger.Data.Transaction -- * rendering , showTransaction , showTransactionOneLineAmounts +, showTransactionLineFirstPart , transactionFile -- * tests , tests_Transaction @@ -137,18 +138,22 @@ showTransactionHelper onelineamounts t = <> foldMap ((<> newline) . TB.fromText) (postingsAsLines onelineamounts $ tpostings t) <> newline where - descriptionline = T.stripEnd $ T.concat [date, status, code, desc, samelinecomment] - date = showDate (tdate t) <> maybe "" (("="<>) . showDate) (tdate2 t) - status | tstatus t == Cleared = " *" - | tstatus t == Pending = " !" - | otherwise = "" - code = if T.null (tcode t) then "" else wrap " (" ")" $ tcode t + descriptionline = T.stripEnd $ showTransactionLineFirstPart t <> T.concat [desc, samelinecomment] desc = if T.null d then "" else " " <> d where d = tdescription t (samelinecomment, newlinecomments) = case renderCommentLines (tcomment t) of [] -> ("",[]) c:cs -> (c,cs) newline = TB.singleton '\n' +-- Useful when rendering error messages. +showTransactionLineFirstPart t = T.concat [date, status, code] + where + date = showDate (tdate t) <> maybe "" (("="<>) . showDate) (tdate2 t) + status | tstatus t == Cleared = " *" + | tstatus t == Pending = " !" + | otherwise = "" + code = if T.null (tcode t) then "" else wrap " (" ")" $ tcode t + hasRealPostings :: Transaction -> Bool hasRealPostings = not . null . realPostings diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index cb315e699..ad7392536 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -363,14 +363,16 @@ journalCheckPayeesDeclared :: Journal -> Either String () journalCheckPayeesDeclared j = mapM_ checkpayee (jtxns j) where checkpayee t - | p `elem` ps = Right () - | otherwise = Left $ printf "undeclared payee \"%s\"\nat: %s\n\n%s" - (T.unpack p) - (sourcePosPairPretty $ tsourcepos t) - (linesPrepend2 "> " " " . (<>"\n") . textChomp $ showTransaction t) + | payee `elem` journalPayeesDeclared j = Right () + | otherwise = Left $ + printf "%s:%d:%d:\n%sundeclared payee \"%s\"\n" f l (maybe 0 ((+1).fst) mcols) ex payee where - p = transactionPayee t - ps = journalPayeesDeclared j + payee = transactionPayee t + (f,l,mcols,ex) = makeTransactionErrorExcerpt t finderrcols + finderrcols t = Just (col, Just col2) + where + col = T.length (showTransactionLineFirstPart t) + 1 + col2 = col + T.length (transactionPayee t) -- | Check that all the journal's postings are to accounts declared with -- account directives, returning an error message otherwise. @@ -382,7 +384,7 @@ journalCheckAccountsDeclared j = mapM_ checkacct (journalPostings j) | otherwise = Left $ printf "%s:%d:%d:\n%sundeclared account \"%s\"\n" f l (maybe 0 ((+1).fst) mcols) ex a where - (f,l,mcols,ex) = makeExcerpt p finderrcols + (f,l,mcols,ex) = makePostingErrorExcerpt p finderrcols finderrcols p _ _ = Just (col, Just col2) where col = 4 + if isVirtual p then 1 else 0 @@ -398,7 +400,7 @@ journalCheckCommoditiesDeclared j = mapM_ checkcommodities (journalPostings j) Nothing -> Right () Just (c, _) -> Left $ printf "%s:%d:\n%sundeclared commodity \"%s\"\n" f l ex c - where (f,l,_,ex) = makeExcerpt p finderrcols + where (f,l,_,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 @@ -444,6 +446,36 @@ journalCheckCommoditiesDeclared j = mapM_ checkcommodities (journalPostings j) amtstart = acctend + (T.length $ T.takeWhile isSpace $ T.drop acctend errline) amtend = amtstart + (T.length $ T.stripEnd $ T.takeWhile (/=';') $ T.drop amtstart errline) +-- | Given a problem transaction and a function calculating the best +-- column(s) for marking the error region: +-- render it as a megaparsec-style excerpt, showing the original line number +-- on the transaction line, and a column(s) marker. +-- Returns the file path, line number, column(s) if known, +-- and the rendered excerpt, or as much of these as is possible. +makeTransactionErrorExcerpt :: Transaction -> (Transaction -> Maybe (Int, Maybe Int)) -> (FilePath, Int, Maybe (Int, Maybe Int), Text) +makeTransactionErrorExcerpt t findtxnerrorcolumns = (f, tl, merrcols, ex) + where + (SourcePos f tpos _) = fst $ tsourcepos t + tl = unPos tpos + txntxt = showTransaction t & textChomp & (<>"\n") + merrcols = findtxnerrorcolumns t + ex = decorateTransactionErrorExcerpt tl merrcols txntxt + +-- | Add megaparsec-style left margin, line number, and optional column marker(s). +decorateTransactionErrorExcerpt :: Int -> Maybe (Int, Maybe Int) -> Text -> Text +decorateTransactionErrorExcerpt l mcols txt = + T.unlines $ ls' <> colmarkerline <> map (lineprefix<>) ms + where + (ls,ms) = splitAt 1 $ T.lines txt + ls' = map ((T.pack (show l) <> " | ") <>) ls + colmarkerline = + [lineprefix <> T.replicate col " " <> T.replicate regionw "^" + | Just (col, mendcol) <- [mcols] + , let regionw = maybe 1 (subtract col) mendcol + ] + lineprefix = T.replicate marginw " " <> "| " + where marginw = length (show l) + 1 + -- | Given a problem posting and a function calculating the best -- column(s) for marking the error region: -- look up error info from the parent transaction, and render the transaction @@ -451,8 +483,8 @@ journalCheckCommoditiesDeclared j = mapM_ checkcommodities (journalPostings j) -- on the problem posting's line, and a column indicator. -- Returns the file path, line number, column(s) if known, -- and the rendered excerpt, or as much of these as is possible. -makeExcerpt :: Posting -> (Posting -> Transaction -> Text -> Maybe (Int, Maybe Int)) -> (FilePath, Int, Maybe (Int, Maybe Int), Text) -makeExcerpt p finderrorcolumns = +makePostingErrorExcerpt :: Posting -> (Posting -> Transaction -> Text -> Maybe (Int, Maybe Int)) -> (FilePath, Int, Maybe (Int, Maybe Int), Text) +makePostingErrorExcerpt p findpostingerrorcolumns = case ptransaction p of Nothing -> ("-", 0, Nothing, "") Just t -> (f, errabsline, merrcols, ex) @@ -463,14 +495,12 @@ makeExcerpt p finderrorcolumns = errrelline = maybe 0 (tcommentlines+) mpindex -- XXX doesn't count posting coment lines errabsline = unPos tl + errrelline txntxt = showTransaction t & textChomp & (<>"\n") - merrcols = finderrorcolumns p t txntxt - ex = decorateExcerpt errabsline errrelline merrcols txntxt + merrcols = findpostingerrorcolumns p t txntxt + ex = decoratePostingErrorExcerpt errabsline errrelline merrcols txntxt --- | Add megaparsec-style left margin, line number, and --- optional column(s) marker to a text excerpt, suitable for --- an error message. -decorateExcerpt :: Int -> Int -> Maybe (Int, Maybe Int) -> Text -> Text -decorateExcerpt absline relline mcols txt = +-- | Add megaparsec-style left margin, line number, and optional column marker(s). +decoratePostingErrorExcerpt :: Int -> Int -> Maybe (Int, Maybe Int) -> Text -> Text +decoratePostingErrorExcerpt absline relline mcols txt = T.unlines $ js' <> ks' <> colmarkerline <> ms' where (ls,ms) = splitAt (relline+1) $ T.lines txt