@@ -0,0 +1,311 @@
1+{-# LANGUAGE RelaxedPolyRec #-} -- needed for inlinesBetween on GHC < 7
2+{-
3+Copyright (C) 2012 John MacFarlane <jgm@berkeley.edu>
4+
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.
9+
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.
14+
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
18+-}
19+
20+{- |
21+ Module : Text.Pandoc.Readers.MediaWiki
22+ Copyright : Copyright (C) 2012 John MacFarlane
23+ License : GNU GPL, version 2 or above
24+
25+ Maintainer : John MacFarlane <jgm@berkeley.edu>
26+ Stability : alpha
27+ Portability : portable
28+
29+Conversion of mediawiki text to 'Pandoc' document.
30+-}
31+{-
32+TODO:
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 ###
36+_ tests for lists
37+_ support HTML lists
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
51+_ ignore gallery tag?
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
55+ postprocessing
56+_ category links
57+_ tests for raw html inline
58+_ tests for sup, sub, del
59+_ tests for pre, haskell
60+_ tests for code, tt, hask
61+_ test for blockquote
62+-}
63+module Text.Pandoc.Readers.MediaWiki ( readMediaWiki ) where
64+
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 ((<$>), (<*), (*>), (<$))
76+import Control.Monad
77+import Data.List (intersperse)
78+import Text.HTML.TagSoup
79+
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)
83+ -> Pandoc
84+readMediaWiki opts s =
85+ (readWith parseMediaWiki) def{ stateOptions = opts } (s ++ "\n\n")
86+
87+type MWParser = Parser [Char] ParserState
88+
89+--
90+-- auxiliary functions
91+--
92+
93+specialChars :: [Char]
94+specialChars = "'[]<=&*"
95+
96+spaceChars :: [Char]
97+spaceChars = " \n\t"
98+
99+sym :: String -> MWParser ()
100+sym s = () <$ try (string s)
101+
102+htmlComment :: MWParser ()
103+htmlComment = () <$ htmlTag isCommentTag
104+
105+inlinesInTags :: String -> MWParser Inlines
106+inlinesInTags tag = trimInlines . mconcat <$> try
107+ (htmlTag (~== TagOpen tag []) *>
108+ manyTill inline (htmlTag (~== TagClose tag)))
109+
110+blocksInTags :: String -> MWParser Blocks
111+blocksInTags tag = mconcat <$> try
112+ (htmlTag (~== TagOpen tag []) *>
113+ manyTill block (htmlTag (~== TagClose tag)))
114+
115+charsInTags :: String -> MWParser [Char]
116+charsInTags tag = fromEntities <$> try
117+ (htmlTag (~== TagOpen tag []) *>
118+ manyTill anyChar (htmlTag (~== TagClose tag)))
119+
120+--
121+-- main parser
122+--
123+
124+parseMediaWiki :: MWParser Pandoc
125+parseMediaWiki = do
126+ bs <- mconcat <$> many block
127+ spaces
128+ eof
129+ return $ B.doc bs
130+
131+--
132+-- block parsers
133+--
134+
135+block :: MWParser Blocks
136+block = header
137+ <|> hrule
138+ <|> bulletList
139+ <|> orderedList
140+ <|> definitionList
141+ <|> blockquote
142+ <|> codeblock
143+ <|> haskell
144+ <|> mempty <$ skipMany1 blankline
145+ <|> mempty <$ try (spaces *> htmlComment)
146+ <|> para
147+
148+para :: MWParser Blocks
149+para = B.para . trimInlines . mconcat <$> many1 inline
150+
151+hrule :: MWParser Blocks
152+hrule = B.horizontalRule <$ try (string "----" *> many (char '-') *> newline)
153+
154+blockquote :: MWParser Blocks
155+blockquote = B.blockQuote <$> blocksInTags "blockquote"
156+
157+codeblock :: MWParser Blocks
158+codeblock = B.codeBlock . trimCode <$> charsInTags "pre"
159+
160+trimCode :: String -> String
161+trimCode ('\n':xs) = stripTrailingNewlines xs
162+trimCode xs = stripTrailingNewlines xs
163+
164+haskell :: MWParser Blocks
165+haskell = B.codeBlockWith ("",["haskell"],[]) . trimCode <$>
166+ charsInTags "haskell"
167+
168+header :: MWParser Blocks
169+header = try $ do
170+ col <- sourceColumn <$> getPosition
171+ guard $ col == 1 -- header must be at beginning of line
172+ eqs <- many1 (char '=')
173+ let lev = length eqs
174+ guard $ lev <= 6
175+ contents <- trimInlines . mconcat <$> manyTill inline (count lev $ char '=')
176+ return $ B.header lev contents
177+
178+bulletList :: MWParser Blocks
179+bulletList = B.bulletList <$> many1 (listItem '*')
180+
181+orderedList :: MWParser Blocks
182+orderedList = B.orderedList <$> many1 (listItem '#')
183+
184+definitionList :: MWParser Blocks
185+definitionList = B.definitionList <$> many1 defListItem
186+
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)
192+
193+defListTerm :: MWParser Inlines
194+defListTerm = char ';' >> skipMany spaceChar >> manyTill anyChar newline >>=
195+ parseFromString (trimInlines . mconcat <$> many inline)
196+
197+listStart :: Char -> MWParser ()
198+listStart c = char c *> notFollowedBy listStartChar
199+
200+listStartChar :: MWParser Char
201+listStartChar = oneOf "*#;:"
202+
203+anyListStart :: MWParser ()
204+anyListStart = listStart '*' <|> listStart '#' <|> listStart ';'
205+
206+listItem :: Char -> MWParser Blocks
207+listItem c = try $ do
208+ listStart c
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
213+
214+--
215+-- inline parsers
216+--
217+
218+inline :: MWParser Inlines
219+inline = whitespace
220+ <|> url
221+ <|> str
222+ <|> strong
223+ <|> emph
224+ <|> nowiki
225+ <|> linebreak
226+ <|> externalLink
227+ <|> strikeout
228+ <|> subscript
229+ <|> superscript
230+ <|> code
231+ <|> hask
232+ <|> B.singleton <$> charRef
233+ <|> inlineHtml
234+ <|> special
235+
236+str :: MWParser Inlines
237+str = B.str <$> many1 (noneOf $ specialChars ++ spaceChars)
238+
239+special :: MWParser Inlines
240+special = B.str <$> count 1 (notFollowedBy' (htmlTag isBlockTag) *>
241+ oneOf specialChars)
242+
243+inlineHtml :: MWParser Inlines
244+inlineHtml = B.rawInline "html" . snd <$> htmlTag isInlineTag
245+
246+whitespace :: MWParser Inlines
247+whitespace = B.space <$ (skipMany1 spaceChar <|> endline <|> htmlComment)
248+
249+endline :: MWParser ()
250+endline = () <$ try (newline <*
251+ notFollowedBy blankline <*
252+ notFollowedBy' hrule <*
253+ notFollowedBy anyListStart)
254+
255+linebreak :: MWParser Inlines
256+linebreak = B.linebreak <$
257+ (htmlTag (~== TagOpen "br" []) *>
258+ optional (htmlTag (~== TagClose "br")) *>
259+ optional blankline)
260+
261+externalLink :: MWParser Inlines
262+externalLink = try $ do
263+ char '['
264+ (orig, src) <- uri
265+ skipMany1 spaceChar
266+ lab <- manyTill inline (char ']')
267+ let lab' = if null lab
268+ then [B.str "1"] -- TODO generate sequentially from state
269+ else lab
270+ return $ B.link src "" $ trimInlines $ mconcat lab'
271+
272+url :: MWParser Inlines
273+url = do
274+ (_, src) <- uri
275+ return $ B.link src "" (B.str orig)
276+
277+nowiki :: MWParser Inlines
278+nowiki = B.text <$> charsInTags "nowiki"
279+
280+strikeout :: MWParser Inlines
281+strikeout = B.strikeout <$> (inlinesInTags "strike" <|> inlinesInTags "del")
282+
283+superscript :: MWParser Inlines
284+superscript = B.superscript <$> inlinesInTags "sup"
285+
286+subscript :: MWParser Inlines
287+subscript = B.subscript <$> inlinesInTags "sub"
288+
289+code :: MWParser Inlines
290+code = B.code <$> (charsInTags "code" <|> charsInTags "tt")
291+
292+hask :: MWParser Inlines
293+hask = B.codeWith ("",["haskell"],[]) <$> charsInTags "hask"
294+
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
301+
302+emph :: MWParser Inlines
303+emph = B.emph <$> nested (inlinesBetween start end)
304+ where start = sym "''" >> lookAhead nonspaceChar
305+ end = try $ notFollowedBy' (() <$ strong) >> sym "''"
306+
307+strong :: MWParser Inlines
308+strong = B.strong <$> nested (inlinesBetween start end)
309+ where start = sym "'''" >> lookAhead nonspaceChar
310+ end = try $ sym "'''"
311+