@@ -0,0 +1,394 @@
1+{-
2+Copyright (C) 2008 John MacFarlane <jgm@berkeley.edu>
3+
4+This program is free software; you can redistribute it and/or modify
5+it under the terms of the GNU General Public License as published by
6+the Free Software Foundation; either version 2 of the License, or
7+(at your option) any later version.
8+
9+This program is distributed in the hope that it will be useful,
10+but WITHOUT ANY WARRANTY; without even the implied warranty of
11+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12+GNU General Public License for more details.
13+
14+You should have received a copy of the GNU General Public License
15+along with this program; if not, write to the Free Software
16+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17+-}
18+
19+{- |
20+ Module : Text.Pandoc.Writers.MediaWiki
21+ Copyright : Copyright (C) 2006-7 John MacFarlane
22+ License : GNU GPL, version 2 or above
23+
24+ Maintainer : John MacFarlane <jgm@berkeley.edu>
25+ Stability : alpha
26+ Portability : portable
27+
28+Conversion of 'Pandoc' documents to MediaWiki markup.
29+
30+MediaWiki: <http://www.mediawiki.org/wiki/MediaWiki>
31+-}
32+module Text.Pandoc.Writers.MediaWiki ( writeMediaWiki ) where
33+import Text.Pandoc.Definition
34+import Text.Pandoc.Shared
35+import Text.Pandoc.XML ( escapeStringForXML )
36+import Data.List ( intersect )
37+import Network.URI ( isURI )
38+import Control.Monad.State
39+
40+data WriterState = WriterState {
41+ stNotes :: Bool -- True if there are notes
42+ , stListLevel :: [Char] -- String at beginning of list items, e.g. "**"
43+ , stUseTags :: Bool -- True if we should use HTML tags because we're in a complex list
44+ }
45+
46+-- | Convert Pandoc to MediaWiki.
47+writeMediaWiki :: WriterOptions -> Pandoc -> String
48+writeMediaWiki opts document =
49+ evalState (pandocToMediaWiki opts document)
50+ (WriterState { stNotes = False, stListLevel = [], stUseTags = False })
51+
52+-- | Return MediaWiki representation of document.
53+pandocToMediaWiki :: WriterOptions -> Pandoc -> State WriterState String
54+pandocToMediaWiki opts (Pandoc _ blocks) = do
55+ let before = writerIncludeBefore opts
56+ let after = writerIncludeAfter opts
57+ let head' = if writerStandalone opts
58+ then writerHeader opts
59+ else ""
60+ let toc = if writerTableOfContents opts
61+ then "__TOC__\n"
62+ else ""
63+ body <- blockListToMediaWiki opts blocks
64+ notesExist <- get >>= return . stNotes
65+ let notes = if notesExist
66+ then "\n== Notes ==\n<references />"
67+ else ""
68+ return $ head' ++ before ++ toc ++ body ++ after ++ notes
69+
70+-- | Escape special characters for MediaWiki.
71+escapeString :: String -> String
72+escapeString = escapeStringForXML
73+
74+-- | Convert Pandoc block element to MediaWiki.
75+blockToMediaWiki :: WriterOptions -- ^ Options
76+ -> Block -- ^ Block element
77+ -> State WriterState String
78+
79+blockToMediaWiki _ Null = return ""
80+
81+blockToMediaWiki opts (Plain inlines) =
82+ inlineListToMediaWiki opts inlines
83+
84+blockToMediaWiki opts (Para inlines) = do
85+ useTags <- get >>= return . stUseTags
86+ listLevel <- get >>= return . stListLevel
87+ contents <- inlineListToMediaWiki opts inlines
88+ return $ if useTags
89+ then "<p>" ++ contents ++ "</p>"
90+ else contents ++ if null listLevel then "\n" else ""
91+
92+blockToMediaWiki _ (RawHtml str) = return str
93+
94+blockToMediaWiki _ HorizontalRule = return "\n-----\n"
95+
96+blockToMediaWiki opts (Header level inlines) = do
97+ contents <- inlineListToMediaWiki opts inlines
98+ let eqs = replicate (level + 1) '='
99+ return $ eqs ++ " " ++ contents ++ " " ++ eqs ++ "\n"
100+
101+blockToMediaWiki _ (CodeBlock (_,classes,_) str) = do
102+ let at = classes `intersect` ["actionscript", "ada", "apache", "applescript", "asm", "asp",
103+ "autoit", "bash", "blitzbasic", "bnf", "c", "c_mac", "caddcl", "cadlisp", "cfdg", "cfm",
104+ "cpp", "cpp-qt", "csharp", "css", "d", "delphi", "diff", "div", "dos", "eiffel", "fortran",
105+ "freebasic", "gml", "groovy", "html4strict", "idl", "ini", "inno", "io", "java", "java5",
106+ "javascript", "latex", "lisp", "lua", "matlab", "mirc", "mpasm", "mysql", "nsis", "objc",
107+ "ocaml", "ocaml-brief", "oobas", "oracle8", "pascal", "perl", "php", "php-brief", "plsql",
108+ "python", "qbasic", "rails", "reg", "robots", "ruby", "sas", "scheme", "sdlbasic",
109+ "smalltalk", "smarty", "sql", "tcl", "", "thinbasic", "tsql", "vb", "vbnet", "vhdl",
110+ "visualfoxpro", "winbatch", "xml", "xpp", "z80"]
111+ let (beg, end) = if null at
112+ then ("<pre>", "</pre>")
113+ else ("<source lang=\"" ++ head at ++ "\">", "</source>")
114+ return $ beg ++ escapeString str ++ end
115+
116+blockToMediaWiki opts (BlockQuote blocks) = do
117+ contents <- blockListToMediaWiki opts blocks
118+ return $ "<blockquote>" ++ contents ++ "</blockquote>"
119+
120+blockToMediaWiki opts (Table caption aligns widths headers rows) = do
121+ let alignStrings = map alignmentToString aligns
122+ captionDoc <- if null caption
123+ then return ""
124+ else do
125+ c <- inlineListToMediaWiki opts caption
126+ return $ "<caption>" ++ c ++ "</caption>"
127+ colHeads <- colHeadsToMediaWiki opts alignStrings widths headers
128+ rows' <- mapM (tableRowToMediaWiki opts alignStrings) rows
129+ return $ "<table>\n" ++ captionDoc ++ colHeads ++ vcat rows' ++ "\n</table>"
130+
131+blockToMediaWiki opts x@(BulletList items) = do
132+ oldUseTags <- get >>= return . stUseTags
133+ let useTags = oldUseTags || not (isSimpleList x)
134+ if useTags
135+ then do
136+ modify $ \s -> s { stUseTags = True }
137+ contents <- mapM (listItemToMediaWiki opts) items
138+ modify $ \s -> s { stUseTags = oldUseTags }
139+ return $ "<ul>\n" ++ vcat contents ++ "</ul>\n"
140+ else do
141+ modify $ \s -> s { stListLevel = stListLevel s ++ "*" }
142+ contents <- mapM (listItemToMediaWiki opts) items
143+ modify $ \s -> s { stListLevel = init (stListLevel s) }
144+ return $ vcat contents
145+
146+blockToMediaWiki opts x@(OrderedList attribs items) = do
147+ oldUseTags <- get >>= return . stUseTags
148+ let useTags = oldUseTags || not (isSimpleList x)
149+ if useTags
150+ then do
151+ modify $ \s -> s { stUseTags = True }
152+ contents <- mapM (listItemToMediaWiki opts) items
153+ modify $ \s -> s { stUseTags = oldUseTags }
154+ return $ "<ol" ++ listAttribsToString attribs ++ ">\n" ++ vcat contents ++ "</ol>\n"
155+ else do
156+ modify $ \s -> s { stListLevel = stListLevel s ++ "#" }
157+ contents <- mapM (listItemToMediaWiki opts) items
158+ modify $ \s -> s { stListLevel = init (stListLevel s) }
159+ return $ vcat contents
160+
161+blockToMediaWiki opts x@(DefinitionList items) = do
162+ oldUseTags <- get >>= return . stUseTags
163+ let useTags = oldUseTags || not (isSimpleList x)
164+ if useTags
165+ then do
166+ modify $ \s -> s { stUseTags = True }
167+ contents <- mapM (definitionListItemToMediaWiki opts) items
168+ modify $ \s -> s { stUseTags = oldUseTags }
169+ return $ "<dl>\n" ++ vcat contents ++ "</dl>\n"
170+ else do
171+ modify $ \s -> s { stListLevel = stListLevel s ++ ";" }
172+ contents <- mapM (definitionListItemToMediaWiki opts) items
173+ modify $ \s -> s { stListLevel = init (stListLevel s) }
174+ return $ vcat contents
175+
176+-- Auxiliary functions for lists:
177+
178+-- | Convert ordered list attributes to HTML attribute string
179+listAttribsToString :: ListAttributes -> String
180+listAttribsToString (startnum, numstyle, _) =
181+ let numstyle' = camelCaseToHyphenated $ show numstyle
182+ in (if startnum /= 1
183+ then " start=\"" ++ show startnum ++ "\""
184+ else "") ++
185+ (if numstyle /= DefaultStyle
186+ then " style=\"list-style-type: " ++ numstyle' ++ ";\""
187+ else "")
188+
189+-- | Convert bullet or ordered list item (list of blocks) to MediaWiki.
190+listItemToMediaWiki :: WriterOptions -> [Block] -> State WriterState String
191+listItemToMediaWiki opts items = do
192+ contents <- blockListToMediaWiki opts items
193+ useTags <- get >>= return . stUseTags
194+ if useTags
195+ then return $ "<li>" ++ contents ++ "</li>"
196+ else do
197+ marker <- get >>= return . stListLevel
198+ return $ marker ++ " " ++ contents
199+
200+-- | Convert definition list item (label, list of blocks) to MediaWiki.
201+definitionListItemToMediaWiki :: WriterOptions
202+ -> ([Inline],[Block])
203+ -> State WriterState String
204+definitionListItemToMediaWiki opts (label, items) = do
205+ labelText <- inlineListToMediaWiki opts label
206+ contents <- blockListToMediaWiki opts items
207+ useTags <- get >>= return . stUseTags
208+ if useTags
209+ then return $ "<dt>" ++ labelText ++ "</dt>\n<dd>" ++ contents ++ "</dd>"
210+ else do
211+ marker <- get >>= return . stListLevel
212+ return $ marker ++ " " ++ labelText ++ "\n" ++ (init marker ++ ": ") ++ contents
213+
214+-- | True if the list can be handled by simple wiki markup, False if HTML tags will be needed.
215+isSimpleList :: Block -> Bool
216+isSimpleList x =
217+ case x of
218+ BulletList items -> all isSimpleListItem items
219+ OrderedList (num, sty, _) items -> all isSimpleListItem items &&
220+ num == 1 && sty `elem` [DefaultStyle, Decimal]
221+ DefinitionList items -> all isSimpleListItem $ map snd items
222+ _ -> False
223+
224+-- | True if list item can be handled with the simple wiki syntax. False if
225+-- HTML tags will be needed.
226+isSimpleListItem :: [Block] -> Bool
227+isSimpleListItem [] = True
228+isSimpleListItem [x] =
229+ case x of
230+ Plain _ -> True
231+ Para _ -> True
232+ BulletList _ -> isSimpleList x
233+ OrderedList _ _ -> isSimpleList x
234+ DefinitionList _ -> isSimpleList x
235+ _ -> False
236+isSimpleListItem [x, y] | isPlainOrPara x =
237+ case y of
238+ BulletList _ -> isSimpleList y
239+ OrderedList _ _ -> isSimpleList y
240+ DefinitionList _ -> isSimpleList y
241+ _ -> False
242+isSimpleListItem _ = False
243+
244+isPlainOrPara :: Block -> Bool
245+isPlainOrPara (Plain _) = True
246+isPlainOrPara (Para _) = True
247+isPlainOrPara _ = False
248+
249+tr :: String -> String
250+tr x = "<tr>\n" ++ x ++ "\n</tr>"
251+
252+-- | Concatenates strings with line breaks between them.
253+vcat :: [String] -> String
254+vcat [] = ""
255+vcat [x] = x
256+vcat (x:xs) = x ++ "\n" ++ vcat xs
257+
258+-- Auxiliary functions for tables:
259+
260+colHeadsToMediaWiki :: WriterOptions
261+ -> [[Char]]
262+ -> [Float]
263+ -> [[Block]]
264+ -> State WriterState String
265+colHeadsToMediaWiki opts alignStrings widths headers = do
266+ heads <- sequence $ zipWith3
267+ (\alignment columnwidth item -> tableItemToMediaWiki opts "th" alignment columnwidth item)
268+ alignStrings widths headers
269+ return $ tr $ vcat heads
270+
271+alignmentToString :: Alignment -> [Char]
272+alignmentToString alignment = case alignment of
273+ AlignLeft -> "left"
274+ AlignRight -> "right"
275+ AlignCenter -> "center"
276+ AlignDefault -> "left"
277+
278+tableRowToMediaWiki :: WriterOptions
279+ -> [[Char]]
280+ -> [[Block]]
281+ -> State WriterState String
282+tableRowToMediaWiki opts aligns columns =
283+ (sequence $ zipWith3 (tableItemToMediaWiki opts "td") aligns (repeat 0) columns) >>=
284+ return . tr . vcat
285+
286+tableItemToMediaWiki :: WriterOptions
287+ -> [Char]
288+ -> [Char]
289+ -> Float
290+ -> [Block]
291+ -> State WriterState String
292+tableItemToMediaWiki opts tag' align' width' item = do
293+ contents <- blockListToMediaWiki opts item
294+ let attrib = " align=\"" ++ align' ++ "\"" ++
295+ if width' /= 0
296+ then " style=\"width: " ++ (show (truncate (100 * width') :: Integer)) ++ "%;\""
297+ else ""
298+ return $ "<" ++ tag' ++ attrib ++ ">" ++ contents ++ "<" ++ tag' ++ ">"
299+
300+-- | Convert list of Pandoc block elements to MediaWiki.
301+blockListToMediaWiki :: WriterOptions -- ^ Options
302+ -> [Block] -- ^ List of block elements
303+ -> State WriterState String
304+blockListToMediaWiki opts blocks =
305+ mapM (blockToMediaWiki opts) blocks >>= return . vcat
306+
307+-- | Convert list of Pandoc inline elements to MediaWiki.
308+inlineListToMediaWiki :: WriterOptions -> [Inline] -> State WriterState String
309+inlineListToMediaWiki opts lst =
310+ mapM (inlineToMediaWiki opts) lst >>= return . concat
311+
312+-- | Convert Pandoc inline element to MediaWiki.
313+inlineToMediaWiki :: WriterOptions -> Inline -> State WriterState String
314+
315+inlineToMediaWiki opts (Emph lst) = do
316+ contents <- inlineListToMediaWiki opts lst
317+ return $ "''" ++ contents ++ "''"
318+
319+inlineToMediaWiki opts (Strong lst) = do
320+ contents <- inlineListToMediaWiki opts lst
321+ return $ "'''" ++ contents ++ "'''"
322+
323+inlineToMediaWiki opts (Strikeout lst) = do
324+ contents <- inlineListToMediaWiki opts lst
325+ return $ "<s>" ++ contents ++ "</s>"
326+
327+inlineToMediaWiki opts (Superscript lst) = do
328+ contents <- inlineListToMediaWiki opts lst
329+ return $ "<sup>" ++ contents ++ "</sup>"
330+
331+inlineToMediaWiki opts (Subscript lst) = do
332+ contents <- inlineListToMediaWiki opts lst
333+ return $ "<sub>" ++ contents ++ "</sub>"
334+
335+inlineToMediaWiki opts (SmallCaps lst) = inlineListToMediaWiki opts lst
336+
337+inlineToMediaWiki opts (Quoted SingleQuote lst) = do
338+ contents <- inlineListToMediaWiki opts lst
339+ return $ "‘" ++ contents ++ "’"
340+
341+inlineToMediaWiki opts (Quoted DoubleQuote lst) = do
342+ contents <- inlineListToMediaWiki opts lst
343+ return $ "“" ++ contents ++ "”"
344+
345+inlineToMediaWiki _ EmDash = return "—"
346+
347+inlineToMediaWiki _ EnDash = return "–"
348+
349+inlineToMediaWiki _ Apostrophe = return "’"
350+
351+inlineToMediaWiki _ Ellipses = return "…"
352+
353+inlineToMediaWiki _ (Code str) =
354+ return $ "<tt>" ++ (escapeString str) ++ "</tt>"
355+
356+inlineToMediaWiki _ (Str str) = return $ escapeString str
357+
358+inlineToMediaWiki _ (Math str) = return $ "<math>" ++ str ++ "</math>"
359+ -- note: str should NOT be escaped
360+
361+inlineToMediaWiki _ (TeX _) = return ""
362+
363+inlineToMediaWiki _ (HtmlInline str) = return str
364+
365+inlineToMediaWiki _ (LineBreak) = return "<br />\n"
366+
367+inlineToMediaWiki _ Space = return " "
368+
369+inlineToMediaWiki opts (Link txt (src, _)) = do
370+ link <- inlineListToMediaWiki opts txt
371+ let useAuto = txt == [Code src]
372+ let src' = if isURI src
373+ then src
374+ else if take 1 src == "/"
375+ then "http://{{SERVERNAME}}" ++ src
376+ else "http://{{SERVERNAME}}/" ++ src
377+ return $ if useAuto
378+ then src'
379+ else "[" ++ src' ++ " " ++ link ++ "]"
380+
381+inlineToMediaWiki opts (Image alt (source, tit)) = do
382+ alt' <- inlineListToMediaWiki opts alt
383+ let txt = if (null tit)
384+ then if null alt
385+ then ""
386+ else "|" ++ alt'
387+ else "|" ++ tit
388+ return $ "[[Image:" ++ source ++ txt ++ "]]"
389+
390+inlineToMediaWiki opts (Note contents) = do
391+ contents' <- blockListToMediaWiki opts contents
392+ modify (\s -> s { stNotes = True })
393+ return $ "<ref>" ++ contents' ++ "</ref>"
394+ -- note - may not work for notes with multiple blocks