Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

Parsing: Added HasLogMessages, logMessage, reportLogMessages.

Browse source 
We need to do logging by updating parser state, or we'll get
inappropriate and repeated log messages when there is parser
backtracking.

See #3447.
This commit is contained in:
John MacFarlane 2017-02-17 12:56:07 +01:00
parent 05cf034cc3
commit 38daf9de68
1 changed files with 25 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
src/Text/Pandoc/Parsing.hs
View file

@ -73,11 +73,14 @@ module Text.Pandoc.Parsing ( anyLine,
guardDisabled, guardDisabled,
updateLastStrPos, updateLastStrPos,
notAfterString, notAfterString,
logMessage,
reportLogMessages,
ParserState (..), ParserState (..),
HasReaderOptions (..), HasReaderOptions (..),
HasHeaderMap (..), HasHeaderMap (..),
HasIdentifierList (..), HasIdentifierList (..),
HasMacros (..), HasMacros (..),
HasLogMessages (..),
HasLastStrPosition (..), HasLastStrPosition (..),
defaultParserState, defaultParserState,
HeaderType (..), HeaderType (..),
@ -934,6 +937,7 @@ data ParserState = ParserState
stateCaption :: Maybe Inlines, -- ^ Caption in current environment stateCaption :: Maybe Inlines, -- ^ Caption in current environment
stateInHtmlBlock :: Maybe String, -- ^ Tag type of HTML block being parsed stateInHtmlBlock :: Maybe String, -- ^ Tag type of HTML block being parsed
stateContainers :: [String], -- ^ parent include files stateContainers :: [String], -- ^ parent include files
stateLogMessages :: [LogMessage], -- ^ log messages
stateMarkdownAttribute :: Bool -- ^ True if in markdown=1 context stateMarkdownAttribute :: Bool -- ^ True if in markdown=1 context
} }
@ -1003,6 +1007,14 @@ instance HasLastStrPosition ParserState where
setLastStrPos pos st = st{ stateLastStrPos = Just pos } setLastStrPos pos st = st{ stateLastStrPos = Just pos }
getLastStrPos st = stateLastStrPos st getLastStrPos st = stateLastStrPos st
class HasLogMessages st where
addLogMessage :: LogMessage -> st -> st
getLogMessages :: st -> [LogMessage]
instance HasLogMessages ParserState where
addLogMessage msg st = st{ stateLogMessages = msg : stateLogMessages st }
getLogMessages st = reverse $ stateLogMessages st
defaultParserState :: ParserState defaultParserState :: ParserState
defaultParserState = defaultParserState =
ParserState { stateOptions = def, ParserState { stateOptions = def,
@ -1030,9 +1042,22 @@ defaultParserState =
stateCaption = Nothing, stateCaption = Nothing,
stateInHtmlBlock = Nothing, stateInHtmlBlock = Nothing,
stateContainers = [], stateContainers = [],
stateLogMessages = [],
stateMarkdownAttribute = False stateMarkdownAttribute = False
} }
-- | Add a log message.
logMessage :: (Stream s m a, HasLogMessages st)
=> LogMessage -> ParserT s st m ()
logMessage msg = updateState (addLogMessage msg)
-- | Report all the accumulated log messages, according to verbosity level.
reportLogMessages :: (PandocMonad m, Stream s m a, HasLogMessages st)
=> ParserT s st m ()
reportLogMessages = do
msgs <- getLogMessages <$> getState
mapM_ report msgs
-- | Succeed only if the extension is enabled. -- | Succeed only if the extension is enabled.
guardEnabled :: (Stream s m a, HasReaderOptions st) => Extension -> ParserT s st m () guardEnabled :: (Stream s m a, HasReaderOptions st) => Extension -> ParserT s st m ()
guardEnabled ext = getOption readerExtensions >>= guard . extensionEnabled ext guardEnabled ext = getOption readerExtensions >>= guard . extensionEnabled ext