simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-09-19 10:17:35 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #1861 from simonmichael/simon

Browse Source 
more consistent error messages, per #1436
This commit is contained in:
Simon Michael 2022-04-27 08:47:40 -10:00 committed by GitHub
commit 8086d848e3
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
35 changed files with 588 additions and 349 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
hledger-lib/Hledger/Data/Dates.hs
View File

@ -105,7 +105,7 @@ import Safe (headMay, lastMay, maximumMay, minimumMay)
import Text.Megaparsec
import Text.Megaparsec.Char (char, char', digitChar, string, string')
import Text.Megaparsec.Char.Lexer (decimal, signed)
import Text.Megaparsec.Custom (customErrorBundlePretty)
import Text.Megaparsec.Custom (customErrorBundlePretty, HledgerParseErrors)
import Text.Printf (printf)
import Hledger.Data.Types
@ -360,7 +360,7 @@ latestSpanContaining datespans = go
-- | Parse a period expression to an Interval and overall DateSpan using
-- the provided reference date, or return a parse error.
parsePeriodExpr
:: Day -> Text -> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
:: Day -> Text -> Either HledgerParseErrors (Interval, DateSpan)
parsePeriodExpr refdate s = parsewith (periodexprp refdate <* eof) (T.toLower s)
-- | Like parsePeriodExpr, but call error' on failure.
@ -408,14 +408,14 @@ spanFromSmartDate refdate sdate = DateSpan (Just b) (Just e)
fixSmartDateStr :: Day -> Text -> Text
fixSmartDateStr d s =
either (error' . printf "could not parse date %s %s" (show s) . show) id $ -- PARTIAL:
(fixSmartDateStrEither d s :: Either (ParseErrorBundle Text CustomErr) Text)
(fixSmartDateStrEither d s :: Either HledgerParseErrors Text)
-- | A safe version of fixSmartDateStr.
fixSmartDateStrEither :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) Text
fixSmartDateStrEither :: Day -> Text -> Either HledgerParseErrors Text
fixSmartDateStrEither d = fmap showDate . fixSmartDateStrEither' d
fixSmartDateStrEither'
:: Day -> Text -> Either (ParseErrorBundle Text CustomErr) Day
:: Day -> Text -> Either HledgerParseErrors Day
fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of
Right sd -> Right $ fixSmartDate d sd
Left e -> Left e

4
hledger-lib/Hledger/Data/Journal.hs
View File

@ -142,13 +142,13 @@ import Hledger.Query
-- | A parser of text that runs in some monad, keeping a Journal as state.
type JournalParser m a = StateT Journal (ParsecT CustomErr Text m) a
type JournalParser m a = StateT Journal (ParsecT HledgerParseErrorData Text m) a
-- | A parser of text that runs in some monad, keeping a Journal as
-- state, that can throw an exception to end parsing, preventing
-- further parser backtracking.
type ErroringJournalParser m a =
StateT Journal (ParsecT CustomErr Text (ExceptT FinalParseError m)) a
StateT Journal (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m)) a
-- deriving instance Show Journal
instance Show Journal where

10
hledger-lib/Hledger/Data/PeriodicTransaction.hs
View File

@ -189,20 +189,20 @@ instance Show PeriodicTransaction where
-- <BLANKLINE>
--
-- >>> _ptgen ""
-- *** Exception: failed to parse...
-- *** Exception: Error: failed to parse...
-- ...
--
-- >>> _ptgen "weekly from 2017"
-- *** Exception: Unable to generate transactions according to "weekly from 2017" because 2017-01-01 is not a first day of the Week
-- *** Exception: Error: Unable to generate transactions according to "weekly from 2017" because 2017-01-01 is not a first day of the Week
--
-- >>> _ptgen "monthly from 2017/5/4"
-- *** Exception: Unable to generate transactions according to "monthly from 2017/5/4" because 2017-05-04 is not a first day of the Month
-- *** Exception: Error: Unable to generate transactions according to "monthly from 2017/5/4" because 2017-05-04 is not a first day of the Month
--
-- >>> _ptgen "every quarter from 2017/1/2"
-- *** Exception: Unable to generate transactions according to "every quarter from 2017/1/2" because 2017-01-02 is not a first day of the Quarter
-- *** Exception: Error: Unable to generate transactions according to "every quarter from 2017/1/2" because 2017-01-02 is not a first day of the Quarter
--
-- >>> _ptgen "yearly from 2017/1/14"
-- *** Exception: Unable to generate transactions according to "yearly from 2017/1/14" because 2017-01-14 is not a first day of the Year
-- *** Exception: Error: Unable to generate transactions according to "yearly from 2017/1/14" because 2017-01-14 is not a first day of the Year
--
-- >>> let reportperiod="daily from 2018/01/03" in let (i,s) = parsePeriodExpr' nulldate reportperiod in runPeriodicTransaction (nullperiodictransaction{ptperiodexpr=reportperiod, ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1]}) (DateSpan (Just $ fromGregorian 2018 01 01) (Just $ fromGregorian 2018 01 03))
-- []

17
hledger-lib/Hledger/Data/Transaction.hs
View File

@ -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

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

@ -112,6 +112,8 @@ module Hledger.Read.Common (
skipNonNewlineSpaces,
skipNonNewlineSpaces1,
aliasesFromOpts,
makeTransactionErrorExcerpt,
makePostingErrorExcerpt,
-- * tests
tests_Common,
@ -144,7 +146,7 @@ import Text.Megaparsec
import Text.Megaparsec.Char (char, char', digitChar, newline, string)
import Text.Megaparsec.Char.Lexer (decimal)
import Text.Megaparsec.Custom
(FinalParseError, attachSource, customErrorBundlePretty, finalErrorBundlePretty, parseErrorAt, parseErrorAtRegion)
(FinalParseError, attachSource, customErrorBundlePretty, finalErrorBundlePretty, parseErrorAt, parseErrorAtRegion, HledgerParseErrors)
import Hledger.Data
import Hledger.Query (Query(..), filterQuery, parseQueryTerm, queryEndDate, queryStartDate, queryIsDate, simplifyQuery)
@ -152,6 +154,7 @@ import Hledger.Reports.ReportOptions (ReportOpts(..), queryFromFlags, rawOptsToR
import Hledger.Utils
import Text.Printf (printf)
import Hledger.Read.InputOptions
import Safe (atMay)
--- ** doctest setup
-- $setup
@ -271,7 +274,7 @@ initialiseAndParseJournal parser iopts f txt =
y = first3 . toGregorian $ _ioDay iopts
initJournal = nulljournal{jparsedefaultyear = Just y, jincludefilestack = [f]}
-- Flatten parse errors and final parse errors, and output each as a pretty String.
prettyParseErrors :: ExceptT FinalParseError IO (Either (ParseErrorBundle Text CustomErr) a)
prettyParseErrors :: ExceptT FinalParseError IO (Either (ParseErrorBundle Text HledgerParseErrorData) a)
-> ExceptT String IO a
prettyParseErrors = withExceptT customErrorBundlePretty . liftEither
<=< withExceptT (finalErrorBundlePretty . attachSource f txt)
@ -362,59 +365,173 @@ journalCheckPayeesDeclared :: Journal -> Either String ()
journalCheckPayeesDeclared j = mapM_ checkpayee (jtxns j)
where
checkpayee t
| p `elem` ps = Right ()
| payee `elem` journalPayeesDeclared j = Right ()
| otherwise = Left $
printf "undeclared payee \"%s\"\nat: %s\n\n%s"
(T.unpack p)
(sourcePosPairPretty $ tsourcepos t)
(linesPrepend2 "> " " " . (<>"\n") . textChomp $ showTransaction t)
printf "%s:%d:%d-%d:\n%sundeclared payee \"%s\"\n" f l col col2 ex payee
where
p = transactionPayee t
ps = journalPayeesDeclared j
payee = transactionPayee t
(f,l,mcols,ex) = makeTransactionErrorExcerpt t finderrcols
col = maybe 0 fst mcols
col2 = maybe 0 (fromMaybe 0 . snd) mcols
finderrcols t = Just (col, Just col2)
where
col = T.length (showTransactionLineFirstPart t) + 2
col2 = col + T.length (transactionPayee t) - 1
-- | Check that all the journal's postings are to accounts declared with
-- account directives, returning an error message otherwise.
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)
where
as = journalAccountNamesDeclared j
checkacct p@Posting{paccount=a}
| a `elem` journalAccountNamesDeclared j = Right ()
| otherwise = Left $
printf "%s:%d:%d-%d:\n%sundeclared account \"%s\"\n" f l col col2 ex a
where
(f,l,mcols,ex) = makePostingErrorExcerpt p finderrcols
col = maybe 0 fst mcols
col2 = maybe 0 (fromMaybe 0 . snd) mcols
finderrcols p _ _ = Just (col, Just col2)
where
col = 5 + if isVirtual p then 1 else 0
col2 = col + T.length a - 1
-- | Check that all the commodities used in this journal's postings have been declared
-- by commodity directives, returning an error message otherwise.
journalCheckCommoditiesDeclared :: Journal -> Either String ()
journalCheckCommoditiesDeclared j =
mapM_ checkcommodities (journalPostings j)
journalCheckCommoditiesDeclared j = mapM_ checkcommodities (journalPostings j)
where
checkcommodities Posting{..} =
case mfirstundeclaredcomm of
checkcommodities p =
case findundeclaredcomm p of
Nothing -> Right ()
Just c -> Left $
(printf "undeclared commodity \"%s\"\n" (T.unpack c))
++ case ptransaction of
Nothing -> ""
Just t -> printf "in transaction at: %s\n\n%s"
(sourcePosPairPretty $ tsourcepos t)
(linesPrepend " " . (<>"\n") . textChomp $ showTransaction t)
Just (comm, _) ->
Left $ printf "%s:%d:%d-%d:\n%sundeclared commodity \"%s\"\n" f l col col2 ex comm
where
(f,l,mcols,ex) = makePostingErrorExcerpt p finderrcols
col = maybe 0 fst mcols
col2 = maybe 0 (fromMaybe 0 . snd) mcols
where
mfirstundeclaredcomm =
find (`M.notMember` jcommodities j)
. map acommodity
. (maybe id ((:) . baamount) pbalanceassertion)
. filter (not . isIgnorable)
$ amountsRaw pamount
-- 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
(Just c, _) -> Just (c, True)
(_, Just c) -> Just (c, False)
_ -> Nothing
where
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)
-- Ignore missing amounts and zero amounts without commodity (#1767)
isIgnorable a = (T.null (acommodity a) && amountIsZero a) || a == missingamt
-- Find the best position for an error column marker when this posting
-- 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
Nothing -> Nothing
Just pindex -> Just (amtstart, Just amtend)
where
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
amtstart = acctend + (T.length $ T.takeWhile isSpace $ T.drop acctend errline) + 1
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)
-- XXX findtxnerrorcolumns is awkward, I don't think this is the final form
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-1) " " <> T.replicate regionw "^"
| Just (col, mendcol) <- [mcols]
, let regionw = maybe 1 (subtract col) mendcol + 1
]
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
-- as a megaparsec-style excerpt, showing the original line number
-- 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.
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)
where
(SourcePos f tl _) = fst $ tsourcepos t
tcommentlines = max 0 (length (T.lines $ tcomment t) - 1)
mpindex = transactionFindPostingIndex (==p) t
errrelline = maybe 0 (tcommentlines+) mpindex -- XXX doesn't count posting coment lines
errabsline = unPos tl + errrelline
txntxt = showTransaction t & textChomp & (<>"\n")
merrcols = findpostingerrorcolumns p t txntxt
ex = decoratePostingErrorExcerpt errabsline errrelline merrcols txntxt
-- | 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
(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-1) " " <> T.replicate regionw "^"
| Just (col, mendcol) <- [mcols]
, let regionw = 1 + maybe 0 (subtract col) mendcol
]
lineprefix = T.replicate marginw " " <> "| "
where marginw = length (show absline) + 1
-- | Find the 1-based index of the first posting in this transaction
-- satisfying the given predicate.
transactionFindPostingIndex :: (Posting -> Bool) -> Transaction -> Maybe Int
transactionFindPostingIndex ppredicate =
fmap fst . find (ppredicate.snd) . zip [1..] . tpostings
setYear :: Year -> JournalParser m ()
setYear y = modify' (\j -> j{jparsedefaultyear=Just y})
@ -855,7 +972,7 @@ amountwithoutpricep mult = do
Right (q,p,d,g) -> pure (q, Precision p, d, g)
-- | Try to parse an amount from a string
amountp'' :: String -> Either (ParseErrorBundle Text CustomErr) Amount
amountp'' :: String -> Either HledgerParseErrors Amount
amountp'' s = runParser (evalStateT (amountp <* eof) nulljournal) "" (T.pack s)
-- | Parse an amount from a string, or get an error.

4
hledger-lib/Hledger/Read/CsvReader.hs
View File

@ -216,7 +216,7 @@ parseAndValidateCsvRules rulesfile s =
parseErrorPretty (FancyError 0 (S.singleton $ ErrorFail errorString) :: ParseError Text String)
-- | Parse this text as CSV conversion rules. The file path is for error messages.
parseCsvRules :: FilePath -> T.Text -> Either (ParseErrorBundle T.Text CustomErr) CsvRules
parseCsvRules :: FilePath -> T.Text -> Either (ParseErrorBundle T.Text HledgerParseErrorData) CsvRules
-- parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s
parseCsvRules = runParser (evalStateT rulesp defrules)
@ -1232,7 +1232,7 @@ renderTemplate rules record t = maybe t mconcat $ parseMaybe
<|> replaceCsvFieldReference rules record <$> referencep)
t
where
referencep = liftA2 T.cons (char '%') (takeWhile1P (Just "reference") isFieldNameChar) :: Parsec CustomErr Text Text
referencep = liftA2 T.cons (char '%') (takeWhile1P (Just "reference") isFieldNameChar) :: Parsec HledgerParseErrorData Text Text
isFieldNameChar c = isAlphaNum c || c == '_' || c == '-'
-- | Replace something that looks like a reference to a csv field ("%date" or "%1)

4
hledger-lib/Hledger/Read/JournalReader.hs
View File

@ -113,7 +113,7 @@ import qualified Hledger.Read.CsvReader as CsvReader (reader)
-- | Run a journal parser in some monad. See also: parseWithState.
runJournalParser, rjp
:: Monad m
=> JournalParser m a -> Text -> m (Either (ParseErrorBundle Text CustomErr) a)
=> JournalParser m a -> Text -> m (Either HledgerParseErrors a)
runJournalParser p = runParserT (evalStateT p nulljournal) ""
rjp = runJournalParser
@ -122,7 +122,7 @@ runErroringJournalParser, rejp
:: Monad m
=> ErroringJournalParser m a
-> Text
-> m (Either FinalParseError (Either (ParseErrorBundle Text CustomErr) a))
-> m (Either FinalParseError (Either HledgerParseErrors a))
runErroringJournalParser p t =
runExceptT $ runParserT (evalStateT p nulljournal) "" t
rejp = runErroringJournalParser

2
hledger-lib/Hledger/Reports/ReportOptions.hs
View File

@ -801,7 +801,7 @@ makeHledgerClassyLenses ''ReportSpec
-- >>> _rsQuery $ set querystring ["assets"] defreportspec
-- Acct (RegexpCI "assets")
-- >>> _rsQuery $ set querystring ["(assets"] defreportspec
-- *** Exception: Updating ReportSpec failed: try using overEither instead of over or setEither instead of set
-- *** Exception: Error: Updating ReportSpec failed: try using overEither instead of over or setEither instead of set
-- >>> _rsQuery $ set period (MonthPeriod 2021 08) defreportspec
-- Date DateSpan 2021-08
class HasReportOptsNoUpdate a => HasReportOpts a where

2
hledger-lib/Hledger/Utils.hs
View File

@ -252,7 +252,7 @@ numDigitsInt n
-- | Simpler alias for errorWithoutStackTrace
error' :: String -> a
error' = errorWithoutStackTrace
error' = errorWithoutStackTrace . ("Error: " <>)
-- | A version of errorWithoutStackTrace that adds a usage hint.
usageError :: String -> a

24
hledger-lib/Hledger/Utils/Parse.hs
View File

@ -38,7 +38,7 @@ module Hledger.Utils.Parse (
skipNonNewlineSpaces',
-- * re-exports
CustomErr
HledgerParseErrorData
)
where
@ -54,13 +54,13 @@ import Text.Megaparsec.Custom
import Text.Printf
-- | A parser of string to some type.
type SimpleStringParser a = Parsec CustomErr String a
type SimpleStringParser a = Parsec HledgerParseErrorData String a
-- | A parser of strict text to some type.
type SimpleTextParser = Parsec CustomErr Text -- XXX an "a" argument breaks the CsvRulesParser declaration somehow
type SimpleTextParser = Parsec HledgerParseErrorData Text -- XXX an "a" argument breaks the CsvRulesParser declaration somehow
-- | A parser of text that runs in some monad.
type TextParser m a = ParsecT CustomErr Text m a
type TextParser m a = ParsecT HledgerParseErrorData Text m a
-- | Render a pair of source positions in human-readable form, only displaying the range of lines.
sourcePosPairPretty :: (SourcePos, SourcePos) -> String
@ -76,7 +76,7 @@ choice' = choice . map try
-- | Backtracking choice, use this when alternatives share a prefix.
-- Consumes no input if all choices fail.
choiceInState :: [StateT s (ParsecT CustomErr Text m) a] -> StateT s (ParsecT CustomErr Text m) a
choiceInState :: [StateT s (ParsecT HledgerParseErrorData Text m) a] -> StateT s (ParsecT HledgerParseErrorData Text m) a
choiceInState = choice . map try
surroundedBy :: Applicative m => m openclose -> m a -> m a
@ -87,7 +87,7 @@ parsewith p = runParser p ""
-- | Run a text parser in the identity monad. See also: parseWithState.
runTextParser, rtp
:: TextParser Identity a -> Text -> Either (ParseErrorBundle Text CustomErr) a
:: TextParser Identity a -> Text -> Either HledgerParseErrors a
runTextParser = parsewith
rtp = runTextParser
@ -100,9 +100,9 @@ parsewithString p = runParser p ""
parseWithState
:: Monad m
=> st
-> StateT st (ParsecT CustomErr Text m) a
-> StateT st (ParsecT HledgerParseErrorData Text m) a
-> Text
-> m (Either (ParseErrorBundle Text CustomErr) a)
-> m (Either HledgerParseErrors a)
parseWithState ctx p = runParserT (evalStateT p ctx) ""
parseWithState'
@ -139,7 +139,7 @@ nonspace = satisfy (not . isSpace)
isNonNewlineSpace :: Char -> Bool
isNonNewlineSpace c = not (isNewline c) && isSpace c
spacenonewline :: (Stream s, Char ~ Token s) => ParsecT CustomErr s m Char
spacenonewline :: (Stream s, Char ~ Token s) => ParsecT HledgerParseErrorData s m Char
spacenonewline = satisfy isNonNewlineSpace
{-# INLINABLE spacenonewline #-}
@ -147,17 +147,17 @@ restofline :: TextParser m String
restofline = anySingle `manyTill` eolof
-- Skip many non-newline spaces.
skipNonNewlineSpaces :: (Stream s, Token s ~ Char) => ParsecT CustomErr s m ()
skipNonNewlineSpaces :: (Stream s, Token s ~ Char) => ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces = () <$ takeWhileP Nothing isNonNewlineSpace
{-# INLINABLE skipNonNewlineSpaces #-}
-- Skip many non-newline spaces, failing if there are none.
skipNonNewlineSpaces1 :: (Stream s, Token s ~ Char) => ParsecT CustomErr s m ()
skipNonNewlineSpaces1 :: (Stream s, Token s ~ Char) => ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1 = () <$ takeWhile1P Nothing isNonNewlineSpace
{-# INLINABLE skipNonNewlineSpaces1 #-}
-- Skip many non-newline spaces, returning True if any have been skipped.
skipNonNewlineSpaces' :: (Stream s, Token s ~ Char) => ParsecT CustomErr s m Bool
skipNonNewlineSpaces' :: (Stream s, Token s ~ Char) => ParsecT HledgerParseErrorData s m Bool
skipNonNewlineSpaces' = True <$ skipNonNewlineSpaces1 <|> pure False
{-# INLINABLE skipNonNewlineSpaces' #-}

28
hledger-lib/Hledger/Utils/Test.hs
View File

@ -31,7 +31,7 @@ import Test.Tasty.HUnit
-- import Test.Tasty.SmallCheck as SC
import Text.Megaparsec
import Text.Megaparsec.Custom
( CustomErr,
( HledgerParseErrorData,
FinalParseError,
attachSource,
customErrorBundlePretty,
@ -56,7 +56,7 @@ assertRight (Left a) = assertFailure $ "expected Right, got (Left " ++ show a +
-- | Run a parser on the given text and display a helpful error.
parseHelper :: (HasCallStack, Default st, Monad m) =>
StateT st (ParsecT CustomErr T.Text m) a -> T.Text -> ExceptT String m a
StateT st (ParsecT HledgerParseErrorData T.Text m) a -> T.Text -> ExceptT String m a
parseHelper parser input =
withExceptT (\e -> "\nparse error at " ++ customErrorBundlePretty e ++ "\n") . ExceptT
$ runParserT (evalStateT (parser <* eof) def) "" input
@ -65,7 +65,7 @@ parseHelper parser input =
-- produce an 'Assertion'. Suitable for hledger's JournalParser parsers.
assertParseHelper :: (HasCallStack, Default st) =>
(String -> Assertion) -> (a -> Assertion)
-> StateT st (ParsecT CustomErr T.Text IO) a -> T.Text
-> StateT st (ParsecT HledgerParseErrorData T.Text IO) a -> T.Text
-> Assertion
assertParseHelper onFailure onSuccess parser input =
either onFailure onSuccess =<< runExceptT (parseHelper parser input)
@ -74,25 +74,25 @@ assertParseHelper onFailure onSuccess parser input =
-- all of the given input text, showing the parse error if it fails.
-- Suitable for hledger's JournalParser parsers.
assertParse :: (HasCallStack, Default st) =>
StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> Assertion
StateT st (ParsecT HledgerParseErrorData T.Text IO) a -> T.Text -> Assertion
assertParse = assertParseHelper assertFailure (const $ return ())
-- | Assert a parser produces an expected value.
assertParseEq :: (HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> a -> Assertion
StateT st (ParsecT HledgerParseErrorData T.Text IO) a -> T.Text -> a -> Assertion
assertParseEq parser input = assertParseEqOn parser input id
-- | Like assertParseEq, but transform the parse result with the given function
-- before comparing it.
assertParseEqOn :: (HasCallStack, Eq b, Show b, Default st) =>
StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> (a -> b) -> b -> Assertion
StateT st (ParsecT HledgerParseErrorData T.Text IO) a -> T.Text -> (a -> b) -> b -> Assertion
assertParseEqOn parser input f expected =
assertParseHelper assertFailure (assertEqual "" expected . f) parser input
-- | Assert that this stateful parser runnable in IO fails to parse
-- the given input text, with a parse error containing the given string.
assertParseError :: (HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> String -> Assertion
StateT st (ParsecT HledgerParseErrorData T.Text IO) a -> T.Text -> String -> Assertion
assertParseError parser input errstr = assertParseHelper
(\e -> unless (errstr `isInfixOf` e) $ assertFailure $ "\nparse error is not as expected:" ++ e)
(\v -> assertFailure $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n")
@ -102,7 +102,7 @@ assertParseError parser input errstr = assertParseHelper
-- final state (the wrapped state, not megaparsec's internal state),
-- transformed by the given function, matches the given expected value.
assertParseStateOn :: (HasCallStack, Eq b, Show b, Default st) =>
StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> (st -> b) -> b -> Assertion
StateT st (ParsecT HledgerParseErrorData T.Text IO) a -> T.Text -> (st -> b) -> b -> Assertion
assertParseStateOn parser input f expected = do
es <- runParserT (execStateT (parser <* eof) def) "" input
case es of
@ -111,7 +111,7 @@ assertParseStateOn parser input f expected = do
-- | These "E" variants of the above are suitable for hledger's ErroringJournalParser parsers.
parseHelperE :: (HasCallStack, Default st, Monad m) =>
StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError m)) a -> T.Text -> ExceptT String m a
StateT st (ParsecT HledgerParseErrorData T.Text (ExceptT FinalParseError m)) a -> T.Text -> ExceptT String m a
parseHelperE parser input = do
withExceptT (\e -> "\nparse error at " ++ customErrorBundlePretty e ++ "\n") . liftEither
=<< withExceptT (\e -> "parse error at " ++ finalErrorBundlePretty (attachSource "" input e))
@ -119,30 +119,30 @@ parseHelperE parser input = do
assertParseHelperE :: (HasCallStack, Default st) =>
(String -> Assertion) -> (a -> Assertion)
-> StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a -> T.Text
-> StateT st (ParsecT HledgerParseErrorData T.Text (ExceptT FinalParseError IO)) a -> T.Text
-> Assertion
assertParseHelperE onFailure onSuccess parser input =
either onFailure onSuccess =<< runExceptT (parseHelperE parser input)
assertParseE
:: (HasCallStack, Eq a, Show a, Default st)
=> StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a -> T.Text -> Assertion
=> StateT st (ParsecT HledgerParseErrorData T.Text (ExceptT FinalParseError IO)) a -> T.Text -> Assertion
assertParseE = assertParseHelperE assertFailure (const $ return ())
assertParseEqE
:: (Default st, Eq a, Show a, HasCallStack)
=> StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a -> T.Text -> a -> Assertion
=> StateT st (ParsecT HledgerParseErrorData T.Text (ExceptT FinalParseError IO)) a -> T.Text -> a -> Assertion
assertParseEqE parser input = assertParseEqOnE parser input id
assertParseEqOnE
:: (HasCallStack, Eq b, Show b, Default st)
=> StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a -> T.Text -> (a -> b) -> b -> Assertion
=> StateT st (ParsecT HledgerParseErrorData T.Text (ExceptT FinalParseError IO)) a -> T.Text -> (a -> b) -> b -> Assertion
assertParseEqOnE parser input f expected =
assertParseHelperE assertFailure (assertEqual "" expected . f) parser input
assertParseErrorE
:: (Default st, Eq a, Show a, HasCallStack)
=> StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a -> T.Text -> String -> Assertion
=> StateT st (ParsecT HledgerParseErrorData T.Text (ExceptT FinalParseError IO)) a -> T.Text -> String -> Assertion
assertParseErrorE parser input errstr = assertParseHelperE
(\e -> unless (errstr `isInfixOf` e) $ assertFailure $ "\nparse error is not as expected:" ++ e)
(\v -> assertFailure $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n")

53
hledger-lib/Text/Megaparsec/Custom.hs
View File

@ -7,8 +7,9 @@
{-# LANGUAGE StandaloneDeriving #-} -- new
module Text.Megaparsec.Custom (
-- * Custom parse error type
CustomErr,
-- * Custom parse error types
HledgerParseErrorData,
HledgerParseErrors,
-- * Failing with an arbitrary source position
parseErrorAt,
@ -55,12 +56,10 @@ import Data.Text (Text)
import Text.Megaparsec
--- * Custom parse error type
--- * Custom parse error types
-- | A custom error type for the parser. The type is specialized to
-- parsers of 'Text' streams.
data CustomErr
-- | Custom error data for hledger parsers. Specialised for a 'Text' parse stream.
data HledgerParseErrorData
-- | Fail with a message at a specific source position interval. The
-- interval must be contained within a single line.
= ErrorFailAt Int -- Starting offset
@ -69,21 +68,27 @@ data CustomErr
-- | Re-throw parse errors obtained from the "re-parsing" of an excerpt
-- of the source text.
| ErrorReparsing
(NE.NonEmpty (ParseError Text CustomErr)) -- Source fragment parse errors
(NE.NonEmpty (ParseError Text HledgerParseErrorData)) -- Source fragment parse errors
deriving (Show, Eq, Ord)
-- | A specialised version of ParseErrorBundle:
-- a non-empty collection of hledger parse errors,
-- equipped with PosState to help pretty-print them.
-- Specialised for a 'Text' parse stream.
type HledgerParseErrors = ParseErrorBundle Text HledgerParseErrorData
-- We require an 'Ord' instance for 'CustomError' so that they may be
-- stored in a 'Set'. The actual instance is inconsequential, so we just
-- derive it, but the derived instance requires an (orphan) instance for
-- 'ParseError'. Hopefully this does not cause any trouble.
deriving instance Ord (ParseError Text CustomErr)
deriving instance Ord (ParseError Text HledgerParseErrorData)
-- Note: the pretty-printing of our 'CustomErr' type is only partally
-- Note: the pretty-printing of our 'HledgerParseErrorData' type is only partally
-- defined in its 'ShowErrorComponent' instance; we perform additional
-- adjustments in 'customErrorBundlePretty'.
instance ShowErrorComponent CustomErr where
instance ShowErrorComponent HledgerParseErrorData where
showErrorComponent (ErrorFailAt _ _ errMsg) = errMsg
showErrorComponent (ErrorReparsing _) = "" -- dummy value
@ -98,7 +103,7 @@ instance ShowErrorComponent CustomErr where
-- start of the input stream (the number of tokens processed at that
-- point).
parseErrorAt :: Int -> String -> CustomErr
parseErrorAt :: Int -> String -> HledgerParseErrorData
parseErrorAt offset = ErrorFailAt offset (offset+1)
-- | Fail at a specific source interval, given by the raw offsets of its
@ -112,7 +117,7 @@ parseErrorAtRegion
:: Int -- ^ Start offset
-> Int -- ^ End end offset
-> String -- ^ Error message
-> CustomErr
-> HledgerParseErrorData
parseErrorAtRegion startOffset endOffset msg =
if startOffset < endOffset
then ErrorFailAt startOffset endOffset msg
@ -142,7 +147,7 @@ getExcerptText (SourceExcerpt _ txt) = txt
-- This function could be extended to return the result of 'p', but we don't
-- currently need this.
excerpt_ :: MonadParsec CustomErr Text m => m a -> m SourceExcerpt
excerpt_ :: MonadParsec HledgerParseErrorData Text m => m a -> m SourceExcerpt
excerpt_ p = do
offset <- getOffset
(!txt, _) <- match p
@ -164,8 +169,8 @@ excerpt_ p = do
reparseExcerpt
:: Monad m
=> SourceExcerpt
-> ParsecT CustomErr Text m a
-> ParsecT CustomErr Text m a
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
reparseExcerpt (SourceExcerpt offset txt) p = do
(_, res) <- lift $ runParserT' p (offsetInitialState offset txt)
case res of
@ -210,7 +215,7 @@ reparseExcerpt (SourceExcerpt offset txt) p = do
-- 0 (that is, the beginning of the source file), which is the
-- case for 'ParseErrorBundle's returned from 'runParserT'.
customErrorBundlePretty :: ParseErrorBundle Text CustomErr -> String
customErrorBundlePretty :: HledgerParseErrors -> String
customErrorBundlePretty errBundle =
let errBundle' = errBundle { bundleErrors =
NE.sortWith errorOffset $ -- megaparsec requires that the list of errors be sorted by their offsets
@ -219,7 +224,7 @@ customErrorBundlePretty errBundle =
where
finalizeCustomError
:: ParseError Text CustomErr -> NE.NonEmpty (ParseError Text CustomErr)
:: ParseError Text HledgerParseErrorData -> NE.NonEmpty (ParseError Text HledgerParseErrorData)
finalizeCustomError err = case findCustomError err of
Nothing -> pure err
@ -233,7 +238,7 @@ customErrorBundlePretty errBundle =
-- If any custom errors are present, arbitrarily take the first one
-- (since only one custom error should be used at a time).
findCustomError :: ParseError Text CustomErr -> Maybe CustomErr
findCustomError :: ParseError Text HledgerParseErrorData -> Maybe HledgerParseErrorData
findCustomError err = case err of
FancyError _ errSet ->
finds (\case {ErrorCustom e -> Just e; _ -> Nothing}) errSet
@ -280,7 +285,7 @@ data FinalParseError' e
| FinalBundleWithStack (FinalParseErrorBundle' e)
deriving (Show)
type FinalParseError = FinalParseError' CustomErr
type FinalParseError = FinalParseError' HledgerParseErrorData
-- We need a 'Monoid' instance for 'FinalParseError' so that 'ExceptT
-- FinalParseError m' is an instance of Alternative and MonadPlus, which
@ -308,7 +313,7 @@ data FinalParseErrorBundle' e = FinalParseErrorBundle'
, includeFileStack :: [FilePath]
} deriving (Show)
type FinalParseErrorBundle = FinalParseErrorBundle' CustomErr
type FinalParseErrorBundle = FinalParseErrorBundle' HledgerParseErrorData
--- * Constructing and throwing final parse errors
@ -347,7 +352,7 @@ finalCustomFailure = finalFancyFailure . S.singleton . ErrorCustom
-- 'attachSource' must be used on a "final" parse error before it can be
-- pretty-printed.
finalErrorBundlePretty :: FinalParseErrorBundle' CustomErr -> String
finalErrorBundlePretty :: FinalParseErrorBundle' HledgerParseErrorData -> String
finalErrorBundlePretty bundle =
concatMap showIncludeFilepath (includeFileStack bundle)
<> customErrorBundlePretty (finalErrorBundle bundle)
@ -391,11 +396,11 @@ attachSource filePath sourceText finalParseError = case finalParseError of
parseIncludeFile
:: Monad m
=> StateT st (ParsecT CustomErr Text (ExceptT FinalParseError m)) a
=> StateT st (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m)) a
-> st
-> FilePath
-> Text
-> StateT st (ParsecT CustomErr Text (ExceptT FinalParseError m)) a
-> StateT st (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m)) a
parseIncludeFile parser initialState filepath text =
catchError parser' handler
where

4
hledger/Hledger/Cli/Commands/Check.hs
View File

@ -14,8 +14,6 @@ import Data.Either (partitionEithers)
import Data.List (isPrefixOf, find)
import Control.Monad (forM_)
import System.Console.CmdArgs.Explicit
import System.Exit (exitFailure)
import System.IO (stderr, hPutStrLn)
import Hledger
import Hledger.Cli.CliOptions
@ -120,4 +118,4 @@ runCheck copts@CliOpts{rawopts_} j (check,args) = do
case results of
Right () -> return ()
Left err -> hPutStrLn stderr ("Error: "++err) >> exitFailure
Left err -> error' err

25
hledger/Hledger/Cli/Commands/Check/Ordereddates.hs
View File

@ -3,11 +3,12 @@ module Hledger.Cli.Commands.Check.Ordereddates (
)
where
import qualified Data.Text as T
import Hledger
import Hledger.Cli.CliOptions
import Control.Monad (forM)
import Data.List (groupBy)
import Text.Printf (printf)
import Data.Maybe (fromMaybe)
journalCheckOrdereddates :: CliOpts -> Journal -> Either String ()
journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do
@ -26,17 +27,17 @@ journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do
case checkTransactions compare ts of
FoldAcc{fa_previous=Nothing} -> Right ()
FoldAcc{fa_error=Nothing} -> Right ()
FoldAcc{fa_error=Just error, fa_previous=Just previous} -> do
let
datestr = if date2_ ropts then "2" else ""
uniquestr = if checkunique then " and/or not unique" else ""
positionstr = sourcePosPairPretty $ tsourcepos error
txn1str = T.unpack . linesPrepend (T.pack " ") $ showTransaction previous
txn2str = T.unpack . linesPrepend2 (T.pack "> ") (T.pack " ") $ showTransaction error
Left $
"transaction date" <> datestr <> " is out of order"
<> uniquestr <> "\nat " <> positionstr <> ":\n\n"
<> txn1str <> txn2str
FoldAcc{fa_error=Just t, fa_previous=Just tprev} -> Left $ printf
"%s:%d:%d-%d:\n%stransaction date%s is out of order with previous transaction date %s%s"
f l col col2 ex datenum tprevdate oruniquestr
where
(f,l,mcols,ex) = makeTransactionErrorExcerpt t finderrcols
col = maybe 0 fst mcols
col2 = maybe 0 (fromMaybe 0 . snd) mcols
finderrcols _t = Just (1, Just 10)
datenum = if date2_ ropts then "2" else ""
tprevdate = show $ (if date2_ ropts then transactionDate2 else tdate) tprev
oruniquestr = if checkunique then ", and/or not unique" else "" -- XXX still used ?
data FoldAcc a b = FoldAcc
{ fa_error :: Maybe a

29
hledger/Hledger/Cli/Commands/Check/Uniqueleafnames.hs
View File

@ -12,6 +12,7 @@ import Data.Text (Text)
import qualified Data.Text as T
import Hledger
import Text.Printf (printf)
import Data.Maybe (fromMaybe)
-- | Check that all the journal's postings are to accounts with a unique leaf name.
-- Otherwise, return an error message for the first offending posting.
@ -38,16 +39,22 @@ journalLeafAndFullAccountNames = map leafAndAccountName . journalAccountNamesUse
where leafAndAccountName a = (accountLeafName a, a)
checkposting :: [(Text,[AccountName])] -> Posting -> Either String ()
checkposting leafandfullnames Posting{paccount,ptransaction} =
case [lf | lf@(_,fs) <- leafandfullnames, paccount `elem` fs] of
checkposting leafandfullnames p@Posting{paccount=a} =
case [lf | lf@(_,fs) <- leafandfullnames, a `elem` fs] of
[] -> Right ()
(leaf,fulls):_ -> Left $ printf
"account leaf names are not unique\nleaf name \"%s\" appears in account names: %s%s"
leaf
(T.intercalate ", " $ map (("\""<>).(<>"\"")) fulls)
(case ptransaction of
Nothing -> ""
Just t -> printf "\nseen in \"%s\" in transaction at: %s\n\n%s"
paccount
(sourcePosPairPretty $ tsourcepos t)
(linesPrepend "> " . (<>"\n") . textChomp $ showTransaction t) :: String)
"%s:%d:%d-%d:\n%saccount leaf name \"%s\" is not unique\nit is used in account names: %s"
f l col col2 ex leaf accts
where
-- t = fromMaybe nulltransaction ptransaction -- XXX sloppy
col = maybe 0 fst mcols
col2 = maybe 0 (fromMaybe 0 . snd) mcols
(f,l,mcols,ex) = makePostingErrorExcerpt p finderrcols
where
finderrcols p _ _ = Just (col, Just col2)
where
alen = T.length $ paccount p
llen = T.length $ accountLeafName a
col = 5 + (if isVirtual p then 1 else 0) + alen - llen
col2 = col + llen - 1
accts = T.intercalate ", " $ map (("\""<>).(<>"\"")) fulls

2
hledger/test/check-uniqueleafnames.test
View File

@ -11,5 +11,5 @@ $ hledger -f- check uniqueleafnames
(a) 1
(b:a) 1
$ hledger -f- check uniqueleafnames
>2 /account leaf names are not unique/
>2 /account leaf name .* is not unique/
>=1

8
hledger/test/csv.test
View File

@ -774,7 +774,7 @@ if|account2|comment
%description Flubber|acct|
$ ./csvtest.sh
>2
hledger: input.rules:6:1:
hledger: Error: input.rules:6:1:
|
6 | %amount 150|acct2
| ^
@ -796,7 +796,7 @@ account2 acct
comment cmt
$ ./csvtest.sh
>2
hledger: input.rules:5:1:
hledger: Error: input.rules:5:1:
|
5 | if Flubber
| ^
@ -822,7 +822,7 @@ if Flubber
account2 %myaccount2
$ ./csvtest.sh
>2
hledger: input.rules:6:3:
hledger: Error: input.rules:6:3:
|
6 | myaccount2 acct
| ^^^^^^^^^^^^
@ -870,7 +870,7 @@ if account2 comment
%description Flubber acct
$ ./csvtest.sh
>2
hledger: input.rules:5:1:
hledger: Error: input.rules:5:1:
|
5 | if account2 comment
| ^

44
hledger/test/errors/Makefile Normal file
View File

@ -0,0 +1,44 @@
# Check error messages of hledger in $PATH against current error tests.
test:
@printf "Running error message tests with hledger $$(hledger --version | awk '{print $$2}'):\n"
shelltest *.test
TESTJOURNALS=*.j
# Update error message tests and readme based on the latest test journals
# and error output of hledger in $PATH.
update: tests readme
tests:
@printf "Updating *.test with the error messages of hledger $$(hledger --version | awk '{print $$2}')\n"
@read -p "ok ? Press enter: "
for f in $(TESTJOURNALS); do make -s $$(basename $$f .j).test; done
make -s test
# Generate a shelltest. Run the test script/journal to generate the error message.
# Since the error will contain an absolute file path, we must:
# 1. remove most of the file path
# 2. test with a (multiline) regex rather than literal text
# 3. backslash-quote most forward slashes in error messages
# 4. neutralise any remaining problematic error text (eg in parseable-regexps.test)
%.test: %.j
head -1 $< | sed -E 's%#!/usr/bin/env -S (.*)%$$$$$$ \1 $<%' >$@
printf ">>>2 /" >>$@
-./$< 2>&1 | sed -E \
-e 's%(hledger: Error: ).*/\./(.*)%\1.*\2%' \
-e 's%/%\\/%g' \
-e 's%alias \\/\(\\/%alias \\/\\(\\/%' \
-e 's%compiled: \(%compiled: \\(%' \
>>$@
printf "/\n>>>= 1" >>$@
readme: $(TESTJOURNALS)
@printf "Updating README.md with the error messages of hledger $$(hledger --version | awk '{print $$2}')\n"
@read -p "ok ? Press enter: "
sed '/<!-- GENERATED: -->/q' <README.md >README.md.tmp
echo "$$(hledger --version | cut -d, -f1) error messages:" >>README.md.tmp
for f in $(TESTJOURNALS); do \
printf '\n### %s\n```\n%s\n```\n\n' "$$(basename "$$f" .j)" "$$(./"$$f" 2>&1)"; \
done >>README.md.tmp
mv README.md.tmp README.md

318
hledger/test/errors/README.md
View File

@ -20,36 +20,6 @@ Some files contain extra declarations to ease flycheck testing.
[flycheck-hledger-10]: https://github.com/DamienCassou/flycheck-hledger/pull/10
[#1436]: https://github.com/simonmichael/hledger/issues/1436
## Status
Here is the current status
(hledger 1.25, flycheck 87b275b9):
| | format | accurate line(s) | accurate column(s) | visual | flycheck detects | flycheck region |
|--------------------------|---------|------------------|--------------------|--------|------------------|-----------------|
| parseable | format1 | Y | Y | YY | Y | Y |
| parseable-dates | format1 | Y | Y | YY | Y | Y |
| parseable-regexps | format1 | Y | Y | YY | Y | Y |
| balanced | | Y | - | Y | Y | |
| balancednoautoconversion | | Y | - | Y | Y | |
| assertions | | Y | | Y | Y | Y |
| accounts | format2 | | | Y | Y | |
| commodities | format2 | | | Y | Y | |
| payees | format2 | | | Y | Y | Y |
| ordereddates | format2 | | | Y | Y | Y |
| uniqueleafnames | | | | Y | Y | |
Key:
- format: the error message follows a standard format
(format1: location on first line, megaparsec-like.
format2: summary on first line, location on second line, rustc-like.
std: new standard format)
- accurate line - the optimal line(s) is(are) selected
- accurate column - the optimal column(s) is(are) selected
- visual - the CLI error message shows a relevant excerpt (Y), ideally with the error highlighted (YY)
- flycheck detects - flycheck recognises the error output, reports the error and doesn't give a "suspicious" warning
- flycheck region - flycheck highlights a reasonably accurate text region containing the error
## Goals
- [x] phase 1: update flycheck to detect journal errors of current hledger release (and keep a branch updated to detect errors of latest hledger master)
@ -67,67 +37,84 @@ Key:
- [x] phase 13: decide/add error ids/explanations/web pages ? not needed
- [ ] phase 14: support Language Server Protocol & Visual Code
## Current status
Here is the current status
(hledger 1.25.99-gd278c4c71-20220422, flycheck 87b275b9):
| | std format | line | column | excerpt | flycheck | flycheck region |
|--------------------------|------------|------|------------|---------|----------|-----------------|
| accounts | Y | Y | Y | YY | | |
| assertions | | Y | | Y | | |
| balanced | | Y | - | Y | | |
| balancednoautoconversion | | Y | - | Y | | |
| commodities | Y | Y | Y (approx) | YY | | |
| ordereddates | Y | Y | Y | YY | | |
| parseable | Y | Y | Y | YY | | |
| parseable-dates | Y | Y | Y | YY | | |
| parseable-regexps | Y | Y | Y | YY | | |
| payees | Y | Y | Y | YY | | |
| uniqueleafnames | Y | Y | Y | YY | | |
Key:
- std format - the error message follows a standard format (location on first line, megaparsec-like excerpt, description).
- line - the optimal line(s) is(are) selected
- column - the optimal column(s) is(are) selected
- excerpt - a useful excerpt is shown (Y), ideally with the error highlighted (YY)
- flycheck - latest flycheck release recognises and reports the error, with no "suspicious state" warning
- flycheck region - flycheck highlights a reasonably accurate region containing the error
## Preferred error format
Here is our preferred error message layout for now:
```
hledger: Error: FILE:LOCATION:
EXCERPT
SUMMARY
[DETAILS]
```
Notes (see also [#1436][]):
- the "hledger: " prefix could be dropped later with a bit more effort
- includes the word "Error" and the error position on line 1
- FILE is the file path
- LOCATION is `LINE[-ENDLINE][:COLUMN[-ENDCOLUMN]]`
- we may show 0 for LINE or COLUMN when unknown
- EXCERPT is a short visual snippet whenever possible, with the error region highlighted, line numbers, and colour when supported. This section must be easy for flycheck to ignore.
- SUMMARY is a one line description/explanation of the problem.
These are currently dynamic, they can include helpful contextual info.
ShellCheck uses static summaries.
- DETAILS is optional additional details/advice when needed.
- this layout is based on megaparsec's
- for comparison: rustc puts summary on line 1 and location on line 2:
```
Error[ID]: SUMMARY
at FILE:LOCATION
EXCERPT
[DETAILS]
```
- try https://github.com/mesabloo/diagnose later
## Current journal errors
<!-- to update: erase the below then C-u M-! ./showall -->
hledger 1.25.99-g133c54434-20220414 error messages, last updated 2022-04-15:
<!-- GENERATED: -->
hledger 1.25.99-g9bff671b5-20220424 error messages:
### parseable
### accounts
```
hledger: /Users/simon/src/hledger/hledger/test/errors/./parseable.j:3:2:
|
3 | 1
| ^
unexpected newline
expecting date separator or digit
hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./accounts.j:4:6-6:
| 2022-01-01
4 | (a) 1
| ^
undeclared account "a"
```
### parseable-dates
```
hledger: /Users/simon/src/hledger/hledger/test/errors/./parseable-dates.j:3:1:
|
3 | 2022/1/32
| ^^^^^^^^^
well-formed but invalid date: 2022/1/32
```
### parseable-regexps
```
hledger: /Users/simon/src/hledger/hledger/test/errors/./parseable-regexps.j:3:8:
|
3 | alias /(/ = a
| ^
this regular expression could not be compiled: (
```
### balanced
```
hledger: /Users/simon/src/hledger/hledger/test/errors/./balanced.j:3-4
could not balance this transaction:
real postings' sum should be 0 but is: 1
2022-01-01
a 1
```
### balancednoautoconversion
```
hledger: /Users/simon/src/hledger/hledger/test/errors/./balancednoautoconversion.j:6-8
could not balance this transaction:
real postings' sum should be 0 but is: 1 A
-1 B
2022-01-01
a 1 A
b -1 B
```
### assertions
```
hledger: balance assertion: /Users/simon/src/hledger/hledger/test/errors/./assertions.j:4:8
hledger: Error: balance assertion: /Users/simon/src/hledger/hledger/test/errors/./assertions.j:4:8
transaction:
2022-01-01
a 0 = 1
@ -139,112 +126,99 @@ commodity:
calculated: 0
asserted: 1
difference: 1
```
### accounts
```
Error: undeclared account "a"
in transaction at: /Users/simon/src/hledger/hledger/test/errors/./accounts.j:3-4
2022-01-01
(a) 1
### balanced
```
hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./balanced.j:3-4
could not balance this transaction:
real postings' sum should be 0 but is: 1
2022-01-01
a 1
```
### balancednoautoconversion
```
hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./balancednoautoconversion.j:6-8
could not balance this transaction:
real postings' sum should be 0 but is: 1 A
-1 B
2022-01-01
a 1 A
b -1 B
```
### commodities
```
Error: undeclared commodity "A"
in transaction at: /Users/simon/src/hledger/hledger/test/errors/./commodities.j:5-6
2022-01-01
(a) A 1
hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./commodities.j:6:21-23:
| 2022-01-01
6 | (a) A 1
| ^^^
undeclared commodity "A"
```
### payees
```
Error: undeclared payee "p"
at: /Users/simon/src/hledger/hledger/test/errors/./payees.j:6-7
> 2022-01-01 p
(a) A 1
```
### ordereddates
```
Error: transaction date is out of order
at /Users/simon/src/hledger/hledger/test/errors/./ordereddates.j:10-11:
2022-01-02 p
(a) 1
> 2022-01-01 p
(a) 1
hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./ordereddates.j:10:1-10:
10 | 2022-01-01 p
| ^^^^^^^^^^
| (a) 1
transaction date is out of order with previous transaction date 2022-01-02
```
### parseable-dates
```
hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./parseable-dates.j:3:1:
|
3 | 2022/1/32
| ^^^^^^^^^
well-formed but invalid date: 2022/1/32
```
### parseable-regexps
```
hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./parseable-regexps.j:3:8:
|
3 | alias /(/ = a
| ^
this regular expression could not be compiled: (
```
### parseable
```
hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./parseable.j:3:2:
|
3 | 1
| ^
unexpected newline
expecting date separator or digit
```
### payees
```
hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./payees.j:6:12-12:
6 | 2022-01-01 p
| ^
| (a) A 1
undeclared payee "p"
```
### uniqueleafnames
```
Error: account leaf names are not unique
leaf name "c" appears in account names: "a:c", "b:c"
seen in "a:c" in transaction at: /Users/simon/src/hledger/hledger/test/errors/./uniqueleafnames.j:8-9
> 2022-01-01 p
> (a:c) 1
hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./uniqueleafnames.j:9:8-8:
| 2022-01-01 p
9 | (a:c) 1
| ^
account leaf name "c" is not unique
it is used in account names: "a:c", "b:c"
```
## New error format
The preferred standard error format for now is the following,
similar to the one megaparsec gives us
and probably the easiest to implement consistently:
```
Error: FILE:LOCATION:
EXCERPT
SUMMARY
[DETAILS]
```
Other format notes (see also [#1436][]):
megaparsec-like:
```
Error: [ID] FILE:LOCATION
EXCERPT
SUMMARY
[DETAILS]
```
- begins with the word "Error"
- ID is an optional error id, eg `HL1001` (in brackets ?). We might adopt these, similar to ShellCheck.
- FILE is the file path.
- LOCATION is `LINE[-ENDLINE][:COLUMN[-ENDCOLUMN]]`. Having location on the first line helps some tools, like Emacs M-x compile.
- EXCERPT is a short visual snippet whenever possible, with the error region highlighted, line numbers, and colour when supported. This section must be easy for flycheck to ignore.
- SUMMARY is a one line description/explanation of the problem. Currently we use dynamic summaries including contextual data for clarity. ShellCheck uses static summaries, which might have some advantages.
- DETAILS is optional additional details/advice when needed.
rustc-like:
```
Error[ID]: SUMMARY
at FILE:LOCATION
EXCERPT
[DETAILS]
```
- Having summary on the first line can be helpful eg when grepping logged errors.
Questions:
- location needed on first line for maximum tool support ?
- summary needed on first line for maximum concision/greppability ?
- allow long, much-wider-than-80-char first lines or not ?
- dynamic or static summary ?
- error ids/explanations needed ? local and/or web based ? easily editable ? document old hledger versions ?

9
hledger/test/errors/accounts.test Normal file
View File

@ -0,0 +1,9 @@
$$$ hledger check accounts -f accounts.j
>>>2 /hledger: Error: .*accounts.j:4:6-6:
| 2022-01-01
4 | (a) 1
| ^
undeclared account "a"
/
>>>= 1

16
hledger/test/errors/assertions.test Normal file
View File

@ -0,0 +1,16 @@
$$$ hledger check -f assertions.j
>>>2 /hledger: Error: .*assertions.j:4:8
transaction:
2022-01-01
a 0 = 1
assertion details:
date: 2022-01-01
account: a
commodity:
calculated: 0
asserted: 1
difference: 1
/
>>>= 1

9
hledger/test/errors/balanced.test Normal file
View File

@ -0,0 +1,9 @@
$$$ hledger check -f balanced.j
>>>2 /hledger: Error: .*balanced.j:3-4
could not balance this transaction:
real postings' sum should be 0 but is: 1
2022-01-01
a 1
/
>>>= 1

8
hledger/test/errors/balancednoautoconversion.j Executable file
View File

@ -0,0 +1,8 @@
#!/usr/bin/env -S hledger check balancednoautoconversion -f
# Show the error when balancedwithautoconversion is required
# and an implicit commodity conversion is found.
# Currently the same as the regular balancedwithautoconversion error.
1/1
a 1 A
b -1 B

11
hledger/test/errors/balancednoautoconversion.test Normal file
View File

@ -0,0 +1,11 @@
$$$ hledger check balancednoautoconversion -f balancednoautoconversion.j
>>>2 /hledger: Error: .*balancednoautoconversion.j:6-8
could not balance this transaction:
real postings' sum should be 0 but is: 1 A
-1 B
2022-01-01
a 1 A
b -1 B
/
>>>= 1

9
hledger/test/errors/commodities.test Normal file
View File

@ -0,0 +1,9 @@
$$$ hledger check commodities -f commodities.j
>>>2 /hledger: Error: .*commodities.j:6:21-23:
| 2022-01-01
6 | (a) A 1
| ^^^
undeclared commodity "A"
/
>>>= 1

8
hledger/test/errors/ordereddates.test Normal file
View File

@ -0,0 +1,8 @@
$$$ hledger check ordereddates -f ordereddates.j
>>>2 /hledger: Error: .*ordereddates.j:10:1-10:
10 | 2022-01-01 p
| ^^^^^^^^^^
| (a) 1
transaction date is out of order with previous transaction date 2022-01-02
/
>>>= 1

9
hledger/test/errors/parseable-dates.test Normal file
View File

@ -0,0 +1,9 @@
$$$ hledger check -f parseable-dates.j
>>>2 /hledger: Error: .*parseable-dates.j:3:1:
|
3 | 2022\/1\/32
| ^^^^^^^^^
well-formed but invalid date: 2022\/1\/32
/
>>>= 1

9
hledger/test/errors/parseable-regexps.test Normal file
View File

@ -0,0 +1,9 @@
$$$ hledger check -f parseable-regexps.j
>>>2 /hledger: Error: .*parseable-regexps.j:3:8:
|
3 | alias \/\(\/ = a
| ^
this regular expression could not be compiled: \(
/
>>>= 1

10
hledger/test/errors/parseable.test Normal file
View File

@ -0,0 +1,10 @@
$$$ hledger check -f parseable.j
>>>2 /hledger: Error: .*parseable.j:3:2:
|
3 | 1
| ^
unexpected newline
expecting date separator or digit
/
>>>= 1

9
hledger/test/errors/payees.test Normal file
View File

@ -0,0 +1,9 @@
$$$ hledger check payees -f payees.j
>>>2 /hledger: Error: .*payees.j:6:12-12:
6 | 2022-01-01 p
| ^
| (a) A 1
undeclared payee "p"
/
>>>= 1

28
hledger/test/errors/showall
View File

@ -1,28 +0,0 @@
#!/usr/bin/env sh
# Execute all test journals, showing their error messages
# (as README-ready markdown).
# All test journals in this directory, in preferred test/display order
testfiles="\
parseable.j \
parseable-dates.j \
parseable-regexps.j \
balanced.j \
balancednoautoconversion.j \
assertions.j \
accounts.j \
commodities.j \
payees.j \
ordereddates.j \
uniqueleafnames.j \
"
printf '%s error messages, last updated %s:\n\n' \
"$(hledger --version | cut -d, -f1)" \
"$(date +%Y-%m-%d)"
for f in $testfiles; do
printf '### %s\n```\n' "$(echo "$f" | cut -d. -f1)"
./"$f" || true
printf '```\n\n'
done

9
hledger/test/errors/uniqueleafnames.test Normal file
View File

@ -0,0 +1,9 @@
$$$ hledger check uniqueleafnames -f uniqueleafnames.j
>>>2 /hledger: Error: .*uniqueleafnames.j:9:8-8:
| 2022-01-01 p
9 | (a:c) 1
| ^
account leaf name "c" is not unique
it is used in account names: "a:c", "b:c"
/
>>>= 1

2
hledger/test/forecast.test
View File

@ -172,7 +172,7 @@ Balance changes in 2016-10-01..2017-01-31:
$ hledger bal -M -b 2016-10 -e 2017-02 -f - --forecast=20160801-foobar
>
>2
hledger: could not parse forecast period : 1:10:
hledger: Error: could not parse forecast period : 1:10:
|
1 | 20160801-foobar
| ^

4
hledger/test/journal/parse-errors.test
View File

@ -8,7 +8,7 @@
# 1.
$ hledger -f - print
>2
hledger: -:1:5:
hledger: Error: -:1:5:
|
1 | 2018
| ^
@ -123,7 +123,7 @@ $ hledger -f- print
b 1B
$ hledger -f- print
>2
hledger: -:1-3
hledger: Error: -:1-3
could not balance this transaction:
real postings all have the same sign
2020-01-01

2
hledger/test/roi.test
View File

@ -238,7 +238,7 @@ hledger -f- roi -p 2019-11 --inv Investment --pnl PnL
Assets:Checking 101 A
Unrealized PnL
>>>2
hledger: Amounts could not be converted to a single cost basis: ["10 B","-10 B @@ 100 A"]
hledger: Error: Amounts could not be converted to a single cost basis: ["10 B","-10 B @@ 100 A"]
Consider using --value to force all costs to be in a single commodity.
For example, "--cost --value=end,<commodity> --infer-market-prices", where commodity is the one that was used to pay for the investment.
>>>=1