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

imp: check: mark all error columns when that's preferable (#1436)

Browse Source 
Undeclared commodity errors now mark the whole amount and assertion
region, since locating the exact position of commodity symbols is
difficult.
This commit is contained in:
Simon Michael 2022-04-22 11:58:37 -10:00
parent 8f4405e628
commit c7e8f58c33
1 changed files with 71 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
hledger-lib/Hledger/Read/Common.hs
View File

@ -364,8 +364,7 @@ journalCheckPayeesDeclared j = mapM_ checkpayee (jtxns j)
where where
checkpayee t checkpayee t
| p `elem` ps = Right () | p `elem` ps = Right ()
| otherwise = Left $ | otherwise = Left $ printf "undeclared payee \"%s\"\nat: %s\n\n%s"
printf "undeclared payee \"%s\"\nat: %s\n\n%s"
(T.unpack p) (T.unpack p)
(sourcePosPairPretty $ tsourcepos t) (sourcePosPairPretty $ tsourcepos t)
(linesPrepend2 "> " " " . (<>"\n") . textChomp $ showTransaction t) (linesPrepend2 "> " " " . (<>"\n") . textChomp $ showTransaction t)
@ -381,10 +380,13 @@ journalCheckAccountsDeclared j = mapM_ checkacct (journalPostings j)
checkacct p@Posting{paccount=a} checkacct p@Posting{paccount=a}
| a `elem` journalAccountNamesDeclared j = Right () | a `elem` journalAccountNamesDeclared j = Right ()
| otherwise = Left $ | otherwise = Left $
printf "%s:%d:%d:\n%sundeclared account \"%s\"\n" f l (maybe 0 (+1) mc) ex a printf "%s:%d:%d:\n%sundeclared account \"%s\"\n" f l (maybe 0 ((+1).fst) mcols) ex a
where where
(f,l,mc,ex) = makeExcerpt p finderrcol (f,l,mcols,ex) = makeExcerpt p finderrcols
finderrcol p _ _ = Just $ 4 + if isVirtual p then 1 else 0 finderrcols p _ _ = Just (col, Just col2)
where
col = 4 + if isVirtual p then 1 else 0
col2 = col + T.length a
-- | Check that all the commodities used in this journal's postings have been declared -- | Check that all the commodities used in this journal's postings have been declared
-- by commodity directives, returning an error message otherwise. -- by commodity directives, returning an error message otherwise.
@ -394,60 +396,81 @@ journalCheckCommoditiesDeclared j = mapM_ checkcommodities (journalPostings j)
checkcommodities p = checkcommodities p =
case findundeclaredcomm p of case findundeclaredcomm p of
Nothing -> Right () Nothing -> Right ()
Just comm -> Left $ printf "%s:%d:\n%sundeclared commodity \"%s\"\n" f l ex comm Just (c, _) ->
Left $ printf "%s:%d:\n%sundeclared commodity \"%s\"\n" f l ex c
where (f,l,_,ex) = makeExcerpt p finderrcols
where where
-- we don't know the original column of amounts -- Find the first undeclared commodity symbol in this posting's amount
(f,l,_,ex) = makeExcerpt p finderrcol -- or balance assertion amount, if any. The boolean will be true if
where -- the undeclared symbol was in the posting amount.
-- Find the first undeclared commodity symbol in this posting, if any. findundeclaredcomm :: Posting -> Maybe (CommoditySymbol, Bool)
findundeclaredcomm Posting{pamount=amt,pbalanceassertion} = findundeclaredcomm Posting{pamount=amt,pbalanceassertion} =
find (`M.notMember` jcommodities j) case (findundeclared postingcomms, findundeclared assertioncomms) of
. map acommodity (Just c, _) -> Just (c, True)
. (maybe id ((:) . baamount) pbalanceassertion) (_, Just c) -> Just (c, False)
. filter (not . isIgnorable) _ -> Nothing
$ amountsRaw amt where
postingcomms = map acommodity $ filter (not . isIgnorable) $ amountsRaw amt
where where
-- Ignore missing amounts and zero amounts without commodity (#1767) -- Ignore missing amounts and zero amounts without commodity (#1767)
isIgnorable a = (T.null (acommodity a) && amountIsZero a) || a == missingamt isIgnorable a = (T.null (acommodity a) && amountIsZero a) || a == missingamt
assertioncomms = [acommodity a | Just a <- [baamount <$> pbalanceassertion]]
findundeclared = find (`M.notMember` jcommodities j)
-- Find the best position for an error column marker. -- Find the best position for an error column marker when this posting
finderrcol p t txntxt = -- is rendered by showTransaction.
-- Reliably locating a problem commodity symbol in showTransaction output
-- is really tricky. Some examples:
--
-- assets "C $" -1 @ $ 2
-- ^
-- assets $1 = $$1
-- ^
-- assets [ANSI RED]$-1[ANSI RESET]
-- ^
--
-- To simplify, we will mark the whole amount + balance assertion region, like:
-- assets "C $" -1 @ $ 2
-- ^^^^^^^^^^^^^^
finderrcols p t txntxt =
case transactionFindPostingIndex (==p) t of case transactionFindPostingIndex (==p) t of
Nothing -> Nothing Nothing -> Nothing
Just pindex -> Just $ Just pindex -> Just (amtstart, Just amtend)
acctend + (T.length $ T.takeWhile isnotsymbol $ T.drop acctend l)
where where
l = fromMaybe "" $ T.lines txntxt `atMay` pindex tcommentlines = max 0 (length (T.lines $ tcomment t) - 1)
errrelline = 1 + tcommentlines + pindex -- XXX doesn't count posting coment lines
errline = fromMaybe "" (T.lines txntxt `atMay` (errrelline-1))
acctend = 4 + T.length (paccount p) + if isVirtual p then 2 else 0 acctend = 4 + T.length (paccount p) + if isVirtual p then 2 else 0
isnotsymbol c = isSpace c || isDigit c || isDigitSeparatorChar c 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 posting and a function calculating the best -- | Given a problem posting and a function calculating the best
-- position for the error column marker: -- column(s) for marking the error region:
-- look up error info from the parent transaction, and render the transaction -- look up error info from the parent transaction, and render the transaction
-- as a megaparsec-style excerpt, showing the original line number -- as a megaparsec-style excerpt, showing the original line number
-- on the problem posting's line, and a column indicator. -- on the problem posting's line, and a column indicator.
-- Returns the file path, line number, starting column if known, -- Returns the file path, line number, column(s) if known,
-- and the rendered excerpt, or as much of these as is possible. -- and the rendered excerpt, or as much of these as is possible.
makeExcerpt :: Posting -> (Posting -> Transaction -> Text -> Maybe Int) -> (FilePath, Int, Maybe Int, Text) makeExcerpt :: Posting -> (Posting -> Transaction -> Text -> Maybe (Int, Maybe Int)) -> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makeExcerpt p findErrorColumn = makeExcerpt p finderrorcolumns =
case ptransaction p of case ptransaction p of
Nothing -> ("-", 0, Nothing, "") Nothing -> ("-", 0, Nothing, "")
Just t -> (f, errabsline, merrcol, ex) Just t -> (f, errabsline, merrcols, ex)
where where
(SourcePos f tl _) = fst $ tsourcepos t (SourcePos f tl _) = fst $ tsourcepos t
tcommentlines = max 0 (length (T.lines $ tcomment t) - 1) tcommentlines = max 0 (length (T.lines $ tcomment t) - 1)
mpindex = transactionFindPostingIndex (==p) t mpindex = transactionFindPostingIndex (==p) t
errrelline = maybe 0 (tcommentlines+) mpindex errrelline = maybe 0 (tcommentlines+) mpindex -- XXX doesn't count posting coment lines
errabsline = unPos tl + errrelline errabsline = unPos tl + errrelline
txntxt = showTransaction t & textChomp & (<>"\n") txntxt = showTransaction t & textChomp & (<>"\n")
merrcol = findErrorColumn p t txntxt merrcols = finderrorcolumns p t txntxt
ex = decorateExcerpt errabsline errrelline merrcol txntxt ex = decorateExcerpt errabsline errrelline merrcols txntxt
-- | Add megaparsec-style left margin, line number, and -- | Add megaparsec-style left margin, line number, and
-- optional column marker to an excerpt to be used in an -- optional column(s) marker to a text excerpt, suitable for
-- error message. -- an error message.
decorateExcerpt :: Int -> Int -> Maybe Int -> Text -> Text decorateExcerpt :: Int -> Int -> Maybe (Int, Maybe Int) -> Text -> Text
decorateExcerpt absline relline mcol txt = decorateExcerpt absline relline mcols txt =
T.unlines $ js' <> ks' <> colmarkerline <> ms' T.unlines $ js' <> ks' <> colmarkerline <> ms'
where where
(ls,ms) = splitAt (relline+1) $ T.lines txt (ls,ms) = splitAt (relline+1) $ T.lines txt
@ -456,7 +479,11 @@ decorateExcerpt absline relline mcol txt =
[k] -> (map (lineprefix<>) js, [T.pack (show absline) <> " | " <> k]) [k] -> (map (lineprefix<>) js, [T.pack (show absline) <> " | " <> k])
_ -> ([], []) _ -> ([], [])
ms' = map (lineprefix<>) ms ms' = map (lineprefix<>) ms
colmarkerline = [lineprefix <> T.replicate col " " <> "^" | Just col <- [mcol]] colmarkerline =
[lineprefix <> T.replicate col " " <> T.replicate regionw "^"
| Just (col, mendcol) <- [mcols]
, let regionw = maybe 1 (subtract col) mendcol
]
lineprefix = T.replicate marginw " " <> "| " lineprefix = T.replicate marginw " " <> "| "
where marginw = length (show absline) + 1 where marginw = length (show absline) + 1