mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-28 21:02:04 +03:00
imp: check: accounts: print a standardised error message like megaparsec's (#1436)
added: formatExcerptLikeMegaparsec
This commit is contained in:
parent
f47d423a67
commit
4b3644d780
@ -377,17 +377,38 @@ journalCheckPayeesDeclared j = mapM_ checkpayee (jtxns j)
|
||||
journalCheckAccountsDeclared :: Journal -> Either String ()
|
||||
journalCheckAccountsDeclared j = mapM_ checkacct (journalPostings j)
|
||||
where
|
||||
checkacct Posting{paccount,ptransaction}
|
||||
| paccount `elem` as = Right ()
|
||||
| otherwise = Left $
|
||||
(printf "undeclared account \"%s\"\n" (T.unpack paccount))
|
||||
++ case ptransaction of
|
||||
Nothing -> ""
|
||||
Just t -> printf "in transaction at: %s\n\n%s"
|
||||
(sourcePosPairPretty $ tsourcepos t)
|
||||
(linesPrepend " " . (<>"\n") . textChomp $ showTransaction t)
|
||||
checkacct p@Posting{paccount=a,ptransaction=mt}
|
||||
| a `elem` journalAccountNamesDeclared j = Right ()
|
||||
| otherwise = Left msg
|
||||
where
|
||||
as = journalAccountNamesDeclared j
|
||||
msg = printf "%s:%d:%d:\n%sundeclared account \"%s\"\n" f l (c+1) excerpt a
|
||||
where
|
||||
(f,l,c,excerpt) = case mt of
|
||||
Nothing -> ("-",0,0,"")
|
||||
Just t -> (tf,errabsline,errcol,txt)
|
||||
where
|
||||
(SourcePos tf tl _tc) = fst $ tsourcepos t
|
||||
mpindex = fmap fst $ find ((a==).paccount.snd) $ zip [1..] $ tpostings t
|
||||
tcommentlines = max 0 $ length (T.lines $ tcomment t) - 1
|
||||
errrelline = maybe 0 (tcommentlines+) mpindex
|
||||
errabsline = unPos tl + errrelline
|
||||
errcol = 4 + if isVirtual p then 1 else 0
|
||||
txt = formatExcerptLikeMegaparsec errabsline errrelline errcol
|
||||
(showTransaction t & textChomp & (<>"\n"))
|
||||
|
||||
formatExcerptLikeMegaparsec :: Int -> Int -> Int -> Text -> Text
|
||||
formatExcerptLikeMegaparsec absline relline col txt =
|
||||
T.unlines $ js' <> ks' <> [colmarkerline] <> ms'
|
||||
where
|
||||
(ls,ms) = splitAt (relline+1) $ T.lines txt
|
||||
(js,ks) = splitAt (length ls - 1) ls
|
||||
(js',ks') = case ks of
|
||||
[k] -> (map (lineprefix<>) js, [T.pack (show absline) <> " | " <> k])
|
||||
_ -> ([], [])
|
||||
ms' = map (lineprefix<>) ms
|
||||
colmarkerline = lineprefix <> T.replicate col " " <> "^"
|
||||
lineprefix = T.replicate marginw " " <> "| "
|
||||
where marginw = length (show absline) + 1
|
||||
|
||||
-- | Check that all the commodities used in this journal's postings have been declared
|
||||
-- by commodity directives, returning an error message otherwise.
|
||||
|
Loading…
Reference in New Issue
Block a user