@@ -37,92 +37,99 @@ import Text.Pandoc.Writers.Shared
3737import Text.Pandoc.Pretty (render)
3838import Text.Pandoc.Templates (renderTemplate')
3939import Text.Pandoc.XML ( escapeStringForXML )
40−import Data.List ( intersect, intercalate, intersperse )
40+import Data.List ( intersect, intercalate )
4141import Network.URI ( isURI )
42+import Control.Monad.Reader
4243import Control.Monad.State
4344
4445data WriterState = WriterState {
4546 stNotes :: Bool -- True if there are notes
46− , stListLevel :: [Char] -- String at beginning of list items, e.g. "**"
47− , stUseTags :: Bool -- True if we should use HTML tags because we're in a complex list
4847 }
4948
49+data WriterReader = WriterReader {
50+ options :: WriterOptions -- Writer options
51+ , stListLevel :: String -- String at beginning of list items, e.g. "**"
52+ , stUseTags :: Bool -- True if we should use HTML tags because we're in a complex list
53+ }
54+
55+type MediaWikiWriter = ReaderT WriterReader (State WriterState)
56+
5057-- | Convert Pandoc to MediaWiki.
5158writeMediaWiki :: WriterOptions -> Pandoc -> String
5259writeMediaWiki opts document =
53− evalState (pandocToMediaWiki opts document)
54− WriterState { stNotes = False, stListLevel = [], stUseTags = False }
60+ let initialState = WriterState { stNotes = False }
61+ env = WriterReader { options = opts, stListLevel = [], stUseTags = False }
62+ in evalState (runReaderT (pandocToMediaWiki document) env) initialState
5563
5664-- | Return MediaWiki representation of document.
57−pandocToMediaWiki :: WriterOptions -> Pandoc -> State WriterState String
58−pandocToMediaWiki opts (Pandoc meta blocks) = do
65+pandocToMediaWiki :: Pandoc -> MediaWikiWriter String
66+pandocToMediaWiki (Pandoc meta blocks) = do
67+ opts <- asks options
5968 metadata <- metaToJSON opts
60− (fmap trimr . blockListToMediaWiki opts)
61− (inlineListToMediaWiki opts)
69+ (fmap trimr . blockListToMediaWiki)
70+ inlineListToMediaWiki
6271 meta
63− body <- blockListToMediaWiki opts blocks
64− notesExist <- get >>= return . stNotes
72+ body <- blockListToMediaWiki blocks
73+ notesExist <- gets stNotes
6574 let notes = if notesExist
6675 then "\n<references />"
6776 else ""
6877 let main = body ++ notes
6978 let context = defField "body" main
70− $ defField "toc" (writerTableOfContents opts)
71− $ metadata
72− if writerStandalone opts
73− then return $ renderTemplate' (writerTemplate opts) context
74− else return main
79+ $ defField "toc" (writerTableOfContents opts) metadata
80+ return $ if writerStandalone opts
81+ then renderTemplate' (writerTemplate opts) context
82+ else main
7583
7684-- | Escape special characters for MediaWiki.
7785escapeString :: String -> String
7886escapeString = escapeStringForXML
7987
8088-- | Convert Pandoc block element to MediaWiki.
81−blockToMediaWiki :: WriterOptions -- ^ Options
82− -> Block -- ^ Block element
83− -> State WriterState String
89+blockToMediaWiki :: Block -- ^ Block element
90+ -> MediaWikiWriter String
8491
85−blockToMediaWiki _ Null = return ""
92+blockToMediaWiki Null = return ""
8693
87−blockToMediaWiki opts (Div attrs bs) = do
88− contents <- blockListToMediaWiki opts bs
94+blockToMediaWiki (Div attrs bs) = do
95+ contents <- blockListToMediaWiki bs
8996 return $ render Nothing (tagWithAttrs "div" attrs) ++ "\n\n" ++
9097 contents ++ "\n\n" ++ "</div>"
9198
92−blockToMediaWiki opts (Plain inlines) =
93− inlineListToMediaWiki opts inlines
99+blockToMediaWiki (Plain inlines) =
100+ inlineListToMediaWiki inlines
94101
95102-- title beginning with fig: indicates that the image is a figure
96−blockToMediaWiki opts (Para [Image txt (src,'f':'i':'g':':':tit)]) = do
103+blockToMediaWiki (Para [Image txt (src,'f':'i':'g':':':tit)]) = do
97104 capt <- if null txt
98105 then return ""
99− else ("|caption " ++) `fmap` inlineListToMediaWiki opts txt
106+ else ("|caption " ++) `fmap` inlineListToMediaWiki txt
100107 let opt = if null txt
101108 then ""
102109 else "|alt=" ++ if null tit then capt else tit ++ capt
103110 return $ "[[Image:" ++ src ++ "|frame|none" ++ opt ++ "]]\n"
104111
105−blockToMediaWiki opts (Para inlines) = do
106− useTags <- get >>= return . stUseTags
107− listLevel <- get >>= return . stListLevel
108− contents <- inlineListToMediaWiki opts inlines
112+blockToMediaWiki (Para inlines) = do
113+ useTags <- asks stUseTags
114+ listLevel <- asks stListLevel
115+ contents <- inlineListToMediaWiki inlines
109116 return $ if useTags
110117 then "<p>" ++ contents ++ "</p>"
111118 else contents ++ if null listLevel then "\n" else ""
112119
113−blockToMediaWiki _ (RawBlock f str)
120+blockToMediaWiki (RawBlock f str)
114121 | f == Format "mediawiki" = return str
115122 | f == Format "html" = return str
116123 | otherwise = return ""
117124
118−blockToMediaWiki _ HorizontalRule = return "\n-----\n"
125+blockToMediaWiki HorizontalRule = return "\n-----\n"
119126
120−blockToMediaWiki opts (Header level _ inlines) = do
121− contents <- inlineListToMediaWiki opts inlines
127+blockToMediaWiki (Header level _ inlines) = do
128+ contents <- inlineListToMediaWiki inlines
122129 let eqs = replicate level '='
123130 return $ eqs ++ " " ++ contents ++ " " ++ eqs ++ "\n"
124131
125−blockToMediaWiki _ (CodeBlock (_,classes,_) str) = do
132+blockToMediaWiki (CodeBlock (_,classes,_) str) = do
126133 let at = classes `intersect` ["actionscript", "ada", "apache", "applescript", "asm", "asp",
127134 "autoit", "bash", "blitzbasic", "bnf", "c", "c_mac", "caddcl", "cadlisp", "cfdg", "cfm",
128135 "cpp", "cpp-qt", "csharp", "css", "d", "delphi", "diff", "div", "dos", "eiffel", "fortran",
@@ -137,69 +144,54 @@ blockToMediaWiki _ (CodeBlock (_,classes,_) str) = do
137144 else ("<source lang=\"" ++ head at ++ "\">", "</source>")
138145 return $ beg ++ escapeString str ++ end
139146
140−blockToMediaWiki opts (BlockQuote blocks) = do
141− contents <- blockListToMediaWiki opts blocks
147+blockToMediaWiki (BlockQuote blocks) = do
148+ contents <- blockListToMediaWiki blocks
142149 return $ "<blockquote>" ++ contents ++ "</blockquote>"
143150
144−blockToMediaWiki opts (Table capt aligns widths headers rows') = do
151+blockToMediaWiki (Table capt aligns widths headers rows') = do
145152 caption <- if null capt
146153 then return ""
147154 else do
148− c <- inlineListToMediaWiki opts capt
155+ c <- inlineListToMediaWiki capt
149156 return $ "|+ " ++ trimr c ++ "\n"
150157 let headless = all null headers
151158 let allrows = if headless then rows' else headers:rows'
152− tableBody <- (concat . intersperse "|-\n") `fmap`
153− mapM (tableRowToMediaWiki opts headless aligns widths)
159+ tableBody <- intercalate "|-\n" `fmap`
160+ mapM (tableRowToMediaWiki headless aligns widths)
154161 (zip [1..] allrows)
155162 return $ "{|\n" ++ caption ++ tableBody ++ "|}\n"
156163
157−blockToMediaWiki opts x@(BulletList items) = do
158− oldUseTags <- get >>= return . stUseTags
159− listLevel <- get >>= return . stListLevel
160− let useTags = oldUseTags || not (isSimpleList x)
164+blockToMediaWiki x@(BulletList items) = do
165+ useTags <- fmap (|| not (isSimpleList x)) $ asks stUseTags
161166 if useTags
162167 then do
163− modify $ \s -> s { stUseTags = True }
164− contents <- mapM (listItemToMediaWiki opts) items
165− modify $ \s -> s { stUseTags = oldUseTags }
168+ contents <- local (\ s -> s { stUseTags = True }) $ mapM listItemToMediaWiki items
166169 return $ "<ul>\n" ++ vcat contents ++ "</ul>\n"
167170 else do
168− modify $ \s -> s { stListLevel = stListLevel s ++ "*" }
169− contents <- mapM (listItemToMediaWiki opts) items
170− modify $ \s -> s { stListLevel = init (stListLevel s) }
171+ listLevel <- asks stListLevel
172+ contents <- local (\s -> s { stListLevel = stListLevel s ++ "*" }) $ mapM listItemToMediaWiki items
171173 return $ vcat contents ++ if null listLevel then "\n" else ""
172174
173−blockToMediaWiki opts x@(OrderedList attribs items) = do
174− oldUseTags <- get >>= return . stUseTags
175− listLevel <- get >>= return . stListLevel
176− let useTags = oldUseTags || not (isSimpleList x)
175+blockToMediaWiki x@(OrderedList attribs items) = do
176+ useTags <- fmap (|| not (isSimpleList x)) $ asks stUseTags
177177 if useTags
178178 then do
179− modify $ \s -> s { stUseTags = True }
180− contents <- mapM (listItemToMediaWiki opts) items
181− modify $ \s -> s { stUseTags = oldUseTags }
179+ contents <- local (\s -> s { stUseTags = True }) $ mapM listItemToMediaWiki items
182180 return $ "<ol" ++ listAttribsToString attribs ++ ">\n" ++ vcat contents ++ "</ol>\n"
183181 else do
184− modify $ \s -> s { stListLevel = stListLevel s ++ "#" }
185− contents <- mapM (listItemToMediaWiki opts) items
186− modify $ \s -> s { stListLevel = init (stListLevel s) }
182+ listLevel <- asks stListLevel
183+ contents <- local (\s -> s { stListLevel = stListLevel s ++ "#" }) $ mapM listItemToMediaWiki items
187184 return $ vcat contents ++ if null listLevel then "\n" else ""
188185
189−blockToMediaWiki opts x@(DefinitionList items) = do
190− oldUseTags <- get >>= return . stUseTags
191− listLevel <- get >>= return . stListLevel
192− let useTags = oldUseTags || not (isSimpleList x)
186+blockToMediaWiki x@(DefinitionList items) = do
187+ useTags <- fmap (|| not (isSimpleList x)) $ asks stUseTags
193188 if useTags
194189 then do
195− modify $ \s -> s { stUseTags = True }
196− contents <- mapM (definitionListItemToMediaWiki opts) items
197− modify $ \s -> s { stUseTags = oldUseTags }
190+ contents <- local (\s -> s { stUseTags = True }) $ mapM definitionListItemToMediaWiki items
198191 return $ "<dl>\n" ++ vcat contents ++ "</dl>\n"
199192 else do
200− modify $ \s -> s { stListLevel = stListLevel s ++ ";" }
201− contents <- mapM (definitionListItemToMediaWiki opts) items
202− modify $ \s -> s { stListLevel = init (stListLevel s) }
193+ listLevel <- asks stListLevel
194+ contents <- local (\s -> s { stListLevel = stListLevel s ++ ";" }) $ mapM definitionListItemToMediaWiki items
203195 return $ vcat contents ++ if null listLevel then "\n" else ""
204196
205197-- Auxiliary functions for lists:
@@ -216,31 +208,30 @@ listAttribsToString (startnum, numstyle, _) =
216208 else "")
217209
218210-- | Convert bullet or ordered list item (list of blocks) to MediaWiki.
219−listItemToMediaWiki :: WriterOptions -> [Block] -> State WriterState String
220−listItemToMediaWiki opts items = do
221− contents <- blockListToMediaWiki opts items
222− useTags <- get >>= return . stUseTags
211+listItemToMediaWiki :: [Block] -> MediaWikiWriter String
212+listItemToMediaWiki items = do
213+ contents <- blockListToMediaWiki items
214+ useTags <- asks stUseTags
223215 if useTags
224216 then return $ "<li>" ++ contents ++ "</li>"
225217 else do
226− marker <- get >>= return . stListLevel
218+ marker <- asks stListLevel
227219 return $ marker ++ " " ++ contents
228220
229221-- | Convert definition list item (label, list of blocks) to MediaWiki.
230−definitionListItemToMediaWiki :: WriterOptions
231− -> ([Inline],[[Block]])
232− -> State WriterState String
233−definitionListItemToMediaWiki opts (label, items) = do
234− labelText <- inlineListToMediaWiki opts label
235− contents <- mapM (blockListToMediaWiki opts) items
236− useTags <- get >>= return . stUseTags
222+definitionListItemToMediaWiki :: ([Inline],[[Block]])
223+ -> MediaWikiWriter String
224+definitionListItemToMediaWiki (label, items) = do
225+ labelText <- inlineListToMediaWiki label
226+ contents <- mapM blockListToMediaWiki items
227+ useTags <- asks stUseTags
237228 if useTags
238229 then return $ "<dt>" ++ labelText ++ "</dt>\n" ++
239− (intercalate "\n" $ map (\d -> "<dd>" ++ d ++ "</dd>") contents)
230+ intercalate "\n" (map (\d -> "<dd>" ++ d ++ "</dd>") contents)
240231 else do
241− marker <- get >>= return . stListLevel
232+ marker <- asks stListLevel
242233 return $ marker ++ " " ++ labelText ++ "\n" ++
243− (intercalate "\n" $ map (\d -> init marker ++ ": " ++ d) contents)
234+ intercalate "\n" (map (\d -> init marker ++ ": " ++ d) contents)
244235
245236-- | True if the list can be handled by simple wiki markup, False if HTML tags will be needed.
246237isSimpleList :: Block -> Bool
@@ -283,25 +274,22 @@ vcat = intercalate "\n"
283274
284275-- Auxiliary functions for tables:
285276
286−tableRowToMediaWiki :: WriterOptions
287− -> Bool
277+tableRowToMediaWiki :: Bool
288278 -> [Alignment]
289279 -> [Double]
290280 -> (Int, [[Block]])
291− -> State WriterState String
292−tableRowToMediaWiki opts headless alignments widths (rownum, cells) = do
293− cells' <- mapM (\cellData ->
294− tableCellToMediaWiki opts headless rownum cellData)
281+ -> MediaWikiWriter String
282+tableRowToMediaWiki headless alignments widths (rownum, cells) = do
283+ cells' <- mapM (tableCellToMediaWiki headless rownum)
295284 $ zip3 alignments widths cells
296285 return $ unlines cells'
297286
298−tableCellToMediaWiki :: WriterOptions
299− -> Bool
287+tableCellToMediaWiki :: Bool
300288 -> Int
301289 -> (Alignment, Double, [Block])
302− -> State WriterState String
303−tableCellToMediaWiki opts headless rownum (alignment, width, bs) = do
304− contents <- blockListToMediaWiki opts bs
290+ -> MediaWikiWriter String
291+tableCellToMediaWiki headless rownum (alignment, width, bs) = do
292+ contents <- blockListToMediaWiki bs
305293 let marker = if rownum == 1 && not headless then "!" else "|"
306294 let percent w = show (truncate (100*w) :: Integer) ++ "%"
307295 let attrs = ["align=" ++ show (alignmentToString alignment) |
@@ -313,7 +301,7 @@ tableCellToMediaWiki opts headless rownum (alignment, width, bs) = do
313301 else unwords attrs ++ "|"
314302 return $ marker ++ attr ++ trimr contents
315303
316−alignmentToString :: Alignment -> [Char]
304+alignmentToString :: Alignment -> String
317305alignmentToString alignment = case alignment of
318306 AlignLeft -> "left"
319307 AlignRight -> "right"
@@ -321,94 +309,94 @@ alignmentToString alignment = case alignment of
321309 AlignDefault -> "left"
322310
323311-- | Convert list of Pandoc block elements to MediaWiki.
324−blockListToMediaWiki :: WriterOptions -- ^ Options
325− -> [Block] -- ^ List of block elements
326− -> State WriterState String
327−blockListToMediaWiki opts blocks =
328− mapM (blockToMediaWiki opts) blocks >>= return . vcat
312+blockListToMediaWiki :: [Block] -- ^ List of block elements
313+ -> MediaWikiWriter String
314+blockListToMediaWiki blocks =
315+ fmap vcat $ mapM blockToMediaWiki blocks
329316
330317-- | Convert list of Pandoc inline elements to MediaWiki.
331−inlineListToMediaWiki :: WriterOptions -> [Inline] -> State WriterState String
332−inlineListToMediaWiki opts lst =
333− mapM (inlineToMediaWiki opts) lst >>= return . concat
318+inlineListToMediaWiki :: [Inline] -> MediaWikiWriter String
319+inlineListToMediaWiki lst =
320+ fmap concat $ mapM inlineToMediaWiki lst
334321
335322-- | Convert Pandoc inline element to MediaWiki.
336−inlineToMediaWiki :: WriterOptions -> Inline -> State WriterState String
323+inlineToMediaWiki :: Inline -> MediaWikiWriter String
337324
338−inlineToMediaWiki opts (Span attrs ils) = do
339− contents <- inlineListToMediaWiki opts ils
325+inlineToMediaWiki (Span attrs ils) = do
326+ contents <- inlineListToMediaWiki ils
340327 return $ render Nothing (tagWithAttrs "span" attrs) ++ contents ++ "</span>"
341328
342−inlineToMediaWiki opts (Emph lst) = do
343− contents <- inlineListToMediaWiki opts lst
329+inlineToMediaWiki (Emph lst) = do
330+ contents <- inlineListToMediaWiki lst
344331 return $ "''" ++ contents ++ "''"
345332
346−inlineToMediaWiki opts (Strong lst) = do
347− contents <- inlineListToMediaWiki opts lst
333+inlineToMediaWiki (Strong lst) = do
334+ contents <- inlineListToMediaWiki lst
348335 return $ "'''" ++ contents ++ "'''"
349336
350−inlineToMediaWiki opts (Strikeout lst) = do
351− contents <- inlineListToMediaWiki opts lst
337+inlineToMediaWiki (Strikeout lst) = do
338+ contents <- inlineListToMediaWiki lst
352339 return $ "<s>" ++ contents ++ "</s>"
353340
354−inlineToMediaWiki opts (Superscript lst) = do
355− contents <- inlineListToMediaWiki opts lst
341+inlineToMediaWiki (Superscript lst) = do
342+ contents <- inlineListToMediaWiki lst
356343 return $ "<sup>" ++ contents ++ "</sup>"
357344
358−inlineToMediaWiki opts (Subscript lst) = do
359− contents <- inlineListToMediaWiki opts lst
345+inlineToMediaWiki (Subscript lst) = do
346+ contents <- inlineListToMediaWiki lst
360347 return $ "<sub>" ++ contents ++ "</sub>"
361348
362−inlineToMediaWiki opts (SmallCaps lst) = inlineListToMediaWiki opts lst
349+inlineToMediaWiki (SmallCaps lst) = inlineListToMediaWiki lst
363350
364−inlineToMediaWiki opts (Quoted SingleQuote lst) = do
365− contents <- inlineListToMediaWiki opts lst
351+inlineToMediaWiki (Quoted SingleQuote lst) = do
352+ contents <- inlineListToMediaWiki lst
366353 return $ "\8216" ++ contents ++ "\8217"
367354
368−inlineToMediaWiki opts (Quoted DoubleQuote lst) = do
369− contents <- inlineListToMediaWiki opts lst
355+inlineToMediaWiki (Quoted DoubleQuote lst) = do
356+ contents <- inlineListToMediaWiki lst
370357 return $ "\8220" ++ contents ++ "\8221"
371358
372−inlineToMediaWiki opts (Cite _ lst) = inlineListToMediaWiki opts lst
359+inlineToMediaWiki (Cite _ lst) = inlineListToMediaWiki lst
373360
374−inlineToMediaWiki _ (Code _ str) =
375− return $ "<code>" ++ (escapeString str) ++ "</code>"
361+inlineToMediaWiki (Code _ str) =
362+ return $ "<code>" ++ escapeString str ++ "</code>"
376363
377−inlineToMediaWiki _ (Str str) = return $ escapeString str
364+inlineToMediaWiki (Str str) = return $ escapeString str
378365
379−inlineToMediaWiki _ (Math _ str) = return $ "<math>" ++ str ++ "</math>"
380− -- note: str should NOT be escaped
366+inlineToMediaWiki (Math _ str) = return $ "<math>" ++ str ++ "</math>"
367+ -- note: str should NOT be escaped
381368
382−inlineToMediaWiki _ (RawInline f str)
369+inlineToMediaWiki (RawInline f str)
383370 | f == Format "mediawiki" = return str
384371 | f == Format "html" = return str
385372 | otherwise = return ""
386373
387−inlineToMediaWiki _ (LineBreak) = return "<br />"
374+inlineToMediaWiki (LineBreak) = return "<br />"
388375
389−inlineToMediaWiki _ Space = return " "
376+inlineToMediaWiki Space = return " "
390377
391−inlineToMediaWiki opts (Link txt (src, _)) = do
392− label <- inlineListToMediaWiki opts txt
378+inlineToMediaWiki (Link txt (src, _)) = do
379+ label <- inlineListToMediaWiki txt
393380 case txt of
394381 [Str s] | escapeURI s == src -> return src
395− _ -> if isURI src
396− then return $ "[" ++ src ++ " " ++ label ++ "]"
397− else return $ "[[" ++ src' ++ "|" ++ label ++ "]]"
382+ _ -> return $ if isURI src
383+ then "[" ++ src ++ " " ++ label ++ "]"
384+ else "[[" ++ src' ++ "|" ++ label ++ "]]"
398385 where src' = case src of
399386 '/':xs -> xs -- with leading / it's a
400387 _ -> src -- link to a help page
401−inlineToMediaWiki opts (Image alt (source, tit)) = do
402− alt' <- inlineListToMediaWiki opts alt
403− let txt = if (null tit)
388+
389+inlineToMediaWiki (Image alt (source, tit)) = do
390+ alt' <- inlineListToMediaWiki alt
391+ let txt = if null tit
404392 then if null alt
405393 then ""
406− else "|" ++ alt'
407− else "|" ++ tit
394+ else '|' : alt'
395+ else '|' : tit
408396 return $ "[[Image:" ++ source ++ txt ++ "]]"
409397
410−inlineToMediaWiki opts (Note contents) = do
411− contents' <- blockListToMediaWiki opts contents
398+inlineToMediaWiki (Note contents) = do
399+ contents' <- blockListToMediaWiki contents
412400 modify (\s -> s { stNotes = True })
413401 return $ "<ref>" ++ contents' ++ "</ref>"
414402 -- note - may not work for notes with multiple blocks