aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn MacFarlane <[email protected]>2022-10-18 12:51:12 -0700
committerJohn MacFarlane <[email protected]>2022-10-18 12:51:12 -0700
commitff22116426af532fe758b5918436c7dc3df6e87f (patch)
tree13a31b738ec90f447d0c0c03dbd6296c44d28302
parenteff82cfe4de44a111250ce9ce3ecee2fd4d99924 (diff)
Revert "Markdown reader: avoid duplicate ids with auto_identifiers."
This reverts commit eff82cfe4de44a111250ce9ce3ecee2fd4d99924.
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs33
-rw-r--r--src/Text/Pandoc/Shared.hs26
-rw-r--r--test/command/6384.md8
-rw-r--r--test/command/section-divs.md6
4 files changed, 28 insertions, 45 deletions
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index b31f4792b..773119fa3 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -368,7 +368,7 @@ referenceKey = try $ do
addKvs <- option [] $ guardEnabled Ext_mmd_link_attributes
>> many (try $ spnl >> keyValAttr)
blanklines
- let attr'@(ident,_,_) = extractIdClass $ foldl' (\x f -> f x) attr addKvs
+ let attr' = extractIdClass $ foldl' (\x f -> f x) attr addKvs
target = (escapeURI $ trimr src, tit)
st <- getState
let oldkeys = stateKeys st
@@ -380,7 +380,6 @@ referenceKey = try $ do
-- or section. See #3701.
logMessage $ DuplicateLinkReference raw pos
_ -> return ()
- registerIdentifier ident
updateState $ \s -> s { stateKeys = M.insert key (target, attr') oldkeys }
return $ return mempty
@@ -703,11 +702,10 @@ codeBlockFenced = try $ do
(try $ do
blockDelimiter (== c) (Just size)
blanklines)
- case rawattr of
- Left syn -> return $ return $ B.rawBlock syn contents
- Right attr@(ident,_,_) -> do
- registerIdentifier ident
- return $ return $ B.codeBlockWith attr contents
+ return $ return $
+ case rawattr of
+ Left syn -> B.rawBlock syn contents
+ Right attr -> B.codeBlockWith attr contents
-- correctly handle github language identifiers
toLanguageId :: Text -> Text
@@ -1607,11 +1605,10 @@ code = try $ do
<|>
(Right <$> option ("",[],[])
(guardEnabled Ext_inline_code_attributes >> try attributes))
- case rawattr of
- Left syn -> return $ return $ B.rawInline syn $! result
- Right attr@(ident,_,_) -> do
- registerIdentifier ident
- return $ return $ B.codeWith attr $! result
+ return $ return $
+ case rawattr of
+ Left syn -> B.rawInline syn $! result
+ Right attr -> B.codeWith attr $! result
math :: PandocMonad m => MarkdownParser m (F Inlines)
math = (return . B.displayMath <$> (mathDisplay >>= applyMacros))
@@ -1827,8 +1824,7 @@ bracketedSpan = do
guardEnabled Ext_bracketed_spans
try $ do
(lab,_) <- reference
- attr@(ident,_,_) <- attributes
- registerIdentifier ident
+ attr <- attributes
return $ wrapSpan attr <$> lab
-- | Given an @Attr@ value, this returns a function to wrap the contents
@@ -1867,9 +1863,8 @@ regLink constructor lab = try $ do
rebase <- option False (True <$ guardEnabled Ext_rebase_relative_paths)
pos <- getPosition
let src' = if rebase then rebasePath pos src else src
- attr@(ident,_,_) <- option nullAttr $
+ attr <- option nullAttr $
guardEnabled Ext_link_attributes >> attributes
- registerIdentifier ident
return $ constructor attr src' tit <$> lab
-- a link like [this][ref] or [this][] or [this]
@@ -2039,7 +2034,6 @@ spanHtml = do
(TagOpen _ attrs, _) <- htmlTag (~== TagOpen ("span" :: Text) [])
contents <- mconcat <$> manyTill inline (htmlTag (~== TagClose ("span" :: Text)))
let ident = fromMaybe "" $ lookup "id" attrs
- registerIdentifier ident
let classes = maybe [] T.words $ lookup "class" attrs
let keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]
return $ wrapSpan (ident, classes, keyvals) <$> contents
@@ -2061,7 +2055,6 @@ divHtml = do
then do
updateState $ \st -> st{ stateInHtmlBlock = oldInHtmlBlock }
let ident = fromMaybe "" $ lookup "id" attrs
- registerIdentifier ident
let classes = maybe [] T.words $ lookup "class" attrs
let keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]
return $ B.divWith (ident, classes, keyvals) <$> contents
@@ -2075,9 +2068,7 @@ divFenced = do
string ":::"
skipMany (char ':')
skipMany spaceChar
- attribs@(ident,_,_) <- attributes
- <|> ((\x -> ("",[x],[])) <$> many1Char nonspaceChar)
- registerIdentifier ident
+ attribs <- attributes <|> ((\x -> ("",[x],[])) <$> many1Char nonspaceChar)
skipMany spaceChar
skipMany (char ':')
blankline
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index a7408b151..2b93b18f4 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -562,7 +562,7 @@ makeSections numbering mbBaseLevel bs =
let attr = ("",classes,kvs')
return $
Div divattr (Header level' attr title' : sectionContents') : rest'
- go (Div divattr@(dident,dclasses,dkvs) (Header level hattr title':ys) : xs)
+ go (Div divattr@(dident,dclasses,_) (Header level hattr title':ys) : xs)
| all (\case
Header level' _ _ -> level' > level
_ -> True) ys
@@ -573,15 +573,9 @@ makeSections numbering mbBaseLevel bs =
rest <- go xs
return $
case inner of
- [Div (dident',dclasses'@("section":_),dkvs')
- (Header lev (_,hcs,hkvs) ils : zs)]
- -> Div (if T.null dident
- then dident'
- else dident, combineClasses dclasses' dclasses,
- combineKvs dkvs' dkvs)
- (Header lev (if T.null dident
- then "" -- dident' promoted to Div
- else dident', hcs, hkvs) ils : zs) : rest
+ [Div divattr'@(dident',_,_) zs]
+ | T.null dident || T.null dident' || dident == dident'
+ -> Div (combineAttr divattr' divattr) zs : rest
_ -> Div divattr inner : rest
go (Div attr xs : rest) = do
xs' <- go xs
@@ -591,15 +585,13 @@ makeSections numbering mbBaseLevel bs =
go (x:xs) = (x :) <$> go xs
go [] = return []
- combineClasses :: [T.Text] -> [T.Text] -> [T.Text]
- combineClasses classes1 classes2 =
- classes1 ++ [cl | cl <- classes2, cl `notElem` classes1]
-
- combineKvs :: [(T.Text, T.Text)] -> [(T.Text, T.Text)] -> [(T.Text, T.Text)]
- combineKvs kvs1 kvs2 =
+ combineAttr :: Attr -> Attr -> Attr
+ combineAttr (id1, classes1, kvs1) (id2, classes2, kvs2) =
+ (if T.null id1 then id2 else id1,
+ ordNub (classes1 ++ classes2),
foldr (\(k,v) kvs -> case lookup k kvs of
Nothing -> (k,v):kvs
- Just _ -> kvs) mempty (kvs1 ++ kvs2)
+ Just _ -> kvs) mempty (kvs1 ++ kvs2))
headerLtEq :: Int -> Block -> Bool
headerLtEq level (Header l _ _) = l <= level
diff --git a/test/command/6384.md b/test/command/6384.md
index 5873f433a..1be1c3e45 100644
--- a/test/command/6384.md
+++ b/test/command/6384.md
@@ -1,16 +1,16 @@
```
% pandoc --wrap=preserve --file-scope command/file1.txt command/file2.txt
^D
-<section id="command__file1.txt">
+<div id="command__file1.txt">
<h1 id="command__file1.txt__zed">Zed</h1>
<p><a href="bar">foo</a>
and <a href="#command__file1.txt__zed">Zed</a>
and <a href="#command__file2.txt__zed">other Zed</a>
and <a href="#command__file2.txt">other file</a>
and <a href="c.md#zed">foreign Zed</a></p>
-</section>
-<section id="command__file2.txt">
+</div>
+<div id="command__file2.txt">
<h2 id="command__file2.txt__zed">Zed</h2>
<p><a href="baz">foo</a></p>
-</section>
+</div>
```
diff --git a/test/command/section-divs.md b/test/command/section-divs.md
index d34ed3bd1..5ee28bba8 100644
--- a/test/command/section-divs.md
+++ b/test/command/section-divs.md
@@ -14,12 +14,12 @@ Ok
:::
^D
<section id="hi" class="level1">
-<h1 id="hi-1">Hi</h1>
+<h1>Hi</h1>
<section id="there" class="level2">
-<h2 id="there-1">there</h2>
+<h2>there</h2>
</section>
</section>
<section id="ok" class="level1">
-<h1 id="ok-1">Ok</h1>
+<h1>Ok</h1>
</section>
```