git.iko.soy/typeable/pandoc
on master help sign in
MediaWiki reader: Improved efficiency with raw html tags.
e3abc25John MacFarlane
src/Text/Pandoc/Readers/MediaWiki.hs+59−78
compare with master
unifiedsplit
@@ -30,8 +30,6 @@ Conversion of mediawiki text to 'Pandoc' document.
30-}
30-}
31{-
31{-
32TODO:
32TODO:
33−_ make tag parsers more efficient by parsing one HTML tag, checking it,
34− then...
35_ support HTML lists
33_ support HTML lists
36_ support list style attributes and start values in ol lists, also
34_ support list style attributes and start values in ol lists, also
37 value attribute on li
35 value attribute on li
@@ -85,23 +83,27 @@ spaceChars = " \n\t"
85sym :: String -> MWParser ()
83sym :: String -> MWParser ()
86sym s = () <$ try (string s)
84sym s = () <$ try (string s)
87
85
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+
88htmlComment :: MWParser ()
93htmlComment :: MWParser ()
89htmlComment = () <$ htmlTag isCommentTag
94htmlComment = () <$ htmlTag isCommentTag
90
95
91inlinesInTags :: String -> MWParser Inlines
96inlinesInTags :: String -> MWParser Inlines
92inlinesInTags tag = trimInlines . mconcat <$> try
97inlinesInTags tag = trimInlines . mconcat <$> try
93− (htmlTag (~== TagOpen tag []) *>
94− manyTill inline (htmlTag (~== TagClose tag)))
98+ (manyTill inline (htmlTag (~== TagClose tag)))
95
99
96blocksInTags :: String -> MWParser Blocks
100blocksInTags :: String -> MWParser Blocks
97blocksInTags tag = mconcat <$> try
101blocksInTags tag = mconcat <$> try
98− (htmlTag (~== TagOpen tag []) *>
99− manyTill block (htmlTag (~== TagClose tag)))
102+ (manyTill block (htmlTag (~== TagClose tag)))
100
103
101charsInTags :: String -> MWParser [Char]
104charsInTags :: String -> MWParser [Char]
102charsInTags tag = innerText . parseTags <$> try
105charsInTags tag = innerText . parseTags <$> try
103− (htmlTag (~== TagOpen tag []) *>
104− manyTill anyChar (htmlTag (~== TagClose tag)))
106+ (manyTill anyChar (htmlTag (~== TagClose tag)))
105
107
106--
108--
107-- main parser
109-- main parser
@@ -119,18 +121,15 @@ parseMediaWiki = do
119--
121--
120
122
121block :: MWParser Blocks
123block :: MWParser Blocks
124+block = mempty <$ skipMany1 blankline
122−block = header
125+ <|> header
123 <|> hrule
126 <|> hrule
124 <|> bulletList
127 <|> bulletList
125 <|> orderedList
128 <|> orderedList
126 <|> definitionList
129 <|> definitionList
127 <|> mempty <$ try (spaces *> htmlComment)
130 <|> mempty <$ try (spaces *> htmlComment)
128 <|> preformatted
131 <|> preformatted
129− <|> blockquote
132+ <|> blockTag
130− <|> codeblock
131− <|> syntaxhighlight
132− <|> haskell
133− <|> mempty <$ skipMany1 blankline
134 <|> pTag
133 <|> pTag
135 <|> blockHtml
134 <|> blockHtml
136 <|> para
135 <|> para
@@ -138,6 +137,32 @@ block = header
138para :: MWParser Blocks
137para :: MWParser Blocks
139para = B.para . trimInlines . mconcat <$> many1 inline
138para = B.para . trimInlines . mconcat <$> many1 inline
140
139
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+
141-- We can just skip pTags, as contents will be treated as paragraphs
166-- We can just skip pTags, as contents will be treated as paragraphs
142pTag :: MWParser Blocks
167pTag :: MWParser Blocks
143pTag = mempty <$ (htmlTag (\t -> t ~== TagOpen "p" [] || t ~== TagClose "p"))
168pTag = mempty <$ (htmlTag (\t -> t ~== TagOpen "p" [] || t ~== TagClose "p"))
@@ -164,32 +189,6 @@ preformatted = do
164 strToCode x = x
189 strToCode x = x
165 B.para . bottomUp strToCode . mconcat <$> many1 inline'
190 B.para . bottomUp strToCode . mconcat <$> many1 inline'
166
191
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−
193header :: MWParser Blocks
192header :: MWParser Blocks
194header = try $ do
193header = try $ do
195 col <- sourceColumn <$> getPosition
194 col <- sourceColumn <$> getPosition
@@ -271,15 +270,8 @@ inline = whitespace
271 <|> str
270 <|> str
272 <|> strong
271 <|> strong
273 <|> emph
272 <|> emph
274− <|> nowiki
275− <|> linebreak
276 <|> externalLink
273 <|> externalLink
277− <|> strikeout
274+ <|> inlineTag
278− <|> subscript
279− <|> superscript
280− <|> math
281− <|> code
282− <|> hask
283 <|> B.singleton <$> charRef
275 <|> B.singleton <$> charRef
284 <|> inlineHtml
276 <|> inlineHtml
285 <|> special
277 <|> special
@@ -287,8 +279,26 @@ inline = whitespace
287str :: MWParser Inlines
279str :: MWParser Inlines
288str = B.str <$> many1 (noneOf $ specialChars ++ spaceChars)
280str = B.str <$> many1 (noneOf $ specialChars ++ spaceChars)
289
281
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+
290special :: MWParser Inlines
300special :: MWParser Inlines
291−special = B.str <$> count 1 (notFollowedBy' (htmlTag isBlockTag) *>
301+special = B.str <$> count 1 (notFollowedBy' (htmlTag isBlockTag') *>
292 oneOf specialChars)
302 oneOf specialChars)
293
303
294inlineHtml :: MWParser Inlines
304inlineHtml :: MWParser Inlines
@@ -303,12 +313,6 @@ endline = () <$ try (newline <*
303 notFollowedBy' hrule <*
313 notFollowedBy' hrule <*
304 notFollowedBy anyListStart)
314 notFollowedBy anyListStart)
305
315
306−linebreak :: MWParser Inlines
307−linebreak = B.linebreak <$
308− (htmlTag (~== TagOpen "br" []) *>
309− optional (htmlTag (~== TagClose "br")) *>
310− optional blankline)
311−
312externalLink :: MWParser Inlines
316externalLink :: MWParser Inlines
313externalLink = try $ do
317externalLink = try $ do
314 char '['
318 char '['
@@ -325,29 +329,6 @@ url = do
325 (orig, src) <- uri
329 (orig, src) <- uri
326 return $ B.link src "" (B.str orig)
330 return $ B.link src "" (B.str orig)
327
331
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−
351-- | Parses a list of inlines between start and end delimiters.
332-- | Parses a list of inlines between start and end delimiters.
352inlinesBetween :: (Show b) => MWParser a -> MWParser b -> MWParser Inlines
333inlinesBetween :: (Show b) => MWParser a -> MWParser b -> MWParser Inlines
353inlinesBetween start end =
334inlinesBetween start end =