@@ -0,0 +1,311 @@
1+{-# LANGUAGE RelaxedPolyRec #-} -- needed for inlinesBetween on GHC < 7
3+Copyright (C) 2012 John MacFarlane <jgm@berkeley.edu>
5+This program is free software; you can redistribute it and/or modify
6+it under the terms of the GNU General Public License as published by
7+the Free Software Foundation; either version 2 of the License, or
8+(at your option) any later version.
10+This program is distributed in the hope that it will be useful,
11+but WITHOUT ANY WARRANTY; without even the implied warranty of
12+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13+GNU General Public License for more details.
15+You should have received a copy of the GNU General Public License
16+along with this program; if not, write to the Free Software
17+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21+ Module : Text.Pandoc.Readers.MediaWiki
22+ Copyright : Copyright (C) 2012 John MacFarlane
23+ License : GNU GPL, version 2 or above
25+ Maintainer : John MacFarlane <jgm@berkeley.edu>
27+ Portability : portable
29+Conversion of mediawiki text to 'Pandoc' document.
33+_ fix pre parser -- it should use html tagsoup parsers,
34+ then just strip out the text from text tags.
35+_ correctly handle skipped level in list, e.g. # to ###
38+_ support list style attributes and start values in ol lists, also
39+ value attribute on li
40+_ support <p> tags in lists (and out?)
41+_ support :, ::, etc. for indent (treat as list continuation paras?)
42+_ support preformatted text (lines starting with space)
43+_ support preformatted text blocks
44+_ code highlighting: http://www.mediawiki.org/wiki/Extension:SyntaxHighlight_GeSHi <syntaxhighlight lang="php"> (alternativel, <source...>)
45+ if 'line' attribute present, number lines
46+ if 'start' present, set starting line number
47+_ support internal links http://www.mediawiki.org/wiki/Help:Links
48+_ support external links
49+_ support automatic linkification of URLs
50+_ support images http://www.mediawiki.org/wiki/Help:Images
52+_ support tables http://www.mediawiki.org/wiki/Help:Tables
53+_ support <math> tag for latex math
54+_ templates or anything in {{}} -> handle as raw wikimedia, can be dealt with in
57+_ tests for raw html inline
58+_ tests for sup, sub, del
59+_ tests for pre, haskell
60+_ tests for code, tt, hask
63+module Text.Pandoc.Readers.MediaWiki ( readMediaWiki ) where
65+import Text.Pandoc.Definition
66+import qualified Text.Pandoc.Builder as B
67+import Text.Pandoc.Builder (Inlines, Blocks, trimInlines, (<>))
68+import Text.Pandoc.Options
69+import Text.Pandoc.Readers.HTML ( htmlTag, htmlInBalanced,
70+ isInlineTag, isBlockTag, isTextTag, isCommentTag )
71+import Text.Pandoc.XML ( fromEntities )
72+import Text.Pandoc.Parsing
73+import Text.Pandoc.Shared ( stripTrailingNewlines )
74+import Data.Monoid (mconcat, mempty)
75+import Control.Applicative ((<$>), (<*), (*>), (<$))
77+import Data.List (intersperse)
78+import Text.HTML.TagSoup
80+-- | Read mediawiki from an input string and return a Pandoc document.
81+readMediaWiki :: ReaderOptions -- ^ Reader options
82+ -> String -- ^ String to parse (assuming @'\n'@ line endings)
84+readMediaWiki opts s =
85+ (readWith parseMediaWiki) def{ stateOptions = opts } (s ++ "\n\n")
87+type MWParser = Parser [Char] ParserState
90+-- auxiliary functions
93+specialChars :: [Char]
94+specialChars = "'[]<=&*"
99+sym :: String -> MWParser ()
100+sym s = () <$ try (string s)
102+htmlComment :: MWParser ()
103+htmlComment = () <$ htmlTag isCommentTag
105+inlinesInTags :: String -> MWParser Inlines
106+inlinesInTags tag = trimInlines . mconcat <$> try
107+ (htmlTag (~== TagOpen tag []) *>
108+ manyTill inline (htmlTag (~== TagClose tag)))
110+blocksInTags :: String -> MWParser Blocks
111+blocksInTags tag = mconcat <$> try
112+ (htmlTag (~== TagOpen tag []) *>
113+ manyTill block (htmlTag (~== TagClose tag)))
115+charsInTags :: String -> MWParser [Char]
116+charsInTags tag = fromEntities <$> try
117+ (htmlTag (~== TagOpen tag []) *>
118+ manyTill anyChar (htmlTag (~== TagClose tag)))
124+parseMediaWiki :: MWParser Pandoc
126+ bs <- mconcat <$> many block
135+block :: MWParser Blocks
144+ <|> mempty <$ skipMany1 blankline
145+ <|> mempty <$ try (spaces *> htmlComment)
148+para :: MWParser Blocks
149+para = B.para . trimInlines . mconcat <$> many1 inline
151+hrule :: MWParser Blocks
152+hrule = B.horizontalRule <$ try (string "----" *> many (char '-') *> newline)
154+blockquote :: MWParser Blocks
155+blockquote = B.blockQuote <$> blocksInTags "blockquote"
157+codeblock :: MWParser Blocks
158+codeblock = B.codeBlock . trimCode <$> charsInTags "pre"
160+trimCode :: String -> String
161+trimCode ('\n':xs) = stripTrailingNewlines xs
162+trimCode xs = stripTrailingNewlines xs
164+haskell :: MWParser Blocks
165+haskell = B.codeBlockWith ("",["haskell"],[]) . trimCode <$>
166+ charsInTags "haskell"
168+header :: MWParser Blocks
170+ col <- sourceColumn <$> getPosition
171+ guard $ col == 1 -- header must be at beginning of line
172+ eqs <- many1 (char '=')
173+ let lev = length eqs
175+ contents <- trimInlines . mconcat <$> manyTill inline (count lev $ char '=')
176+ return $ B.header lev contents
178+bulletList :: MWParser Blocks
179+bulletList = B.bulletList <$> many1 (listItem '*')
181+orderedList :: MWParser Blocks
182+orderedList = B.orderedList <$> many1 (listItem '#')
184+definitionList :: MWParser Blocks
185+definitionList = B.definitionList <$> many1 defListItem
187+defListItem :: MWParser (Inlines, [Blocks])
188+defListItem = try $ do
189+ terms <- mconcat . intersperse B.linebreak <$> many1 defListTerm
190+ defs <- many1 $ listItem ':'
191+ return (terms, defs)
193+defListTerm :: MWParser Inlines
194+defListTerm = char ';' >> skipMany spaceChar >> manyTill anyChar newline >>=
195+ parseFromString (trimInlines . mconcat <$> many inline)
197+listStart :: Char -> MWParser ()
198+listStart c = char c *> notFollowedBy listStartChar
200+listStartChar :: MWParser Char
201+listStartChar = oneOf "*#;:"
203+anyListStart :: MWParser ()
204+anyListStart = listStart '*' <|> listStart '#' <|> listStart ';'
206+listItem :: Char -> MWParser Blocks
207+listItem c = try $ do
209+ first <- manyTill anyChar newline
210+ rest <- many (try $ char c *> lookAhead listStartChar *>
211+ manyTill anyChar newline)
212+ parseFromString (mconcat <$> many1 block) $ unlines $ first : rest
218+inline :: MWParser Inlines
232+ <|> B.singleton <$> charRef
236+str :: MWParser Inlines
237+str = B.str <$> many1 (noneOf $ specialChars ++ spaceChars)
239+special :: MWParser Inlines
240+special = B.str <$> count 1 (notFollowedBy' (htmlTag isBlockTag) *>
243+inlineHtml :: MWParser Inlines
244+inlineHtml = B.rawInline "html" . snd <$> htmlTag isInlineTag
246+whitespace :: MWParser Inlines
247+whitespace = B.space <$ (skipMany1 spaceChar <|> endline <|> htmlComment)
249+endline :: MWParser ()
250+endline = () <$ try (newline <*
251+ notFollowedBy blankline <*
252+ notFollowedBy' hrule <*
253+ notFollowedBy anyListStart)
255+linebreak :: MWParser Inlines
256+linebreak = B.linebreak <$
257+ (htmlTag (~== TagOpen "br" []) *>
258+ optional (htmlTag (~== TagClose "br")) *>
261+externalLink :: MWParser Inlines
262+externalLink = try $ do
266+ lab <- manyTill inline (char ']')
267+ let lab' = if null lab
268+ then [B.str "1"] -- TODO generate sequentially from state
270+ return $ B.link src "" $ trimInlines $ mconcat lab'
272+url :: MWParser Inlines
275+ return $ B.link src "" (B.str orig)
277+nowiki :: MWParser Inlines
278+nowiki = B.text <$> charsInTags "nowiki"
280+strikeout :: MWParser Inlines
281+strikeout = B.strikeout <$> (inlinesInTags "strike" <|> inlinesInTags "del")
283+superscript :: MWParser Inlines
284+superscript = B.superscript <$> inlinesInTags "sup"
286+subscript :: MWParser Inlines
287+subscript = B.subscript <$> inlinesInTags "sub"
289+code :: MWParser Inlines
290+code = B.code <$> (charsInTags "code" <|> charsInTags "tt")
292+hask :: MWParser Inlines
293+hask = B.codeWith ("",["haskell"],[]) <$> charsInTags "hask"
295+-- | Parses a list of inlines between start and end delimiters.
296+inlinesBetween :: (Show b) => MWParser a -> MWParser b -> MWParser Inlines
297+inlinesBetween start end =
298+ (trimInlines . mconcat) <$> try (start >> many1Till inner end)
299+ where inner = innerSpace <|> (notFollowedBy' (() <$ whitespace) >> inline)
300+ innerSpace = try $ whitespace >>~ notFollowedBy' end
302+emph :: MWParser Inlines
303+emph = B.emph <$> nested (inlinesBetween start end)
304+ where start = sym "''" >> lookAhead nonspaceChar
305+ end = try $ notFollowedBy' (() <$ strong) >> sym "''"
307+strong :: MWParser Inlines
308+strong = B.strong <$> nested (inlinesBetween start end)
309+ where start = sym "'''" >> lookAhead nonspaceChar
310+ end = try $ sym "'''"