diff options
Diffstat (limited to 'src/Text/Pandoc/Parsing.hs')
-rw-r--r-- | src/Text/Pandoc/Parsing.hs | 31 |
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 |