@@ -30,8 +30,6 @@ Conversion of mediawiki text to 'Pandoc' document.
3030-}
3131{-
3232TODO:
33−_ make tag parsers more efficient by parsing one HTML tag, checking it,
34− then...
3533_ support HTML lists
3634_ support list style attributes and start values in ol lists, also
3735 value attribute on li
@@ -85,23 +83,27 @@ spaceChars = " \n\t"
8583sym :: String -> MWParser ()
8684sym s = () <$ try (string s)
8785
86+isBlockTag' :: Tag String -> Bool
87+isBlockTag' tag@(TagOpen t _) = isBlockTag tag ||
88+ t == "haskell" || t == "syntaxhighlight"
89+isBlockTag' tag@(TagClose t) = isBlockTag tag ||
90+ t == "haskell" || t == "syntaxhighlight"
91+isBlockTag' tag = isBlockTag tag
92+
8893htmlComment :: MWParser ()
8994htmlComment = () <$ htmlTag isCommentTag
9095
9196inlinesInTags :: String -> MWParser Inlines
9297inlinesInTags tag = trimInlines . mconcat <$> try
93− (htmlTag (~== TagOpen tag []) *>
94− manyTill inline (htmlTag (~== TagClose tag)))
98+ (manyTill inline (htmlTag (~== TagClose tag)))
9599
96100blocksInTags :: String -> MWParser Blocks
97101blocksInTags tag = mconcat <$> try
98− (htmlTag (~== TagOpen tag []) *>
99− manyTill block (htmlTag (~== TagClose tag)))
102+ (manyTill block (htmlTag (~== TagClose tag)))
100103
101104charsInTags :: String -> MWParser [Char]
102105charsInTags tag = innerText . parseTags <$> try
103− (htmlTag (~== TagOpen tag []) *>
104− manyTill anyChar (htmlTag (~== TagClose tag)))
106+ (manyTill anyChar (htmlTag (~== TagClose tag)))
105107
106108--
107109-- main parser
@@ -119,18 +121,15 @@ parseMediaWiki = do
119121--
120122
121123block :: MWParser Blocks
122−block = header
124+block = mempty <$ skipMany1 blankline
125+ <|> header
123126 <|> hrule
124127 <|> bulletList
125128 <|> orderedList
126129 <|> definitionList
127130 <|> mempty <$ try (spaces *> htmlComment)
128131 <|> preformatted
129− <|> blockquote
130− <|> codeblock
131− <|> syntaxhighlight
132− <|> haskell
133− <|> mempty <$ skipMany1 blankline
132+ <|> blockTag
134133 <|> pTag
135134 <|> blockHtml
136135 <|> para
@@ -138,6 +137,32 @@ block = header
138137para :: MWParser Blocks
139138para = B.para . trimInlines . mconcat <$> many1 inline
140139
140+blockTag :: MWParser Blocks
141+blockTag = do
142+ (TagOpen t attrs, raw) <- htmlTag (\x -> isBlockTag' x && isTagOpen x)
143+ case t of
144+ "blockquote" -> B.blockQuote <$> blocksInTags "blockquote"
145+ "pre" -> B.codeBlock . trimCode <$> charsInTags "pre"
146+ "syntaxhighlight" -> syntaxhighlight attrs
147+ "haskell" -> B.codeBlockWith ("",["haskell"],[]) . trimCode <$>
148+ charsInTags "haskell"
149+ "p" -> return mempty
150+ _ -> return $ B.rawBlock "html" raw
151+
152+trimCode :: String -> String
153+trimCode ('\n':xs) = stripTrailingNewlines xs
154+trimCode xs = stripTrailingNewlines xs
155+
156+syntaxhighlight :: [Attribute String] -> MWParser Blocks
157+syntaxhighlight attrs = try $ do
158+ let mblang = lookup "lang" attrs
159+ let mbstart = lookup "start" attrs
160+ let mbline = lookup "line" attrs
161+ let classes = maybe [] (:[]) mblang ++ maybe [] (const ["numberLines"]) mbline
162+ let kvs = maybe [] (\x -> [("startFrom",x)]) mbstart
163+ contents <- charsInTags "syntaxhighlight"
164+ return $ B.codeBlockWith ("",classes,kvs) $ trimCode contents
165+
141166-- We can just skip pTags, as contents will be treated as paragraphs
142167pTag :: MWParser Blocks
143168pTag = mempty <$ (htmlTag (\t -> t ~== TagOpen "p" [] || t ~== TagClose "p"))
@@ -164,32 +189,6 @@ preformatted = do
164189 strToCode x = x
165190 B.para . bottomUp strToCode . mconcat <$> many1 inline'
166191
167−blockquote :: MWParser Blocks
168−blockquote = B.blockQuote <$> blocksInTags "blockquote"
169−
170−codeblock :: MWParser Blocks
171−codeblock = B.codeBlock . trimCode <$> charsInTags "pre"
172−
173−trimCode :: String -> String
174−trimCode ('\n':xs) = stripTrailingNewlines xs
175−trimCode xs = stripTrailingNewlines xs
176−
177−syntaxhighlight :: MWParser Blocks
178−syntaxhighlight = try $ do
179− (TagOpen _ attrs, _) <- lookAhead
180− $ htmlTag (~== TagOpen "syntaxhighlight" [])
181− let mblang = lookup "lang" attrs
182− let mbstart = lookup "start" attrs
183− let mbline = lookup "line" attrs
184− let classes = maybe [] (:[]) mblang ++ maybe [] (const ["numberLines"]) mbline
185− let kvs = maybe [] (\x -> [("startFrom",x)]) mbstart
186− contents <- charsInTags "syntaxhighlight"
187− return $ B.codeBlockWith ("",classes,kvs) $ trimCode contents
188−
189−haskell :: MWParser Blocks
190−haskell = B.codeBlockWith ("",["haskell"],[]) . trimCode <$>
191− charsInTags "haskell"
192−
193192header :: MWParser Blocks
194193header = try $ do
195194 col <- sourceColumn <$> getPosition
@@ -271,15 +270,8 @@ inline = whitespace
271270 <|> str
272271 <|> strong
273272 <|> emph
274− <|> nowiki
275− <|> linebreak
276273 <|> externalLink
277− <|> strikeout
278− <|> subscript
279− <|> superscript
280− <|> math
281− <|> code
282− <|> hask
274+ <|> inlineTag
283275 <|> B.singleton <$> charRef
284276 <|> inlineHtml
285277 <|> special
@@ -287,8 +279,26 @@ inline = whitespace
287279str :: MWParser Inlines
288280str = B.str <$> many1 (noneOf $ specialChars ++ spaceChars)
289281
282+inlineTag :: MWParser Inlines
283+inlineTag = do
284+ (TagOpen t _, raw) <- htmlTag (\x -> isInlineTag x && isTagOpen x)
285+ case t of
286+ "nowiki" -> B.text . fromEntities <$> try
287+ (manyTill anyChar (htmlTag (~== TagClose "nowiki")))
288+ "br" -> B.linebreak <$
289+ (optional (htmlTag (~== TagClose "br")) *> optional blankline)
290+ "strike" -> B.strikeout <$> inlinesInTags "strike"
291+ "del" -> B.strikeout <$> inlinesInTags "del"
292+ "sub" -> B.subscript <$> inlinesInTags "sub"
293+ "sup" -> B.superscript <$> inlinesInTags "sup"
294+ "math" -> B.math <$> charsInTags "math"
295+ "code" -> B.code <$> charsInTags "code"
296+ "tt" -> B.code <$> charsInTags "tt"
297+ "hask" -> B.codeWith ("",["haskell"],[]) <$> charsInTags "hask"
298+ _ -> return $ B.rawInline "html" raw
299+
290300special :: MWParser Inlines
291−special = B.str <$> count 1 (notFollowedBy' (htmlTag isBlockTag) *>
301+special = B.str <$> count 1 (notFollowedBy' (htmlTag isBlockTag') *>
292302 oneOf specialChars)
293303
294304inlineHtml :: MWParser Inlines
@@ -303,12 +313,6 @@ endline = () <$ try (newline <*
303313 notFollowedBy' hrule <*
304314 notFollowedBy anyListStart)
305315
306−linebreak :: MWParser Inlines
307−linebreak = B.linebreak <$
308− (htmlTag (~== TagOpen "br" []) *>
309− optional (htmlTag (~== TagClose "br")) *>
310− optional blankline)
311−
312316externalLink :: MWParser Inlines
313317externalLink = try $ do
314318 char '['
@@ -325,29 +329,6 @@ url = do
325329 (orig, src) <- uri
326330 return $ B.link src "" (B.str orig)
327331
328−nowiki :: MWParser Inlines
329−nowiki = B.text . fromEntities <$> try
330− (htmlTag (~== TagOpen "nowiki" []) *>
331− manyTill anyChar (htmlTag (~== TagClose "nowiki")))
332−
333−strikeout :: MWParser Inlines
334−strikeout = B.strikeout <$> (inlinesInTags "strike" <|> inlinesInTags "del")
335−
336−superscript :: MWParser Inlines
337−superscript = B.superscript <$> inlinesInTags "sup"
338−
339−subscript :: MWParser Inlines
340−subscript = B.subscript <$> inlinesInTags "sub"
341−
342−math :: MWParser Inlines
343−math = B.math <$> charsInTags "math"
344−
345−code :: MWParser Inlines
346−code = B.code <$> (charsInTags "code" <|> charsInTags "tt")
347−
348−hask :: MWParser Inlines
349−hask = B.codeWith ("",["haskell"],[]) <$> charsInTags "hask"
350−
351332-- | Parses a list of inlines between start and end delimiters.
352333inlinesBetween :: (Show b) => MWParser a -> MWParser b -> MWParser Inlines
353334inlinesBetween start end =