From d47f7f5ed8cb3485d47201c695647492ae5a8499 Mon Sep 17 00:00:00 2001 From: Evan Silberman Date: Thu, 6 Feb 2025 14:39:17 -0800 Subject: [PATCH] Track wikilinks with a class instead of a title Once upon a time the only metadata element for links in Pandoc's AST was a title, and it was hijacked to track certain links as having originated in the wikilink syntax. Now we have Attrs and we can use a class to handle wikilinks instead. Requires coordinated changes to commonmark-hs. --- src/Text/Pandoc/Readers/Markdown.hs | 3 +- src/Text/Pandoc/Readers/MediaWiki.hs | 4 +-- src/Text/Pandoc/Readers/Vimwiki.hs | 23 ++++-------- src/Text/Pandoc/Writers/Markdown/Inline.hs | 2 +- test/Tests/Readers/Markdown.hs | 15 ++++---- test/command/2649.md | 7 ++-- test/command/8853.md | 2 +- test/command/wikilinks_title_after_pipe.md | 32 ++++++++--------- test/command/wikilinks_title_before_pipe.md | 32 ++++++++--------- test/mediawiki-reader.native | 28 +++++++++------ test/vimwiki-reader.native | 40 ++++++++++----------- 11 files changed, 94 insertions(+), 94 deletions(-) diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 3d4c5da455d1..a0fd682df78c 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -1859,6 +1859,7 @@ wikilink :: PandocMonad m => (Attr -> Text -> Text -> Inlines -> Inlines) -> MarkdownParser m (F Inlines) wikilink constructor = do + let attr = (mempty, ["wikilink"], mempty) titleAfter <- (True <$ guardEnabled Ext_wikilinks_title_after_pipe) <|> (False <$ guardEnabled Ext_wikilinks_title_before_pipe) @@ -1871,7 +1872,7 @@ wikilink constructor = do | titleAfter -> (T.drop 1 after, before) | otherwise -> (before, T.drop 1 after) guard $ T.all (`notElem` ['\n','\r','\f','\t']) url - return . pure . constructor nullAttr url "wikilink" $ + return . pure . constructor attr url "" $ B.text $ fromEntities title link :: PandocMonad m => MarkdownParser m (F Inlines) diff --git a/src/Text/Pandoc/Readers/MediaWiki.hs b/src/Text/Pandoc/Readers/MediaWiki.hs index e7d6ea4cbf8d..628aaa5dca02 100644 --- a/src/Text/Pandoc/Readers/MediaWiki.hs +++ b/src/Text/Pandoc/Readers/MediaWiki.hs @@ -667,7 +667,7 @@ internalLink = try $ do sym "]]" -- see #8525: linktrail <- B.text <$> manyChar (satisfy (\c -> isLetter c && not (isCJK c))) - let link = B.link (addUnderscores pagename) "wikilink" (label <> linktrail) + let link = B.linkWith (mempty, ["wikilink"], mempty) (addUnderscores pagename) (stringify label) (label <> linktrail) if "Category:" `T.isPrefixOf` pagename then do updateState $ \st -> st{ mwCategoryLinks = link : mwCategoryLinks st } @@ -699,7 +699,7 @@ inlinesBetween start end = emph :: PandocMonad m => MWParser m Inlines emph = B.emph <$> inlinesBetween start end where start = sym "''" - end = try $ notFollowedBy' (() <$ strong) >> sym "''" + end = try $ notFollowedBy' (() <$ strong) >> ((sym "''") <|> void newline) strong :: PandocMonad m => MWParser m Inlines strong = B.strong <$> inlinesBetween start end diff --git a/src/Text/Pandoc/Readers/Vimwiki.hs b/src/Text/Pandoc/Readers/Vimwiki.hs index e8be03c2893d..818f5b601b4d 100644 --- a/src/Text/Pandoc/Readers/Vimwiki.hs +++ b/src/Text/Pandoc/Readers/Vimwiki.hs @@ -56,15 +56,7 @@ import Data.Text (Text) import qualified Data.Text as T import Safe (lastMay) import Text.Pandoc.Builder (Blocks, Inlines, fromList, toList, trimInlines) -import qualified Text.Pandoc.Builder as B (blockQuote, bulletList, code, - codeBlockWith, definitionList, - displayMath, divWith, emph, - headerWith, horizontalRule, image, - imageWith, link, math, orderedList, - para, plain, setMeta, simpleTable, - softbreak, space, spanWith, str, - strikeout, strong, subscript, - superscript) +import qualified Text.Pandoc.Builder as B import Text.Pandoc.Class.PandocMonad (PandocMonad (..)) import Text.Pandoc.Definition (Attr, Block (BulletList, OrderedList), Inline (Space), ListNumberDelim (..), @@ -555,17 +547,14 @@ link = try $ do then do url <- manyTillChar anyChar $ char '|' lab <- mconcat <$> manyTill inline (string "]]") - let tit = if isURI url - then "" - else "wikilink" - return $ B.link (procLink url) tit lab + return $ B.linkWith (attr url) (procLink url) "" lab else do manyTill anyChar (string "]]") -- not using try here because [[hell]o]] is not rendered as a link in vimwiki - let tit = if isURI contents - then "" - else "wikilink" - return $ B.link (procLink contents) tit (B.str contents) + return $ B.linkWith (attr contents) (procLink contents) "" (B.str contents) + where + attr t | isURI t = B.nullAttr + | otherwise = (mempty, ["wikilink"], mempty) image :: PandocMonad m => VwParser m Inlines image = try $ do diff --git a/src/Text/Pandoc/Writers/Markdown/Inline.hs b/src/Text/Pandoc/Writers/Markdown/Inline.hs index 948932fc5fca..da04e4b5efe6 100644 --- a/src/Text/Pandoc/Writers/Markdown/Inline.hs +++ b/src/Text/Pandoc/Writers/Markdown/Inline.hs @@ -649,7 +649,7 @@ inlineToMarkdown opts lnk@(Link attr@(ident,classes,kvs) txt (src, tit)) = do case txt of [Str s] | escapeURI s == srcSuffix -> True _ -> False - let useWikilink = tit == "wikilink" && + let useWikilink = "wikilink" `elem` classes && (isEnabled Ext_wikilinks_title_after_pipe opts || isEnabled Ext_wikilinks_title_before_pipe opts) let useRefLinks = writerReferenceLinks opts && not useAuto diff --git a/test/Tests/Readers/Markdown.hs b/test/Tests/Readers/Markdown.hs index 3a6ffd0d3068..aded6c663ef9 100644 --- a/test/Tests/Readers/Markdown.hs +++ b/test/Tests/Readers/Markdown.hs @@ -58,6 +58,9 @@ autolinkWith :: Attr -> String -> Inlines autolinkWith attr s = linkWith attr s' "" (str s') where s' = T.pack s +wikilink :: Attr +wikilink = (mempty, ["wikilink"], mempty) + bareLinkTests :: [(Text, Inlines)] bareLinkTests = [ ("http://google.com is a search engine.", @@ -312,22 +315,22 @@ tests = [ testGroup "inline code" , testGroup "Github wiki links" [ test markdownGH "autolink" $ "[[https://example.org]]" =?> - para (link "https://example.org" "wikilink" (str "https://example.org")) + para (linkWith wikilink "https://example.org" "" (str "https://example.org")) , test markdownGH "link with title" $ "[[title|https://example.org]]" =?> - para (link "https://example.org" "wikilink" (str "title")) + para (linkWith wikilink "https://example.org" "" (str "title")) , test markdownGH "bad link with title" $ "[[title|random string]]" =?> - para (link "random string" "wikilink" (str "title")) + para (linkWith wikilink "random string" "" (str "title")) , test markdownGH "autolink not being a link" $ "[[Name of page]]" =?> - para (link "Name of page" "wikilink" (text "Name of page")) + para (linkWith wikilink "Name of page" "" (text "Name of page")) , test markdownGH "autolink not being a link with a square bracket" $ "[[Name of ]page]]" =?> - para (link "Name of ]page" "wikilink" (text "Name of ]page")) + para (linkWith wikilink "Name of ]page" "" (text "Name of ]page")) , test markdownGH "link with inline start should be a link" $ "[[t`i*t_le|https://example.org]]" =?> - para (link "https://example.org" "wikilink" (str "t`i*t_le")) + para (linkWith wikilink "https://example.org" "" (str "t`i*t_le")) ] , testGroup "Headers" [ "blank line before header" =: diff --git a/test/command/2649.md b/test/command/2649.md index 8258b9c10bea..ae825d059aee 100644 --- a/test/command/2649.md +++ b/test/command/2649.md @@ -90,19 +90,20 @@

1

Sébastien Loeb

+class="wikilink" title="Sébastien Loeb">Sébastien Loeb

78

2

Sébastien Ogier

+class="wikilink" title="Sébastien Ogier">Sébastien +Ogier

38

10

Hannu Mikkola

+class="wikilink" title="Hannu Mikkola">Hannu Mikkola

18

diff --git a/test/command/8853.md b/test/command/8853.md index 75fed4675c61..bf15b5792d7b 100644 --- a/test/command/8853.md +++ b/test/command/8853.md @@ -2,5 +2,5 @@ % pandoc -f markdown+wikilinks_title_after_pipe --wrap=none [[hi]] and ![[hi]] ^D -

hi and hi

+

hi and hi

``` diff --git a/test/command/wikilinks_title_after_pipe.md b/test/command/wikilinks_title_after_pipe.md index 201e5ee1a287..43c27450d571 100644 --- a/test/command/wikilinks_title_after_pipe.md +++ b/test/command/wikilinks_title_after_pipe.md @@ -11,20 +11,20 @@ [[name of page|title]] ^D -

https://example.org

-

title

-

name of page

-

title

+

https://example.org

+

title

+

name of page

+

title

``` ## Writer ``` % pandoc -t commonmark_x+wikilinks_title_after_pipe -f html -

https://example.org

-

title

-

Home

-

Title

+

https://example.org

+

title

+

Home

+

Title

^D [[https://example.org]] @@ -48,20 +48,20 @@ [[name of page|title]] ^D -

https://example.org

-

title

-

name of page

-

title

+

https://example.org

+

title

+

name of page

+

title

``` ## Writer ``` % pandoc -t markdown+wikilinks_title_after_pipe -f html -

https://example.org

-

title

-

Home

-

Title

+

https://example.org

+

title

+

Home

+

Title

^D [[https://example.org]] diff --git a/test/command/wikilinks_title_before_pipe.md b/test/command/wikilinks_title_before_pipe.md index 51bb009bfaaf..86680a3fb853 100644 --- a/test/command/wikilinks_title_before_pipe.md +++ b/test/command/wikilinks_title_before_pipe.md @@ -12,20 +12,20 @@ [[Title|Name of page]] ^D -

https://example.org

-

title

-

Name of page

-

Title

+

https://example.org

+

title

+

Name of page

+

Title

``` ## Writer ``` % pandoc -t commonmark_x+wikilinks_title_before_pipe -f html -

https://example.org

-

title

-

Home

-

Title

+

https://example.org

+

title

+

Home

+

Title

^D [[https://example.org]] @@ -59,20 +59,20 @@ [[Title|Name of page]] ^D -

https://example.org

-

title

-

Name of page

-

Title

+

https://example.org

+

title

+

Name of page

+

Title

``` ## Writer ``` % pandoc -t markdown+wikilinks_title_before_pipe -f html -

https://example.org

-

title

-

Home

-

Title

+

https://example.org

+

title

+

Home

+

Title

^D [[https://example.org]] diff --git a/test/mediawiki-reader.native b/test/mediawiki-reader.native index 9b35bd7eebce..7532528b1b86 100644 --- a/test/mediawiki-reader.native +++ b/test/mediawiki-reader.native @@ -254,40 +254,46 @@ Pandoc [ Str "internal" , Space , Str "links" ] , Para [ Link - ( "" , [] , [] ) [ Str "Help" ] ( "Help" , "wikilink" ) + ( "" , [ "wikilink" ] , [] ) + [ Str "Help" ] + ( "Help" , "Help" ) ] , Para [ Link - ( "" , [] , [] ) + ( "" , [ "wikilink" ] , [] ) [ Str "the" , Space , Str "help" , Space , Str "page" ] - ( "Help" , "wikilink" ) + ( "Help" , "the help page" ) ] , Para [ Link - ( "" , [] , [] ) [ Str "Helpers" ] ( "Help" , "wikilink" ) + ( "" , [ "wikilink" ] , [] ) + [ Str "Helpers" ] + ( "Help" , "Help" ) ] , Para [ Link - ( "" , [] , [] ) [ Str "Help" ] ( "Help" , "wikilink" ) + ( "" , [ "wikilink" ] , [] ) + [ Str "Help" ] + ( "Help" , "Help" ) , Str "ers" ] , Para [ Link - ( "" , [] , [] ) + ( "" , [ "wikilink" ] , [] ) [ Str "Contents" ] - ( "Help:Contents" , "wikilink" ) + ( "Help:Contents" , "Contents" ) ] , Para [ Link - ( "" , [] , [] ) + ( "" , [ "wikilink" ] , [] ) [ Str "#My" , Space , Str "anchor" ] - ( "#My_anchor" , "wikilink" ) + ( "#My_anchor" , "#My anchor" ) ] , Para [ Link - ( "" , [] , [] ) + ( "" , [ "wikilink" ] , [] ) [ Str "and" , Space , Str "text" ] - ( "Page#with_anchor" , "wikilink" ) + ( "Page#with_anchor" , "and text" ) ] , Header 2 ( "images" , [] , [] ) [ Str "images" ] , Figure diff --git a/test/vimwiki-reader.native b/test/vimwiki-reader.native index b8f853ce0ca0..047df1de1182 100644 --- a/test/vimwiki-reader.native +++ b/test/vimwiki-reader.native @@ -559,13 +559,13 @@ Pandoc [ Str "internal" , Space , Str "links" ] , Para [ Link - ( "" , [] , [] ) + ( "" , [ "wikilink" ] , [] ) [ Str "This is a link" ] - ( "This is a link" , "wikilink" ) + ( "This is a link" , "" ) ] , Para [ Link - ( "" , [] , [] ) + ( "" , [ "wikilink" ] , [] ) [ Str "Description" , Space , Str "of" @@ -574,27 +574,27 @@ Pandoc , Space , Str "link" ] - ( "This is a link source" , "wikilink" ) + ( "This is a link source" , "" ) ] , Para [ Link - ( "" , [] , [] ) + ( "" , [ "wikilink" ] , [] ) [ Str "projects/Important Project 1" ] - ( "projects/Important Project 1" , "wikilink" ) + ( "projects/Important Project 1" , "" ) , SoftBreak , Link - ( "" , [] , [] ) + ( "" , [ "wikilink" ] , [] ) [ Str "../index" ] - ( "../index" , "wikilink" ) + ( "../index" , "" ) , SoftBreak , Link - ( "" , [] , [] ) + ( "" , [ "wikilink" ] , [] ) [ Str "Other" , Space , Str "files" ] - ( "a subdirectory/" , "wikilink" ) + ( "a subdirectory/" , "" ) ] , Para [ Link - ( "" , [] , [] ) + ( "" , [ "wikilink" ] , [] ) [ Str "try" , Space , Str "me" @@ -607,11 +607,11 @@ Pandoc , Space , Str "anchors" ] - ( "#tag-one" , "wikilink" ) + ( "#tag-one" , "" ) ] , Para [ Link - ( "" , [] , [] ) + ( "" , [ "wikilink" ] , [] ) [ Str "try" , Space , Str "me" @@ -624,11 +624,11 @@ Pandoc , Space , Str "anchors" ] - ( "#block quotes" , "wikilink" ) + ( "#block quotes" , "" ) ] , Para [ Link - ( "" , [] , [] ) + ( "" , [ "wikilink" ] , [] ) [ Str "try" , Space , Str "me" @@ -641,19 +641,19 @@ Pandoc , Space , Str "anchors" ] - ( "#strong" , "wikilink" ) + ( "#strong" , "" ) ] , Para [ Link - ( "" , [] , [] ) + ( "" , [ "wikilink" ] , [] ) [ Str "Tasks" , Space , Str "for" , Space , Str "tomorrow" ] - ( "Todo List#Tomorrow" , "wikilink" ) + ( "Todo List#Tomorrow" , "" ) ] , Para [ Link - ( "" , [] , [] ) + ( "" , [ "wikilink" ] , [] ) [ Str "diary:2017-05-01" ] - ( "diary/2017-05-01" , "wikilink" ) + ( "diary/2017-05-01" , "" ) ] , Para [ Link