diff options
Diffstat (limited to 'src/Text/Pandoc/Parsing.hs')
| -rw-r--r-- | src/Text/Pandoc/Parsing.hs | 57 |
1 files changed, 46 insertions, 11 deletions
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index e90f64c5b..ce2523d12 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -36,6 +36,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA A utility library with parsers used in pandoc readers. -} module Text.Pandoc.Parsing ( anyLine, + anyLineNewline, many1Till, notFollowedBy', oneOfStrings, @@ -83,6 +84,7 @@ module Text.Pandoc.Parsing ( anyLine, HasMacros (..), HasLogMessages (..), HasLastStrPosition (..), + HasIncludeFiles (..), defaultParserState, HeaderType (..), ParserContext (..), @@ -120,6 +122,7 @@ module Text.Pandoc.Parsing ( anyLine, (<+?>), extractIdClass, insertIncludedFile, + insertIncludedFileF, -- * Re-exports from Text.Pandoc.Parsec Stream, runParser, @@ -253,6 +256,10 @@ anyLine = do return this _ -> mzero +-- | Parse any line, include the final newline in the output +anyLineNewline :: Stream [Char] m Char => ParserT [Char] st m [Char] +anyLineNewline = (++ "\n") <$> anyLine + -- | Like @manyTill@, but reads at least one item. many1Till :: Stream s m t => ParserT s st m a @@ -1008,6 +1015,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 +1033,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 +1074,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 +1375,18 @@ 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 - -> [FilePath] -> FilePath - -> ParserT String ParserState m Blocks -insertIncludedFile blocks dirs f = do +insertIncludedFile' :: (PandocMonad m, HasIncludeFiles st, + Functor mf, Applicative mf, Monad mf) + => ParserT String st m (mf Blocks) + -> [FilePath] -> FilePath + -> ParserT String st m (mf 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 +1398,22 @@ insertIncludedFile blocks dirs f = do bs <- blocks setInput oldInput setPosition oldPos - updateState $ \s -> s{ stateContainers = tail $ stateContainers s } + updateState dropLatestIncludeFile return bs + +-- | 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 st m Blocks +insertIncludedFile blocks dirs f = + runIdentity <$> insertIncludedFile' (Identity <$> blocks) dirs f + +-- | Parse content of include file as future blocks. Circular includes result in +-- an @PandocParseError@. +insertIncludedFileF :: (PandocMonad m, HasIncludeFiles st) + => ParserT String st m (Future st Blocks) + -> [FilePath] -> FilePath + -> ParserT String st m (Future st Blocks) +insertIncludedFileF = insertIncludedFile' |