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,
updateLastStrPos,
notAfterString,
logMessage,
reportLogMessages,
ParserState (..),
HasReaderOptions (..),
HasHeaderMap (..),
HasIdentifierList (..),
HasMacros (..),
HasLogMessages (..),
HasLastStrPosition (..),
defaultParserState,
HeaderType (..),
@ -934,6 +937,7 @@ data ParserState = ParserState
stateCaption :: Maybe Inlines, -- ^ Caption in current environment
stateInHtmlBlock :: Maybe String, -- ^ Tag type of HTML block being parsed
stateContainers :: [String], -- ^ parent include files
stateLogMessages :: [LogMessage], -- ^ log messages
stateMarkdownAttribute :: Bool -- ^ True if in markdown=1 context
}
@ -1003,6 +1007,14 @@ instance HasLastStrPosition ParserState where
setLastStrPos pos st = st{ stateLastStrPos = Just pos }
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 { stateOptions = def,
@ -1030,9 +1042,22 @@ defaultParserState =
stateCaption = Nothing,
stateInHtmlBlock = Nothing,
stateContainers = [],
stateLogMessages = [],
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.
guardEnabled :: (Stream s m a, HasReaderOptions st) => Extension -> ParserT s st m ()
guardEnabled ext = getOption readerExtensions >>= guard . extensionEnabled ext