ref: rename CustomErr -> HledgerParseErrorData
Verbose, but use every chance to clarify the complicated parse error situation.
This commit is contained in:
Simon Michael
parent
07502bd41c
commit
2f28e1b0a7
@ -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 (ParseErrorBundle Text HledgerParseErrorData) (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 (ParseErrorBundle Text HledgerParseErrorData) Text)
|
||||
|
||||
-- | A safe version of fixSmartDateStr.
|
||||
fixSmartDateStrEither :: Day -> Text -> Either (ParseErrorBundle Text CustomErr) Text
|
||||
fixSmartDateStrEither :: Day -> Text -> Either (ParseErrorBundle Text HledgerParseErrorData) Text
|
||||
fixSmartDateStrEither d = fmap showDate . fixSmartDateStrEither' d
|
||||
|
||||
fixSmartDateStrEither'
|
||||
:: Day -> Text -> Either (ParseErrorBundle Text CustomErr) Day
|
||||
:: Day -> Text -> Either (ParseErrorBundle Text HledgerParseErrorData) Day
|
||||
fixSmartDateStrEither' d s = case parsewith smartdateonly (T.toLower s) of
|
||||
Right sd -> Right $ fixSmartDate d sd
|
||||
Left e -> Left e
|
||||
|
||||
@ -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
|
||||
|
||||
@ -271,7 +271,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)
|
||||
@ -855,7 +855,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 (ParseErrorBundle Text HledgerParseErrorData) Amount
|
||||
amountp'' s = runParser (evalStateT (amountp <* eof) nulljournal) "" (T.pack s)
|
||||
|
||||
-- | Parse an amount from a string, or get an error.
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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 (ParseErrorBundle Text HledgerParseErrorData) 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 (ParseErrorBundle Text HledgerParseErrorData) a))
|
||||
runErroringJournalParser p t =
|
||||
runExceptT $ runParserT (evalStateT p nulljournal) "" t
|
||||
rejp = runErroringJournalParser
|
||||
|
||||
@ -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 (ParseErrorBundle Text HledgerParseErrorData) 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 (ParseErrorBundle Text HledgerParseErrorData) 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' #-}
|
||||
|
||||
|
||||
@ -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")
|
||||
|
||||
@ -8,7 +8,7 @@
|
||||
|
||||
module Text.Megaparsec.Custom (
|
||||
-- * Custom parse error type
|
||||
CustomErr,
|
||||
HledgerParseErrorData,
|
||||
|
||||
-- * Failing with an arbitrary source position
|
||||
parseErrorAt,
|
||||
@ -60,7 +60,7 @@ import Text.Megaparsec
|
||||
-- | A custom error type for the parser. The type is specialized to
|
||||
-- parsers of 'Text' streams.
|
||||
|
||||
data CustomErr
|
||||
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,7 +69,7 @@ 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)
|
||||
|
||||
-- We require an 'Ord' instance for 'CustomError' so that they may be
|
||||
@ -77,13 +77,13 @@ data CustomErr
|
||||
-- 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 +98,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 +112,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 +142,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 +164,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 +210,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 :: ParseErrorBundle Text HledgerParseErrorData -> String
|
||||
customErrorBundlePretty errBundle =
|
||||
let errBundle' = errBundle { bundleErrors =
|
||||
NE.sortWith errorOffset $ -- megaparsec requires that the list of errors be sorted by their offsets
|
||||
@ -219,7 +219,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 +233,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 +280,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 +308,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 +347,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 +391,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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user