aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Text/Pandoc/Readers/MediaWiki.hs103
-rw-r--r--tests/mediawiki-reader.native6
-rw-r--r--tests/mediawiki-reader.wiki12
3 files changed, 80 insertions, 41 deletions
diff --git a/src/Text/Pandoc/Readers/MediaWiki.hs b/src/Text/Pandoc/Readers/MediaWiki.hs
index 73017b49c..3c83f60f9 100644
--- a/src/Text/Pandoc/Readers/MediaWiki.hs
+++ b/src/Text/Pandoc/Readers/MediaWiki.hs
@@ -110,16 +110,27 @@ htmlComment :: MWParser ()
htmlComment = () <$ htmlTag isCommentTag
inlinesInTags :: String -> MWParser Inlines
-inlinesInTags tag = trimInlines . mconcat <$> try
- (manyTill inline (htmlTag (~== TagClose tag)))
+inlinesInTags tag = try $ do
+ (_,raw) <- htmlTag (~== TagOpen tag [])
+ if '/' `elem` raw -- self-closing tag
+ then return mempty
+ else trimInlines . mconcat <$>
+ manyTill inline (htmlTag (~== TagClose tag))
blocksInTags :: String -> MWParser Blocks
-blocksInTags tag = mconcat <$> try
- (manyTill block (htmlTag (~== TagClose tag)))
+blocksInTags tag = try $ do
+ (_,raw) <- htmlTag (~== TagOpen tag [])
+ if '/' `elem` raw -- self-closing tag
+ then return mempty
+ else mconcat <$> manyTill block (htmlTag (~== TagClose tag))
charsInTags :: String -> MWParser [Char]
-charsInTags tag = innerText . parseTags <$> try
- (manyTill anyChar (htmlTag (~== TagClose tag)))
+charsInTags tag = try $ do
+ (_,raw) <- htmlTag (~== TagOpen tag [])
+ if '/' `elem` raw -- self-closing tag
+ then return ""
+ else innerText . parseTags <$>
+ manyTill anyChar (htmlTag (~== TagClose tag))
--
-- main parser
@@ -146,8 +157,6 @@ block = mempty <$ skipMany1 blankline
<|> mempty <$ try (spaces *> htmlComment)
<|> preformatted
<|> blockTag
- <|> pTag
- <|> blockHtml
<|> template
<|> para
@@ -164,16 +173,17 @@ template = B.rawBlock "mediawiki" <$> doublebrackets
blockTag :: MWParser Blocks
blockTag = do
- (TagOpen t attrs, raw) <- htmlTag (\x -> isBlockTag' x && isTagOpen x)
- case t of
- "blockquote" -> B.blockQuote <$> blocksInTags "blockquote"
- "pre" -> B.codeBlock . trimCode <$> charsInTags "pre"
- "syntaxhighlight" -> syntaxhighlight attrs
- "haskell" -> B.codeBlockWith ("",["haskell"],[]) . trimCode <$>
- charsInTags "haskell"
- "gallery" -> blocksInTags "gallery"
- "p" -> return mempty
- _ -> return $ B.rawBlock "html" raw
+ (tag, _) <- lookAhead $ htmlTag isBlockTag'
+ case tag of
+ TagOpen "blockquote" _ -> B.blockQuote <$> blocksInTags "blockquote"
+ TagOpen "pre" _ -> B.codeBlock . trimCode <$> charsInTags "pre"
+ TagOpen "syntaxhighlight" attrs -> syntaxhighlight attrs
+ TagOpen "haskell" _ -> B.codeBlockWith ("",["haskell"],[]) . trimCode <$>
+ charsInTags "haskell"
+ TagOpen "gallery" _ -> blocksInTags "gallery"
+ TagOpen "p" _ -> mempty <$ htmlTag (~== tag)
+ TagClose "p" -> mempty <$ htmlTag (~== tag)
+ _ -> B.rawBlock "html" . snd <$> htmlTag (~== tag)
trimCode :: String -> String
trimCode ('\n':xs) = stripTrailingNewlines xs
@@ -189,13 +199,6 @@ syntaxhighlight attrs = try $ do
contents <- charsInTags "syntaxhighlight"
return $ B.codeBlockWith ("",classes,kvs) $ trimCode contents
--- We can just skip pTags, as contents will be treated as paragraphs
-pTag :: MWParser Blocks
-pTag = mempty <$ (htmlTag (\t -> t ~== TagOpen "p" [] || t ~== TagClose "p"))
-
-blockHtml :: MWParser Blocks
-blockHtml = (B.rawBlock "html" . snd <$> htmlTag isBlockTag)
-
hrule :: MWParser Blocks
hrule = B.horizontalRule <$ try (string "----" *> many (char '-') *> newline)
@@ -271,7 +274,7 @@ anyListStart = char '*'
<|> char ';'
li :: MWParser Blocks
-li = htmlTag (~== TagOpen "li" []) *>
+li = lookAhead (htmlTag (~== TagOpen "li" [])) *>
(firstParaToPlain <$> blocksInTags "li") <* spaces
listItem :: Char -> MWParser Blocks
@@ -317,6 +320,7 @@ inline = whitespace
<|> str
<|> strong
<|> emph
+ <|> internalLink
<|> externalLink
<|> inlineTag
<|> B.singleton <$> charRef
@@ -336,21 +340,25 @@ variable = B.rawInline "mediawiki" <$> triplebrackets
inlineTag :: MWParser Inlines
inlineTag = do
- (TagOpen t _, raw) <- htmlTag (\x -> isInlineTag x && isTagOpen x)
- case t of
- "nowiki" -> B.text . fromEntities <$> try
- (manyTill anyChar (htmlTag (~== TagClose "nowiki")))
- "br" -> B.linebreak <$
- (optional (htmlTag (~== TagClose "br")) *> optional blankline)
- "strike" -> B.strikeout <$> inlinesInTags "strike"
- "del" -> B.strikeout <$> inlinesInTags "del"
- "sub" -> B.subscript <$> inlinesInTags "sub"
- "sup" -> B.superscript <$> inlinesInTags "sup"
- "math" -> B.math <$> charsInTags "math"
- "code" -> B.code <$> charsInTags "code"
- "tt" -> B.code <$> charsInTags "tt"
- "hask" -> B.codeWith ("",["haskell"],[]) <$> charsInTags "hask"
- _ -> return $ B.rawInline "html" raw
+ (tag, _) <- lookAhead $ htmlTag isInlineTag
+ case tag of
+ TagOpen "nowiki" _ -> try $ do
+ (_,raw) <- htmlTag (~== tag)
+ if '/' `elem` raw
+ then return mempty
+ else B.text . fromEntities <$>
+ manyTill anyChar (htmlTag (~== TagClose "nowiki"))
+ TagOpen "br" _ -> B.linebreak <$ (htmlTag (~== TagOpen "br" []) -- will get /> too
+ *> optional blankline)
+ TagOpen "strike" _ -> B.strikeout <$> inlinesInTags "strike"
+ TagOpen "del" _ -> B.strikeout <$> inlinesInTags "del"
+ TagOpen "sub" _ -> B.subscript <$> inlinesInTags "sub"
+ TagOpen "sup" _ -> B.superscript <$> inlinesInTags "sup"
+ TagOpen "math" _ -> B.math <$> charsInTags "math"
+ TagOpen "code" _ -> B.code <$> charsInTags "code"
+ TagOpen "tt" _ -> B.code <$> charsInTags "tt"
+ TagOpen "hask" _ -> B.codeWith ("",["haskell"],[]) <$> charsInTags "hask"
+ _ -> B.rawInline "html" . snd <$> htmlTag (~== tag)
special :: MWParser Inlines
special = B.str <$> count 1 (notFollowedBy' (htmlTag isBlockTag') *>
@@ -368,6 +376,19 @@ endline = () <$ try (newline <*
notFollowedBy' hrule <*
notFollowedBy anyListStart)
+internalLink :: MWParser Inlines
+internalLink = try $ do
+ string "[["
+ pagename <- unwords . words <$> many (noneOf "|]")
+ label <- option (B.text pagename) $ char '|' *>
+ ( (mconcat <$> many1 (notFollowedBy (char ']') *> inline))
+ -- the "pipe trick"
+ -- [[Help:Contents|] -> "Contents"
+ <|> (return $ B.text $ drop 1 $ dropWhile (/=':') pagename) )
+ string "]]"
+ linktrail <- B.text <$> many (char '\'' <|> letter)
+ return $ B.link pagename "wikilink" (label <> linktrail)
+
externalLink :: MWParser Inlines
externalLink = try $ do
char '['
diff --git a/tests/mediawiki-reader.native b/tests/mediawiki-reader.native
index 059e73fab..c38736cd4 100644
--- a/tests/mediawiki-reader.native
+++ b/tests/mediawiki-reader.native
@@ -74,6 +74,12 @@ Pandoc (Meta {docTitle = [], docAuthors = [], docDate = []})
,Para [Link [Str "http://johnmacfarlane.net/pandoc/"] ("http://johnmacfarlane.net/pandoc/","")]
,Para [Link [Str "1"] ("http://google.com",""),Space,Link [Str "2"] ("http://yahoo.com","")]
,Para [Link [Str "email",Space,Str "me"] ("mailto:info@example.org","")]
+,Header 2 [Str "internal",Space,Str "links"]
+,Para [Link [Str "Help"] ("Help","wikilink")]
+,Para [Link [Str "the",Space,Str "help",Space,Str "page"] ("Help","wikilink")]
+,Para [Link [Str "Helpers"] ("Help","wikilink")]
+,Para [Link [Str "Help"] ("Help","wikilink"),Str "ers"]
+,Para [Link [Str "Contents"] ("Help:Contents","wikilink")]
,Header 2 [Str "lists"]
,BulletList
[[Plain [Str "Start",Space,Str "each",Space,Str "line"]]
diff --git a/tests/mediawiki-reader.wiki b/tests/mediawiki-reader.wiki
index 7653d4f3b..34fe8ade5 100644
--- a/tests/mediawiki-reader.wiki
+++ b/tests/mediawiki-reader.wiki
@@ -147,6 +147,18 @@ http://johnmacfarlane.net/pandoc/
[mailto:info@example.org email me]
+== internal links ==
+
+[[Help]]
+
+[[Help|the help page]]
+
+[[Help]]ers
+
+[[Help]]<nowiki/>ers
+
+[[Help:Contents|]]
+
== lists ==
* Start each line