aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Parsing.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Parsing.hs')
-rw-r--r--src/Text/Pandoc/Parsing.hs31
1 files changed, 22 insertions, 9 deletions
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index e4113f31f..a6a1a83dd 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -83,6 +83,7 @@ module Text.Pandoc.Parsing ( anyLine,
HasMacros (..),
HasLogMessages (..),
HasLastStrPosition (..),
+ HasIncludeFiles (..),
defaultParserState,
HeaderType (..),
ParserContext (..),
@@ -1008,6 +1009,9 @@ class HasReaderOptions st where
-- default
getOption f = (f . extractReaderOptions) <$> getState
+instance HasReaderOptions ParserState where
+ extractReaderOptions = stateOptions
+
class HasQuoteContext st m where
getQuoteContext :: (Stream s m t) => ParsecT s st m QuoteContext
withQuoteContext :: QuoteContext -> ParsecT s st m a -> ParsecT s st m a
@@ -1023,9 +1027,6 @@ instance Monad m => HasQuoteContext ParserState m where
setState newState { stateQuoteContext = oldQuoteContext }
return result
-instance HasReaderOptions ParserState where
- extractReaderOptions = stateOptions
-
class HasHeaderMap st where
extractHeaderMap :: st -> M.Map Inlines String
updateHeaderMap :: (M.Map Inlines String -> M.Map Inlines String) ->
@@ -1067,6 +1068,16 @@ instance HasLogMessages ParserState where
addLogMessage msg st = st{ stateLogMessages = msg : stateLogMessages st }
getLogMessages st = reverse $ stateLogMessages st
+class HasIncludeFiles st where
+ getIncludeFiles :: st -> [String]
+ addIncludeFile :: String -> st -> st
+ dropLatestIncludeFile :: st -> st
+
+instance HasIncludeFiles ParserState where
+ getIncludeFiles = stateContainers
+ addIncludeFile f s = s{ stateContainers = f : stateContainers s }
+ dropLatestIncludeFile s = s { stateContainers = drop 1 $ stateContainers s }
+
defaultParserState :: ParserState
defaultParserState =
ParserState { stateOptions = def,
@@ -1358,17 +1369,19 @@ extractIdClass (ident, cls, kvs) = (ident', cls', kvs')
Nothing -> cls
kvs' = filter (\(k,_) -> k /= "id" || k /= "class") kvs
-insertIncludedFile :: PandocMonad m
- => ParserT String ParserState m Blocks
+-- | Parse content of include file as blocks. Circular includes result in an
+-- @PandocParseError@.
+insertIncludedFile :: (PandocMonad m, HasIncludeFiles st)
+ => ParserT String st m Blocks
-> [FilePath] -> FilePath
- -> ParserT String ParserState m Blocks
+ -> ParserT String st m Blocks
insertIncludedFile blocks dirs f = do
oldPos <- getPosition
oldInput <- getInput
- containers <- stateContainers <$> getState
+ containers <- getIncludeFiles <$> getState
when (f `elem` containers) $
throwError $ PandocParseError $ "Include file loop at " ++ show oldPos
- updateState $ \s -> s{ stateContainers = f : stateContainers s }
+ updateState $ addIncludeFile f
mbcontents <- readFileFromDirs dirs f
contents <- case mbcontents of
Just s -> return s
@@ -1380,5 +1393,5 @@ insertIncludedFile blocks dirs f = do
bs <- blocks
setInput oldInput
setPosition oldPos
- updateState $ \s -> s{ stateContainers = drop 1 $ stateContainers s }
+ updateState dropLatestIncludeFile
return bs