@@ -50,6 +50,7 @@ import Text.Pandoc.Options (ReaderOptions(readerParseRaw, readerTrace)
50 Ext_native_divs, Ext_native_spans))
50 Ext_native_divs, Ext_native_spans))
51import Text.Pandoc.Parsing hiding ((<|>))
51import Text.Pandoc.Parsing hiding ((<|>))
52import Text.Pandoc.Walk
52import Text.Pandoc.Walk
53+import qualified Data.Map as M
53import Data.Maybe ( fromMaybe, isJust)
54import Data.Maybe ( fromMaybe, isJust)
54import Data.List ( intercalate, isInfixOf, isPrefixOf, isSuffixOf )
55import Data.List ( intercalate, isInfixOf, isPrefixOf, isSuffixOf )
55import Data.Char ( isDigit )
56import Data.Char ( isDigit )
@@ -75,8 +76,9 @@ readHtml :: ReaderOptions -- ^ Reader options
75 -> Either PandocError Pandoc
76 -> Either PandocError Pandoc
76readHtml opts inp =
77readHtml opts inp =
77 mapLeft (ParseFailure . getError) . flip runReader def $
78 mapLeft (ParseFailure . getError) . flip runReader def $
78− runParserT parseDoc (HTMLState def{ stateOptions = opts } [] Nothing)
80+ (HTMLState def{ stateOptions = opts } [] Nothing [] M.empty)
79− "source" tags
81+ "source" tags
80 where tags = stripPrefixes . canonicalizeTags $
82 where tags = stripPrefixes . canonicalizeTags $
81 parseTagsOptions parseOptions{ optTagPosition = True } inp
83 parseTagsOptions parseOptions{ optTagPosition = True } inp
82 parseDoc = do
84 parseDoc = do
@@ -101,7 +103,9 @@ data HTMLState =
101 HTMLState
103 HTMLState
102 { parserState :: ParserState,
104 { parserState :: ParserState,
103 noteTable :: [(String, Blocks)],
105 noteTable :: [(String, Blocks)],
104− baseHref :: Maybe String
106+ baseHref :: Maybe String,
107+ identifiers :: [String],
108+ headerMap :: M.Map Inlines String
107data HTMLLocal = HTMLLocal { quoteContext :: QuoteContext
111data HTMLLocal = HTMLLocal { quoteContext :: QuoteContext
@@ -398,9 +402,10 @@ pHeader = try $ do
398 let ident = fromMaybe "" $ lookup "id" attr
402 let ident = fromMaybe "" $ lookup "id" attr
399 let classes = maybe [] words $ lookup "class" attr
403 let classes = maybe [] words $ lookup "class" attr
400 let keyvals = [(k,v) | (k,v) <- attr, k /= "class", k /= "id"]
404 let keyvals = [(k,v) | (k,v) <- attr, k /= "class", k /= "id"]
405+ attr' <- registerHeader (ident, classes, keyvals) contents
401 return $ if bodyTitle
406 return $ if bodyTitle
402 then mempty -- skip a representation of the title in the body
407 then mempty -- skip a representation of the title in the body
403− else B.headerWith (ident, classes, keyvals) level contents
408+ else B.headerWith attr' level contents
405pHrule :: TagParser Blocks
410pHrule :: TagParser Blocks
406pHrule = do
411pHrule = do
@@ -983,6 +988,14 @@ isSpace _ = False
984-- Instances
989-- Instances
991+instance HasIdentifierList HTMLState where
992+ extractIdentifierList = identifiers
993+ updateIdentifierList f s = s{ identifiers = f (identifiers s) }
995+instance HasHeaderMap HTMLState where
996+ extractHeaderMap = headerMap
997+ updateHeaderMap f s = s{ headerMap = f (headerMap s) }
986-- This signature should be more general
999-- This signature should be more general
987-- MonadReader HTMLLocal m => HasQuoteContext st m
1000-- MonadReader HTMLLocal m => HasQuoteContext st m
988instance HasQuoteContext st (Reader HTMLLocal) where
1001instance HasQuoteContext st (Reader HTMLLocal) where
@@ -992,9 +1005,6 @@ instance HasQuoteContext st (Reader HTMLLocal) where
992instance HasReaderOptions HTMLState where
1005instance HasReaderOptions HTMLState where
993 extractReaderOptions = extractReaderOptions . parserState
1006 extractReaderOptions = extractReaderOptions . parserState
995−instance Default HTMLState where
996− def = HTMLState def [] Nothing
998instance HasMeta HTMLState where
1008instance HasMeta HTMLState where
999 setMeta s b st = st {parserState = setMeta s b $ parserState st}
1009 setMeta s b st = st {parserState = setMeta s b $ parserState st}
1000 deleteMeta s st = st {parserState = deleteMeta s $ parserState st}
1010 deleteMeta s st = st {parserState = deleteMeta s $ parserState st}