slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages 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
import Text.Megaparsec.Char (char, char', digitChar, string, string') import Text.Megaparsec.Char (char, char', digitChar, string, string')
import Text.Megaparsec.Char.Lexer (decimal, signed) import Text.Megaparsec.Char.Lexer (decimal, signed)
import Text.Megaparsec.Custom (customErrorBundlePretty) import Text.Megaparsec.Custom (customErrorBundlePretty, HledgerParseErrors)
import Text.Printf (printf) import Text.Printf (printf)
import Hledger.Data.Types import Hledger.Data.Types
@ -360,7 +360,7 @@ latestSpanContaining datespans = go
-- | Parse a period expression to an Interval and overall DateSpan using -- | Parse a period expression to an Interval and overall DateSpan using
-- the provided reference date, or return a parse error. -- the provided reference date, or return a parse error.
parsePeriodExpr 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) parsePeriodExpr refdate s = parsewith (periodexprp refdate <* eof) (T.toLower s)
-- | Like parsePeriodExpr, but call error' on failure. -- | Like parsePeriodExpr, but call error' on failure.
@ -408,14 +408,14 @@ spanFromSmartDate refdate sdate = DateSpan (Just b) (Just e)
fixSmartDateStr :: Day -> Text -> Text fixSmartDateStr :: Day -> Text -> Text
fixSmartDateStr d s = fixSmartDateStr d s =
either (error' . printf "could not parse date %s %s" (show s) . show) id $ -- PARTIAL: 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. -- | 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 d = fmap showDate . fixSmartDateStrEither' d
fixSmartDateStrEither' fixSmartDateStrEither'
:: Day -> Text -> Either (ParseErrorBundle Text CustomErr) Day :: Day -> Text -> Either HledgerParseErrors Day
fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of
Right sd -> Right $ fixSmartDate d sd Right sd -> Right $ fixSmartDate d sd
Left e -> Left e 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. -- | 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 -- | A parser of text that runs in some monad, keeping a Journal as
-- state, that can throw an exception to end parsing, preventing -- state, that can throw an exception to end parsing, preventing
-- further parser backtracking. -- further parser backtracking.
type ErroringJournalParser m a = 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 -- deriving instance Show Journal
instance Show Journal where instance Show Journal where

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

@ -189,20 +189,20 @@ instance Show PeriodicTransaction where
-- <BLANKLINE> -- <BLANKLINE>
-- --
-- >>> _ptgen "" -- >>> _ptgen ""
-- *** Exception: failed to parse... -- *** Exception: Error: failed to parse...
-- ... -- ...
-- --
-- >>> _ptgen "weekly from 2017" -- >>> _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" -- >>> _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" -- >>> _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" -- >>> _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)) -- >>> 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 -- * rendering
, showTransaction , showTransaction
, showTransactionOneLineAmounts , showTransactionOneLineAmounts
, showTransactionLineFirstPart
, transactionFile , transactionFile
-- * tests -- * tests
, tests_Transaction , tests_Transaction
@ -137,18 +138,22 @@ showTransactionHelper onelineamounts t =
<> foldMap ((<> newline) . TB.fromText) (postingsAsLines onelineamounts $ tpostings t) <> foldMap ((<> newline) . TB.fromText) (postingsAsLines onelineamounts $ tpostings t)
<> newline <> newline
where where
descriptionline = T.stripEnd $ T.concat [date, status, code, desc, samelinecomment] descriptionline = T.stripEnd $ showTransactionLineFirstPart t <> T.concat [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
desc = if T.null d then "" else " " <> d where d = tdescription t desc = if T.null d then "" else " " <> d where d = tdescription t
(samelinecomment, newlinecomments) = (samelinecomment, newlinecomments) =
case renderCommentLines (tcomment t) of [] -> ("",[]) case renderCommentLines (tcomment t) of [] -> ("",[])
c:cs -> (c,cs) c:cs -> (c,cs)
newline = TB.singleton '\n' 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 :: Transaction -> Bool
hasRealPostings = not . null . realPostings hasRealPostings = not . null . realPostings

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

@ -112,6 +112,8 @@ module Hledger.Read.Common (
skipNonNewlineSpaces, skipNonNewlineSpaces,
skipNonNewlineSpaces1, skipNonNewlineSpaces1,
aliasesFromOpts, aliasesFromOpts,
makeTransactionErrorExcerpt,
makePostingErrorExcerpt,
-- * tests -- * tests
tests_Common, tests_Common,
@ -144,7 +146,7 @@ import Text.Megaparsec
import Text.Megaparsec.Char (char, char', digitChar, newline, string) import Text.Megaparsec.Char (char, char', digitChar, newline, string)
import Text.Megaparsec.Char.Lexer (decimal) import Text.Megaparsec.Char.Lexer (decimal)
import Text.Megaparsec.Custom import Text.Megaparsec.Custom
(FinalParseError, attachSource, customErrorBundlePretty, finalErrorBundlePretty, parseErrorAt, parseErrorAtRegion) (FinalParseError, attachSource, customErrorBundlePretty, finalErrorBundlePretty, parseErrorAt, parseErrorAtRegion, HledgerParseErrors)
import Hledger.Data import Hledger.Data
import Hledger.Query (Query(..), filterQuery, parseQueryTerm, queryEndDate, queryStartDate, queryIsDate, simplifyQuery) 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 Hledger.Utils
import Text.Printf (printf) import Text.Printf (printf)
import Hledger.Read.InputOptions import Hledger.Read.InputOptions
import Safe (atMay)
--- ** doctest setup --- ** doctest setup
-- $setup -- $setup
@ -271,7 +274,7 @@ initialiseAndParseJournal parser iopts f txt =
y = first3 . toGregorian $ _ioDay iopts y = first3 . toGregorian $ _ioDay iopts
initJournal = nulljournal{jparsedefaultyear = Just y, jincludefilestack = [f]} initJournal = nulljournal{jparsedefaultyear = Just y, jincludefilestack = [f]}
-- Flatten parse errors and final parse errors, and output each as a pretty String. -- 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 -> ExceptT String IO a
prettyParseErrors = withExceptT customErrorBundlePretty . liftEither prettyParseErrors = withExceptT customErrorBundlePretty . liftEither
<=< withExceptT (finalErrorBundlePretty . attachSource f txt) <=< withExceptT (finalErrorBundlePretty . attachSource f txt)
@ -362,59 +365,173 @@ journalCheckPayeesDeclared :: Journal -> Either String ()
journalCheckPayeesDeclared j = mapM_ checkpayee (jtxns j) journalCheckPayeesDeclared j = mapM_ checkpayee (jtxns j)
where where
checkpayee t checkpayee t
| p `elem` ps = Right () | payee `elem` journalPayeesDeclared j = Right ()
| otherwise = Left $ | otherwise = Left $
printf "undeclared payee \"%s\"\nat: %s\n\n%s" printf "%s:%d:%d-%d:\n%sundeclared payee \"%s\"\n" f l col col2 ex payee
(T.unpack p)
(sourcePosPairPretty $ tsourcepos t)
(linesPrepend2 "> " " " . (<>"\n") . textChomp $ showTransaction t)
where where
p = transactionPayee t payee = transactionPayee t
ps = journalPayeesDeclared j (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 -- | Check that all the journal's postings are to accounts declared with
-- account directives, returning an error message otherwise. -- account directives, returning an error message otherwise.
journalCheckAccountsDeclared :: Journal -> Either String () journalCheckAccountsDeclared :: Journal -> Either String ()
journalCheckAccountsDeclared j = mapM_ checkacct (journalPostings j) journalCheckAccountsDeclared j = mapM_ checkacct (journalPostings j)
where where
checkacct Posting{paccount,ptransaction} checkacct p@Posting{paccount=a}
| paccount `elem` as = Right () | a `elem` journalAccountNamesDeclared j = Right ()
| otherwise = Left $ | otherwise = Left $
(printf "undeclared account \"%s\"\n" (T.unpack paccount)) printf "%s:%d:%d-%d:\n%sundeclared account \"%s\"\n" f l col col2 ex a
++ case ptransaction of
Nothing -> ""
Just t -> printf "in transaction at: %s\n\n%s"
(sourcePosPairPretty $ tsourcepos t)
(linesPrepend " " . (<>"\n") . textChomp $ showTransaction t)
where where
as = journalAccountNamesDeclared j (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 -- | 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.
journalCheckCommoditiesDeclared :: Journal -> Either String () journalCheckCommoditiesDeclared :: Journal -> Either String ()
journalCheckCommoditiesDeclared j = journalCheckCommoditiesDeclared j = mapM_ checkcommodities (journalPostings j)
mapM_ checkcommodities (journalPostings j)
where where
checkcommodities Posting{..} = checkcommodities p =
case mfirstundeclaredcomm of case findundeclaredcomm p of
Nothing -> Right () Nothing -> Right ()
Just c -> Left $ Just (comm, _) ->
(printf "undeclared commodity \"%s\"\n" (T.unpack c)) Left $ printf "%s:%d:%d-%d:\n%sundeclared commodity \"%s\"\n" f l col col2 ex comm
++ case ptransaction of where
Nothing -> "" (f,l,mcols,ex) = makePostingErrorExcerpt p finderrcols
Just t -> printf "in transaction at: %s\n\n%s" col = maybe 0 fst mcols
(sourcePosPairPretty $ tsourcepos t) col2 = maybe 0 (fromMaybe 0 . snd) mcols
(linesPrepend " " . (<>"\n") . textChomp $ showTransaction t) 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
(Just c, _) -> Just (c, True)
(_, Just c) -> Just (c, False)
_ -> Nothing
where
postingcomms = map acommodity $ filter (not . isIgnorable) $ amountsRaw amt
where where
mfirstundeclaredcomm =
find (`M.notMember` jcommodities j)
. map acommodity
. (maybe id ((:) . baamount) pbalanceassertion)
. filter (not . isIgnorable)
$ amountsRaw pamount
-- 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 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 :: Year -> JournalParser m ()
setYear y = modify' (\j -> j{jparsedefaultyear=Just y}) 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) Right (q,p,d,g) -> pure (q, Precision p, d, g)
-- | Try to parse an amount from a string -- | 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) amountp'' s = runParser (evalStateT (amountp <* eof) nulljournal) "" (T.pack s)
-- | Parse an amount from a string, or get an error. -- | 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) parseErrorPretty (FancyError 0 (S.singleton $ ErrorFail errorString) :: ParseError Text String)
-- | Parse this text as CSV conversion rules. The file path is for error messages. -- | 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 rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s
parseCsvRules = runParser (evalStateT rulesp defrules) parseCsvRules = runParser (evalStateT rulesp defrules)
@ -1232,7 +1232,7 @@ renderTemplate rules record t = maybe t mconcat $ parseMaybe
<|> replaceCsvFieldReference rules record <$> referencep) <|> replaceCsvFieldReference rules record <$> referencep)
t t
where 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 == '-' isFieldNameChar c = isAlphaNum c || c == '_' || c == '-'
-- | Replace something that looks like a reference to a csv field ("%date" or "%1) -- | 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. -- | Run a journal parser in some monad. See also: parseWithState.
runJournalParser, rjp runJournalParser, rjp
:: Monad m :: 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) "" runJournalParser p = runParserT (evalStateT p nulljournal) ""
rjp = runJournalParser rjp = runJournalParser
@ -122,7 +122,7 @@ runErroringJournalParser, rejp
:: Monad m :: Monad m
=> ErroringJournalParser m a => ErroringJournalParser m a
-> Text -> Text
-> m (Either FinalParseError (Either (ParseErrorBundle Text CustomErr) a)) -> m (Either FinalParseError (Either HledgerParseErrors a))
runErroringJournalParser p t = runErroringJournalParser p t =
runExceptT $ runParserT (evalStateT p nulljournal) "" t runExceptT $ runParserT (evalStateT p nulljournal) "" t
rejp = runErroringJournalParser rejp = runErroringJournalParser

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

@ -801,7 +801,7 @@ makeHledgerClassyLenses ''ReportSpec
-- >>> _rsQuery $ set querystring ["assets"] defreportspec -- >>> _rsQuery $ set querystring ["assets"] defreportspec
-- Acct (RegexpCI "assets") -- Acct (RegexpCI "assets")
-- >>> _rsQuery $ set querystring ["(assets"] defreportspec -- >>> _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 -- >>> _rsQuery $ set period (MonthPeriod 2021 08) defreportspec
-- Date DateSpan 2021-08 -- Date DateSpan 2021-08
class HasReportOptsNoUpdate a => HasReportOpts a where class HasReportOptsNoUpdate a => HasReportOpts a where

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

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

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

@ -38,7 +38,7 @@ module Hledger.Utils.Parse (
skipNonNewlineSpaces', skipNonNewlineSpaces',
-- * re-exports -- * re-exports
CustomErr HledgerParseErrorData
) )
where where
@ -54,13 +54,13 @@ import Text.Megaparsec.Custom
import Text.Printf import Text.Printf
-- | A parser of string to some type. -- | 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. -- | 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. -- | 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. -- | Render a pair of source positions in human-readable form, only displaying the range of lines.
sourcePosPairPretty :: (SourcePos, SourcePos) -> String sourcePosPairPretty :: (SourcePos, SourcePos) -> String
@ -76,7 +76,7 @@ choice' = choice . map try
-- | Backtracking choice, use this when alternatives share a prefix. -- | Backtracking choice, use this when alternatives share a prefix.
-- Consumes no input if all choices fail. -- 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 choiceInState = choice . map try
surroundedBy :: Applicative m => m openclose -> m a -> m a 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. -- | Run a text parser in the identity monad. See also: parseWithState.
runTextParser, rtp runTextParser, rtp
:: TextParser Identity a -> Text -> Either (ParseErrorBundle Text CustomErr) a :: TextParser Identity a -> Text -> Either HledgerParseErrors a
runTextParser = parsewith runTextParser = parsewith
rtp = runTextParser rtp = runTextParser
@ -100,9 +100,9 @@ parsewithString p = runParser p ""
parseWithState parseWithState
:: Monad m :: Monad m
=> st => st
-> StateT st (ParsecT CustomErr Text m) a -> StateT st (ParsecT HledgerParseErrorData Text m) a
-> Text -> Text
-> m (Either (ParseErrorBundle Text CustomErr) a) -> m (Either HledgerParseErrors a)
parseWithState ctx p = runParserT (evalStateT p ctx) "" parseWithState ctx p = runParserT (evalStateT p ctx) ""
parseWithState' parseWithState'
@ -139,7 +139,7 @@ nonspace = satisfy (not . isSpace)
isNonNewlineSpace :: Char -> Bool isNonNewlineSpace :: Char -> Bool
isNonNewlineSpace c = not (isNewline c) && isSpace c 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 spacenonewline = satisfy isNonNewlineSpace
{-# INLINABLE spacenonewline #-} {-# INLINABLE spacenonewline #-}
@ -147,17 +147,17 @@ restofline :: TextParser m String
restofline = anySingle `manyTill` eolof restofline = anySingle `manyTill` eolof
-- Skip many non-newline spaces. -- 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 skipNonNewlineSpaces = () <$ takeWhileP Nothing isNonNewlineSpace
{-# INLINABLE skipNonNewlineSpaces #-} {-# INLINABLE skipNonNewlineSpaces #-}
-- Skip many non-newline spaces, failing if there are none. -- 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 skipNonNewlineSpaces1 = () <$ takeWhile1P Nothing isNonNewlineSpace
{-# INLINABLE skipNonNewlineSpaces1 #-} {-# INLINABLE skipNonNewlineSpaces1 #-}
-- Skip many non-newline spaces, returning True if any have been skipped. -- 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 skipNonNewlineSpaces' = True <$ skipNonNewlineSpaces1 <|> pure False
{-# INLINABLE skipNonNewlineSpaces' #-} {-# 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 Test.Tasty.SmallCheck as SC
import Text.Megaparsec import Text.Megaparsec
import Text.Megaparsec.Custom import Text.Megaparsec.Custom
( CustomErr, ( HledgerParseErrorData,
FinalParseError, FinalParseError,
attachSource, attachSource,
customErrorBundlePretty, 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. -- | Run a parser on the given text and display a helpful error.
parseHelper :: (HasCallStack, Default st, Monad m) => 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 = parseHelper parser input =
withExceptT (\e -> "\nparse error at " ++ customErrorBundlePretty e ++ "\n") . ExceptT withExceptT (\e -> "\nparse error at " ++ customErrorBundlePretty e ++ "\n") . ExceptT
$ runParserT (evalStateT (parser <* eof) def) "" input $ runParserT (evalStateT (parser <* eof) def) "" input
@ -65,7 +65,7 @@ parseHelper parser input =
-- produce an 'Assertion'. Suitable for hledger's JournalParser parsers. -- produce an 'Assertion'. Suitable for hledger's JournalParser parsers.
assertParseHelper :: (HasCallStack, Default st) => assertParseHelper :: (HasCallStack, Default st) =>
(String -> Assertion) -> (a -> Assertion) (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 -> Assertion
assertParseHelper onFailure onSuccess parser input = assertParseHelper onFailure onSuccess parser input =
either onFailure onSuccess =<< runExceptT (parseHelper 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. -- all of the given input text, showing the parse error if it fails.
-- Suitable for hledger's JournalParser parsers. -- Suitable for hledger's JournalParser parsers.
assertParse :: (HasCallStack, Default st) => 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 ()) assertParse = assertParseHelper assertFailure (const $ return ())
-- | Assert a parser produces an expected value. -- | Assert a parser produces an expected value.
assertParseEq :: (HasCallStack, Eq a, Show a, Default st) => 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 assertParseEq parser input = assertParseEqOn parser input id
-- | Like assertParseEq, but transform the parse result with the given function -- | Like assertParseEq, but transform the parse result with the given function
-- before comparing it. -- before comparing it.
assertParseEqOn :: (HasCallStack, Eq b, Show b, Default st) => 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 = assertParseEqOn parser input f expected =
assertParseHelper assertFailure (assertEqual "" expected . f) parser input assertParseHelper assertFailure (assertEqual "" expected . f) parser input
-- | Assert that this stateful parser runnable in IO fails to parse -- | Assert that this stateful parser runnable in IO fails to parse
-- the given input text, with a parse error containing the given string. -- the given input text, with a parse error containing the given string.
assertParseError :: (HasCallStack, Eq a, Show a, Default st) => 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 assertParseError parser input errstr = assertParseHelper
(\e -> unless (errstr `isInfixOf` e) $ assertFailure $ "\nparse error is not as expected:" ++ e) (\e -> unless (errstr `isInfixOf` e) $ assertFailure $ "\nparse error is not as expected:" ++ e)
(\v -> assertFailure $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n") (\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), -- final state (the wrapped state, not megaparsec's internal state),
-- transformed by the given function, matches the given expected value. -- transformed by the given function, matches the given expected value.
assertParseStateOn :: (HasCallStack, Eq b, Show b, Default st) => 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 assertParseStateOn parser input f expected = do
es <- runParserT (execStateT (parser <* eof) def) "" input es <- runParserT (execStateT (parser <* eof) def) "" input
case es of 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. -- | These "E" variants of the above are suitable for hledger's ErroringJournalParser parsers.
parseHelperE :: (HasCallStack, Default st, Monad m) => 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 parseHelperE parser input = do
withExceptT (\e -> "\nparse error at " ++ customErrorBundlePretty e ++ "\n") . liftEither withExceptT (\e -> "\nparse error at " ++ customErrorBundlePretty e ++ "\n") . liftEither
=<< withExceptT (\e -> "parse error at " ++ finalErrorBundlePretty (attachSource "" input e)) =<< withExceptT (\e -> "parse error at " ++ finalErrorBundlePretty (attachSource "" input e))
@ -119,30 +119,30 @@ parseHelperE parser input = do
assertParseHelperE :: (HasCallStack, Default st) => assertParseHelperE :: (HasCallStack, Default st) =>
(String -> Assertion) -> (a -> Assertion) (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 -> Assertion
assertParseHelperE onFailure onSuccess parser input = assertParseHelperE onFailure onSuccess parser input =
either onFailure onSuccess =<< runExceptT (parseHelperE parser input) either onFailure onSuccess =<< runExceptT (parseHelperE parser input)
assertParseE assertParseE
:: (HasCallStack, Eq a, Show a, Default st) :: (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 ()) assertParseE = assertParseHelperE assertFailure (const $ return ())
assertParseEqE assertParseEqE
:: (Default st, Eq a, Show a, HasCallStack) :: (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 assertParseEqE parser input = assertParseEqOnE parser input id
assertParseEqOnE assertParseEqOnE
:: (HasCallStack, Eq b, Show b, Default st) :: (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 = assertParseEqOnE parser input f expected =
assertParseHelperE assertFailure (assertEqual "" expected . f) parser input assertParseHelperE assertFailure (assertEqual "" expected . f) parser input
assertParseErrorE assertParseErrorE
:: (Default st, Eq a, Show a, HasCallStack) :: (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 assertParseErrorE parser input errstr = assertParseHelperE
(\e -> unless (errstr `isInfixOf` e) $ assertFailure $ "\nparse error is not as expected:" ++ e) (\e -> unless (errstr `isInfixOf` e) $ assertFailure $ "\nparse error is not as expected:" ++ e)
(\v -> assertFailure $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n") (\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 {-# LANGUAGE StandaloneDeriving #-} -- new
module Text.Megaparsec.Custom ( module Text.Megaparsec.Custom (
-- * Custom parse error type -- * Custom parse error types
CustomErr, HledgerParseErrorData,
HledgerParseErrors,
-- * Failing with an arbitrary source position -- * Failing with an arbitrary source position
parseErrorAt, parseErrorAt,
@ -55,12 +56,10 @@ import Data.Text (Text)
import Text.Megaparsec import Text.Megaparsec
--- * Custom parse error type --- * Custom parse error types
-- | A custom error type for the parser. The type is specialized to -- | Custom error data for hledger parsers. Specialised for a 'Text' parse stream.
-- parsers of 'Text' streams. data HledgerParseErrorData
data CustomErr
-- | Fail with a message at a specific source position interval. The -- | Fail with a message at a specific source position interval. The
-- interval must be contained within a single line. -- interval must be contained within a single line.
= ErrorFailAt Int -- Starting offset = ErrorFailAt Int -- Starting offset
@ -69,21 +68,27 @@ data CustomErr
-- | Re-throw parse errors obtained from the "re-parsing" of an excerpt -- | Re-throw parse errors obtained from the "re-parsing" of an excerpt
-- of the source text. -- of the source text.
| ErrorReparsing | ErrorReparsing
(NE.NonEmpty (ParseError Text CustomErr)) -- Source fragment parse errors (NE.NonEmpty (ParseError Text HledgerParseErrorData)) -- Source fragment parse errors
deriving (Show, Eq, Ord) 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 -- We require an 'Ord' instance for 'CustomError' so that they may be
-- stored in a 'Set'. The actual instance is inconsequential, so we just -- stored in a 'Set'. The actual instance is inconsequential, so we just
-- derive it, but the derived instance requires an (orphan) instance for -- derive it, but the derived instance requires an (orphan) instance for
-- 'ParseError'. Hopefully this does not cause any trouble. -- '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 -- defined in its 'ShowErrorComponent' instance; we perform additional
-- adjustments in 'customErrorBundlePretty'. -- adjustments in 'customErrorBundlePretty'.
instance ShowErrorComponent CustomErr where instance ShowErrorComponent HledgerParseErrorData where
showErrorComponent (ErrorFailAt _ _ errMsg) = errMsg showErrorComponent (ErrorFailAt _ _ errMsg) = errMsg
showErrorComponent (ErrorReparsing _) = "" -- dummy value showErrorComponent (ErrorReparsing _) = "" -- dummy value
@ -98,7 +103,7 @@ instance ShowErrorComponent CustomErr where
-- start of the input stream (the number of tokens processed at that -- start of the input stream (the number of tokens processed at that
-- point). -- point).
parseErrorAt :: Int -> String -> CustomErr parseErrorAt :: Int -> String -> HledgerParseErrorData
parseErrorAt offset = ErrorFailAt offset (offset+1) parseErrorAt offset = ErrorFailAt offset (offset+1)
-- | Fail at a specific source interval, given by the raw offsets of its -- | Fail at a specific source interval, given by the raw offsets of its
@ -112,7 +117,7 @@ parseErrorAtRegion
:: Int -- ^ Start offset :: Int -- ^ Start offset
-> Int -- ^ End end offset -> Int -- ^ End end offset
-> String -- ^ Error message -> String -- ^ Error message
-> CustomErr -> HledgerParseErrorData
parseErrorAtRegion startOffset endOffset msg = parseErrorAtRegion startOffset endOffset msg =
if startOffset < endOffset if startOffset < endOffset
then ErrorFailAt startOffset endOffset msg 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 -- This function could be extended to return the result of 'p', but we don't
-- currently need this. -- currently need this.
excerpt_ :: MonadParsec CustomErr Text m => m a -> m SourceExcerpt excerpt_ :: MonadParsec HledgerParseErrorData Text m => m a -> m SourceExcerpt
excerpt_ p = do excerpt_ p = do
offset <- getOffset offset <- getOffset
(!txt, _) <- match p (!txt, _) <- match p
@ -164,8 +169,8 @@ excerpt_ p = do
reparseExcerpt reparseExcerpt
:: Monad m :: Monad m
=> SourceExcerpt => SourceExcerpt
-> ParsecT CustomErr Text m a -> ParsecT HledgerParseErrorData Text m a
-> ParsecT CustomErr Text m a -> ParsecT HledgerParseErrorData Text m a
reparseExcerpt (SourceExcerpt offset txt) p = do reparseExcerpt (SourceExcerpt offset txt) p = do
(_, res) <- lift $ runParserT' p (offsetInitialState offset txt) (_, res) <- lift $ runParserT' p (offsetInitialState offset txt)
case res of 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 -- 0 (that is, the beginning of the source file), which is the
-- case for 'ParseErrorBundle's returned from 'runParserT'. -- case for 'ParseErrorBundle's returned from 'runParserT'.
customErrorBundlePretty :: ParseErrorBundle Text CustomErr -> String customErrorBundlePretty :: HledgerParseErrors -> String
customErrorBundlePretty errBundle = customErrorBundlePretty errBundle =
let errBundle' = errBundle { bundleErrors = let errBundle' = errBundle { bundleErrors =
NE.sortWith errorOffset $ -- megaparsec requires that the list of errors be sorted by their offsets NE.sortWith errorOffset $ -- megaparsec requires that the list of errors be sorted by their offsets
@ -219,7 +224,7 @@ customErrorBundlePretty errBundle =
where where
finalizeCustomError finalizeCustomError
:: ParseError Text CustomErr -> NE.NonEmpty (ParseError Text CustomErr) :: ParseError Text HledgerParseErrorData -> NE.NonEmpty (ParseError Text HledgerParseErrorData)
finalizeCustomError err = case findCustomError err of finalizeCustomError err = case findCustomError err of
Nothing -> pure err Nothing -> pure err
@ -233,7 +238,7 @@ customErrorBundlePretty errBundle =
-- If any custom errors are present, arbitrarily take the first one -- If any custom errors are present, arbitrarily take the first one
-- (since only one custom error should be used at a time). -- (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 findCustomError err = case err of
FancyError _ errSet -> FancyError _ errSet ->
finds (\case {ErrorCustom e -> Just e; _ -> Nothing}) errSet finds (\case {ErrorCustom e -> Just e; _ -> Nothing}) errSet
@ -280,7 +285,7 @@ data FinalParseError' e
| FinalBundleWithStack (FinalParseErrorBundle' e) | FinalBundleWithStack (FinalParseErrorBundle' e)
deriving (Show) deriving (Show)
type FinalParseError = FinalParseError' CustomErr type FinalParseError = FinalParseError' HledgerParseErrorData
-- We need a 'Monoid' instance for 'FinalParseError' so that 'ExceptT -- We need a 'Monoid' instance for 'FinalParseError' so that 'ExceptT
-- FinalParseError m' is an instance of Alternative and MonadPlus, which -- FinalParseError m' is an instance of Alternative and MonadPlus, which
@ -308,7 +313,7 @@ data FinalParseErrorBundle' e = FinalParseErrorBundle'
, includeFileStack :: [FilePath] , includeFileStack :: [FilePath]
} deriving (Show) } deriving (Show)
type FinalParseErrorBundle = FinalParseErrorBundle' CustomErr type FinalParseErrorBundle = FinalParseErrorBundle' HledgerParseErrorData
--- * Constructing and throwing final parse errors --- * 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 -- 'attachSource' must be used on a "final" parse error before it can be
-- pretty-printed. -- pretty-printed.
finalErrorBundlePretty :: FinalParseErrorBundle' CustomErr -> String finalErrorBundlePretty :: FinalParseErrorBundle' HledgerParseErrorData -> String
finalErrorBundlePretty bundle = finalErrorBundlePretty bundle =
concatMap showIncludeFilepath (includeFileStack bundle) concatMap showIncludeFilepath (includeFileStack bundle)
<> customErrorBundlePretty (finalErrorBundle bundle) <> customErrorBundlePretty (finalErrorBundle bundle)
@ -391,11 +396,11 @@ attachSource filePath sourceText finalParseError = case finalParseError of
parseIncludeFile parseIncludeFile
:: Monad m :: Monad m
=> StateT st (ParsecT CustomErr Text (ExceptT FinalParseError m)) a => StateT st (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m)) a
-> st -> st
-> FilePath -> FilePath
-> Text -> Text
-> StateT st (ParsecT CustomErr Text (ExceptT FinalParseError m)) a -> StateT st (ParsecT HledgerParseErrorData Text (ExceptT FinalParseError m)) a
parseIncludeFile parser initialState filepath text = parseIncludeFile parser initialState filepath text =
catchError parser' handler catchError parser' handler
where where

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

@ -14,8 +14,6 @@ import Data.Either (partitionEithers)
import Data.List (isPrefixOf, find) import Data.List (isPrefixOf, find)
import Control.Monad (forM_) import Control.Monad (forM_)
import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Explicit
import System.Exit (exitFailure)
import System.IO (stderr, hPutStrLn)
import Hledger import Hledger
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
@ -120,4 +118,4 @@ runCheck copts@CliOpts{rawopts_} j (check,args) = do
case results of case results of
Right () -> return () 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 where
import qualified Data.Text as T
import Hledger import Hledger
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
import Control.Monad (forM) import Control.Monad (forM)
import Data.List (groupBy) import Data.List (groupBy)
import Text.Printf (printf)
import Data.Maybe (fromMaybe)
journalCheckOrdereddates :: CliOpts -> Journal -> Either String () journalCheckOrdereddates :: CliOpts -> Journal -> Either String ()
journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do
@ -26,17 +27,17 @@ journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do
case checkTransactions compare ts of case checkTransactions compare ts of
FoldAcc{fa_previous=Nothing} -> Right () FoldAcc{fa_previous=Nothing} -> Right ()
FoldAcc{fa_error=Nothing} -> Right () FoldAcc{fa_error=Nothing} -> Right ()
FoldAcc{fa_error=Just error, fa_previous=Just previous} -> do FoldAcc{fa_error=Just t, fa_previous=Just tprev} -> Left $ printf
let "%s:%d:%d-%d:\n%stransaction date%s is out of order with previous transaction date %s%s"
datestr = if date2_ ropts then "2" else "" f l col col2 ex datenum tprevdate oruniquestr
uniquestr = if checkunique then " and/or not unique" else "" where
positionstr = sourcePosPairPretty $ tsourcepos error (f,l,mcols,ex) = makeTransactionErrorExcerpt t finderrcols
txn1str = T.unpack . linesPrepend (T.pack " ") $ showTransaction previous col = maybe 0 fst mcols
txn2str = T.unpack . linesPrepend2 (T.pack "> ") (T.pack " ") $ showTransaction error col2 = maybe 0 (fromMaybe 0 . snd) mcols
Left $ finderrcols _t = Just (1, Just 10)
"transaction date" <> datestr <> " is out of order" datenum = if date2_ ropts then "2" else ""
<> uniquestr <> "\nat " <> positionstr <> ":\n\n" tprevdate = show $ (if date2_ ropts then transactionDate2 else tdate) tprev
<> txn1str <> txn2str oruniquestr = if checkunique then ", and/or not unique" else "" -- XXX still used ?
data FoldAcc a b = FoldAcc data FoldAcc a b = FoldAcc
{ fa_error :: Maybe a { 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 qualified Data.Text as T
import Hledger import Hledger
import Text.Printf (printf) import Text.Printf (printf)
import Data.Maybe (fromMaybe)
-- | Check that all the journal's postings are to accounts with a unique leaf name. -- | 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. -- Otherwise, return an error message for the first offending posting.
@ -38,16 +39,22 @@ journalLeafAndFullAccountNames = map leafAndAccountName . journalAccountNamesUse
where leafAndAccountName a = (accountLeafName a, a) where leafAndAccountName a = (accountLeafName a, a)
checkposting :: [(Text,[AccountName])] -> Posting -> Either String () checkposting :: [(Text,[AccountName])] -> Posting -> Either String ()
checkposting leafandfullnames Posting{paccount,ptransaction} = checkposting leafandfullnames p@Posting{paccount=a} =
case [lf | lf@(_,fs) <- leafandfullnames, paccount `elem` fs] of case [lf | lf@(_,fs) <- leafandfullnames, a `elem` fs] of
[] -> Right () [] -> Right ()
(leaf,fulls):_ -> Left $ printf (leaf,fulls):_ -> Left $ printf
"account leaf names are not unique\nleaf name \"%s\" appears in account names: %s%s" "%s:%d:%d-%d:\n%saccount leaf name \"%s\" is not unique\nit is used in account names: %s"
leaf f l col col2 ex leaf accts
(T.intercalate ", " $ map (("\""<>).(<>"\"")) fulls) where
(case ptransaction of -- t = fromMaybe nulltransaction ptransaction -- XXX sloppy
Nothing -> "" col = maybe 0 fst mcols
Just t -> printf "\nseen in \"%s\" in transaction at: %s\n\n%s" col2 = maybe 0 (fromMaybe 0 . snd) mcols
paccount (f,l,mcols,ex) = makePostingErrorExcerpt p finderrcols
(sourcePosPairPretty $ tsourcepos t) where
(linesPrepend "> " . (<>"\n") . textChomp $ showTransaction t) :: String) 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 (a) 1
(b:a) 1 (b:a) 1
$ hledger -f- check uniqueleafnames $ hledger -f- check uniqueleafnames
>2 /account leaf names are not unique/ >2 /account leaf name .* is not unique/
>=1 >=1

8
hledger/test/csv.test
View File

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

314
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 [flycheck-hledger-10]: https://github.com/DamienCassou/flycheck-hledger/pull/10
[#1436]: https://github.com/simonmichael/hledger/issues/1436 [#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 ## 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) - [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 - [x] phase 13: decide/add error ids/explanations/web pages ? not needed
- [ ] phase 14: support Language Server Protocol & Visual Code - [ ] 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 ## Current journal errors
<!-- to update: erase the below then C-u M-! ./showall --> <!-- 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: hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./accounts.j:4:6-6:
| | 2022-01-01
3 | 1 4 | (a) 1
| ^ | ^
unexpected newline undeclared account "a"
expecting date separator or digit
``` ```
### 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 ### 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: transaction:
2022-01-01 2022-01-01
a 0 = 1 a 0 = 1
@ -139,112 +126,99 @@ commodity:
calculated: 0 calculated: 0
asserted: 1 asserted: 1
difference: 1 difference: 1
``` ```
### accounts
```
Error: undeclared account "a"
in transaction at: /Users/simon/src/hledger/hledger/test/errors/./accounts.j:3-4
### 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 2022-01-01
(a) 1 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 ### commodities
``` ```
Error: undeclared commodity "A" hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./commodities.j:6:21-23:
in transaction at: /Users/simon/src/hledger/hledger/test/errors/./commodities.j:5-6 | 2022-01-01
6 | (a) A 1
2022-01-01 | ^^^
(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 ### ordereddates
``` ```
Error: transaction date is out of order hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./ordereddates.j:10:1-10:
at /Users/simon/src/hledger/hledger/test/errors/./ordereddates.j:10-11: 10 | 2022-01-01 p
| ^^^^^^^^^^
2022-01-02 p | (a) 1
(a) 1 transaction date is out of order with previous transaction date 2022-01-02
> 2022-01-01 p
(a) 1
``` ```
### 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 ### uniqueleafnames
``` ```
Error: account leaf names are not unique hledger: Error: /Users/simon/src/hledger/hledger/test/errors/./uniqueleafnames.j:9:8-8:
leaf name "c" appears in account names: "a:c", "b:c" | 2022-01-01 p
seen in "a:c" in transaction at: /Users/simon/src/hledger/hledger/test/errors/./uniqueleafnames.j:8-9 9 | (a:c) 1
| ^
> 2022-01-01 p account leaf name "c" is not unique
> (a:c) 1 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 $ hledger bal -M -b 2016-10 -e 2017-02 -f - --forecast=20160801-foobar
> >
>2 >2
hledger: could not parse forecast period : 1:10: hledger: Error: could not parse forecast period : 1:10:
| |
1 | 20160801-foobar 1 | 20160801-foobar
| ^ | ^

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

@ -8,7 +8,7 @@
# 1. # 1.
$ hledger -f - print $ hledger -f - print
>2 >2
hledger: -:1:5: hledger: Error: -:1:5:
| |
1 | 2018 1 | 2018
| ^ | ^
@ -123,7 +123,7 @@ $ hledger -f- print
b 1B b 1B
$ hledger -f- print $ hledger -f- print
>2 >2
hledger: -:1-3 hledger: Error: -:1-3
could not balance this transaction: could not balance this transaction:
real postings all have the same sign real postings all have the same sign
2020-01-01 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 Assets:Checking 101 A
Unrealized PnL Unrealized PnL
>>>2 >>>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. 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. For example, "--cost --value=end,<commodity> --infer-market-prices", where commodity is the one that was used to pay for the investment.
>>>=1 >>>=1