diff options
| -rw-r--r-- | src/Text/Pandoc/Parsing.hs | 32 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Markdown.hs | 30 |
2 files changed, 34 insertions, 28 deletions
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index c16d5bb1d..701b2ef84 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -75,6 +75,7 @@ module Text.Pandoc.Parsing ( (>>~), SubstTable, Key (..), toKey, + registerHeader, smartPunctuation, withQuoteContext, singleQuoteStart, @@ -151,6 +152,7 @@ where import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Builder (Blocks, Inlines, rawBlock, HasMeta(..)) +import qualified Text.Pandoc.Builder as B import Text.Pandoc.XML (fromEntities) import qualified Text.Pandoc.UTF8 as UTF8 (putStrLn) import Text.Parsec @@ -162,11 +164,13 @@ import Text.Pandoc.Shared import qualified Data.Map as M import Text.TeXMath.Macros (applyMacros, Macro, parseMacroDefinitions) import Text.Pandoc.Compat.TagSoupEntity ( lookupEntity ) +import Text.Pandoc.Asciify (toAsciiChar) import Data.Default import qualified Data.Set as Set import Control.Monad.Reader import Control.Applicative ((*>), (<*), (<$), liftA2) import Data.Monoid +import Data.Maybe (catMaybes) type Parser t s = Parsec t s @@ -886,6 +890,34 @@ type KeyTable = M.Map Key Target type SubstTable = M.Map Key Inlines +-- | Add header to the list of headers in state, together +-- with its associated identifier. If the identifier is null +-- and the auto_identifers extension is set, generate a new +-- unique identifier, and update the list of identifiers +-- in state. +registerHeader :: Attr -> Inlines -> Parser s ParserState Attr +registerHeader (ident,classes,kvs) header' = do + ids <- stateIdentifiers `fmap` getState + exts <- getOption readerExtensions + let insert' = M.insertWith (\_new old -> old) + if null ident && Ext_auto_identifiers `Set.member` exts + then do + let id' = uniqueIdent (B.toList header') ids + let id'' = if Ext_ascii_identifiers `Set.member` exts + then catMaybes $ map toAsciiChar id' + else id' + updateState $ \st -> st{ + stateIdentifiers = if id' == id'' + then id' : ids + else id' : id'' : ids, + stateHeaders = insert' header' id' $ stateHeaders st } + return (id'',classes,kvs) + else do + unless (null ident) $ + updateState $ \st -> st{ + stateHeaders = insert' header' ident $ stateHeaders st } + return (ident,classes,kvs) + -- | Fail unless we're in "smart typography" mode. failUnlessSmart :: Parser [tok] ParserState () failUnlessSmart = getOption readerSmart >>= guard diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 658335202..267b30032 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -49,7 +49,6 @@ import Text.Pandoc.Builder (Inlines, Blocks, trimInlines, (<>)) import Text.Pandoc.Options import Text.Pandoc.Shared import Text.Pandoc.XML (fromEntities) -import Text.Pandoc.Asciify (toAsciiChar) import Text.Pandoc.Parsing hiding (tableWith) import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXBlock ) import Text.Pandoc.Readers.HTML ( htmlTag, htmlInBalanced, isInlineTag, isBlockTag, @@ -471,31 +470,6 @@ block = choice [ mempty <$ blanklines header :: MarkdownParser (F Blocks) header = setextHeader <|> atxHeader <?> "header" --- returns unique identifier -addToHeaderList :: Attr -> F Inlines -> MarkdownParser Attr -addToHeaderList (ident,classes,kvs) text = do - let header' = runF text defaultParserState - exts <- getOption readerExtensions - let insert' = M.insertWith (\_new old -> old) - if null ident && Ext_auto_identifiers `Set.member` exts - then do - ids <- stateIdentifiers `fmap` getState - let id' = uniqueIdent (B.toList header') ids - let id'' = if Ext_ascii_identifiers `Set.member` exts - then catMaybes $ map toAsciiChar id' - else id' - updateState $ \st -> st{ - stateIdentifiers = if id' == id'' - then id' : ids - else id' : id'' : ids, - stateHeaders = insert' header' id' $ stateHeaders st } - return (id'',classes,kvs) - else do - unless (null ident) $ - updateState $ \st -> st{ - stateHeaders = insert' header' ident $ stateHeaders st } - return (ident,classes,kvs) - atxHeader :: MarkdownParser (F Blocks) atxHeader = try $ do level <- many1 (char '#') >>= return . length @@ -504,7 +478,7 @@ atxHeader = try $ do skipSpaces text <- trimInlinesF . mconcat <$> many (notFollowedBy atxClosing >> inline) attr <- atxClosing - attr' <- addToHeaderList attr text + attr' <- registerHeader attr (runF text defaultParserState) return $ B.headerWith attr' level <$> text atxClosing :: MarkdownParser Attr @@ -543,7 +517,7 @@ setextHeader = try $ do many (char underlineChar) blanklines let level = (fromMaybe 0 $ findIndex (== underlineChar) setextHChars) + 1 - attr' <- addToHeaderList attr text + attr' <- registerHeader attr (runF text defaultParserState) return $ B.headerWith attr' level <$> text -- |