Parsing: introduce HasIncludeFiles
type class
The `insertIncludeFile` function is generalized to work with all parser states which are instances of that class.
This commit is contained in:
parent
7a17c3eb9f
commit
5ff6108b4c
1 changed files with 22 additions and 9 deletions
|
@ -83,6 +83,7 @@ module Text.Pandoc.Parsing ( anyLine,
|
||||||
HasMacros (..),
|
HasMacros (..),
|
||||||
HasLogMessages (..),
|
HasLogMessages (..),
|
||||||
HasLastStrPosition (..),
|
HasLastStrPosition (..),
|
||||||
|
HasIncludeFiles (..),
|
||||||
defaultParserState,
|
defaultParserState,
|
||||||
HeaderType (..),
|
HeaderType (..),
|
||||||
ParserContext (..),
|
ParserContext (..),
|
||||||
|
@ -1008,6 +1009,9 @@ class HasReaderOptions st where
|
||||||
-- default
|
-- default
|
||||||
getOption f = (f . extractReaderOptions) <$> getState
|
getOption f = (f . extractReaderOptions) <$> getState
|
||||||
|
|
||||||
|
instance HasReaderOptions ParserState where
|
||||||
|
extractReaderOptions = stateOptions
|
||||||
|
|
||||||
class HasQuoteContext st m where
|
class HasQuoteContext st m where
|
||||||
getQuoteContext :: (Stream s m t) => ParsecT s st m QuoteContext
|
getQuoteContext :: (Stream s m t) => ParsecT s st m QuoteContext
|
||||||
withQuoteContext :: QuoteContext -> ParsecT s st m a -> ParsecT s st m a
|
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 }
|
setState newState { stateQuoteContext = oldQuoteContext }
|
||||||
return result
|
return result
|
||||||
|
|
||||||
instance HasReaderOptions ParserState where
|
|
||||||
extractReaderOptions = stateOptions
|
|
||||||
|
|
||||||
class HasHeaderMap st where
|
class HasHeaderMap st where
|
||||||
extractHeaderMap :: st -> M.Map Inlines String
|
extractHeaderMap :: st -> M.Map Inlines String
|
||||||
updateHeaderMap :: (M.Map Inlines String -> 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 }
|
addLogMessage msg st = st{ stateLogMessages = msg : stateLogMessages st }
|
||||||
getLogMessages st = reverse $ 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
|
||||||
defaultParserState =
|
defaultParserState =
|
||||||
ParserState { stateOptions = def,
|
ParserState { stateOptions = def,
|
||||||
|
@ -1358,17 +1369,19 @@ extractIdClass (ident, cls, kvs) = (ident', cls', kvs')
|
||||||
Nothing -> cls
|
Nothing -> cls
|
||||||
kvs' = filter (\(k,_) -> k /= "id" || k /= "class") kvs
|
kvs' = filter (\(k,_) -> k /= "id" || k /= "class") kvs
|
||||||
|
|
||||||
insertIncludedFile :: PandocMonad m
|
-- | Parse content of include file as blocks. Circular includes result in an
|
||||||
=> ParserT String ParserState m Blocks
|
-- @PandocParseError@.
|
||||||
|
insertIncludedFile :: (PandocMonad m, HasIncludeFiles st)
|
||||||
|
=> ParserT String st m Blocks
|
||||||
-> [FilePath] -> FilePath
|
-> [FilePath] -> FilePath
|
||||||
-> ParserT String ParserState m Blocks
|
-> ParserT String st m Blocks
|
||||||
insertIncludedFile blocks dirs f = do
|
insertIncludedFile blocks dirs f = do
|
||||||
oldPos <- getPosition
|
oldPos <- getPosition
|
||||||
oldInput <- getInput
|
oldInput <- getInput
|
||||||
containers <- stateContainers <$> getState
|
containers <- getIncludeFiles <$> getState
|
||||||
when (f `elem` containers) $
|
when (f `elem` containers) $
|
||||||
throwError $ PandocParseError $ "Include file loop at " ++ show oldPos
|
throwError $ PandocParseError $ "Include file loop at " ++ show oldPos
|
||||||
updateState $ \s -> s{ stateContainers = f : stateContainers s }
|
updateState $ addIncludeFile f
|
||||||
mbcontents <- readFileFromDirs dirs f
|
mbcontents <- readFileFromDirs dirs f
|
||||||
contents <- case mbcontents of
|
contents <- case mbcontents of
|
||||||
Just s -> return s
|
Just s -> return s
|
||||||
|
@ -1380,5 +1393,5 @@ insertIncludedFile blocks dirs f = do
|
||||||
bs <- blocks
|
bs <- blocks
|
||||||
setInput oldInput
|
setInput oldInput
|
||||||
setPosition oldPos
|
setPosition oldPos
|
||||||
updateState $ \s -> s{ stateContainers = drop 1 $ stateContainers s }
|
updateState dropLatestIncludeFile
|
||||||
return bs
|
return bs
|
||||||
|
|
Loading…
Reference in a new issue