@@ -0,0 +1,407 @@
1+{-
2+Copyright (C) 2008-2010 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.DokuWiki
21+ Copyright : Copyright (C) 2008-2010 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 DokuWiki markup.
29+
30+DokuWiki: <https://www.dokuwiki.org/dokuwiki>
31+-}
32+module Text.Pandoc.Writers.DokuWiki ( writeDokuWiki ) where
33+import Text.Pandoc.Definition
34+import Text.Pandoc.Options
35+import Text.Pandoc.Shared
36+import Text.Pandoc.Writers.Shared
37+import Text.Pandoc.Templates (renderTemplate')
38+import Text.Pandoc.XML ( escapeStringForXML )
39+import Data.List ( intersect, intercalate )
40+import Network.URI ( isURI )
41+import Control.Monad.State
42+
43+data WriterState = WriterState {
44+ stNotes :: Bool -- True if there are notes
45+ , stListLevel :: [Char] -- String at beginning of list items, e.g. "**"
46+ , stUseTags :: Bool -- True if we should use HTML tags because we're in a complex list
47+ }
48+
49+-- | Convert Pandoc to DokuWiki.
50+writeDokuWiki :: WriterOptions -> Pandoc -> String
51+writeDokuWiki opts document =
52+ evalState (pandocToDokuWiki opts document)
53+ (WriterState { stNotes = False, stListLevel = [], stUseTags = False })
54+
55+-- | Return DokuWiki representation of document.
56+pandocToDokuWiki :: WriterOptions -> Pandoc -> State WriterState String
57+pandocToDokuWiki opts (Pandoc meta blocks) = do
58+ metadata <- metaToJSON opts
59+ (fmap trimr . blockListToDokuWiki opts)
60+ (inlineListToDokuWiki opts)
61+ meta
62+ body <- blockListToDokuWiki opts blocks
63+ notesExist <- get >>= return . stNotes
64+ let notes = if notesExist
65+ then "\n<references />"
66+ else ""
67+ let main = body ++ notes
68+ let context = defField "body" main
69+ $ defField "toc" (writerTableOfContents opts)
70+ $ metadata
71+ if writerStandalone opts
72+ then return $ renderTemplate' (writerTemplate opts) context
73+ else return main
74+
75+-- | Escape special characters for DokuWiki.
76+escapeString :: String -> String
77+escapeString = escapeStringForXML
78+
79+-- | Convert Pandoc block element to DokuWiki.
80+blockToDokuWiki :: WriterOptions -- ^ Options
81+ -> Block -- ^ Block element
82+ -> State WriterState String
83+
84+blockToDokuWiki _ Null = return ""
85+
86+blockToDokuWiki opts (Plain inlines) =
87+ inlineListToDokuWiki opts inlines
88+
89+-- title beginning with fig: indicates that the image is a figure
90+blockToDokuWiki opts (Para [Image txt (src,'f':'i':'g':':':tit)]) = do
91+ capt <- if null txt
92+ then return ""
93+ else ("|caption " ++) `fmap` inlineListToDokuWiki opts txt
94+ let opt = if null txt
95+ then ""
96+ else "|alt=" ++ if null tit then capt else tit ++ capt
97+ return $ "[[Image:" ++ src ++ "|frame|none" ++ opt ++ "]]\n"
98+
99+blockToDokuWiki opts (Para inlines) = do
100+ useTags <- get >>= return . stUseTags
101+ listLevel <- get >>= return . stListLevel
102+ contents <- inlineListToDokuWiki opts inlines
103+ return $ if useTags
104+ then "<p>" ++ contents ++ "</p>"
105+ else contents ++ if null listLevel then "\n" else ""
106+
107+blockToDokuWiki _ (RawBlock "mediawiki" str) = return str
108+blockToDokuWiki _ (RawBlock "html" str) = return str
109+blockToDokuWiki _ (RawBlock _ _) = return ""
110+
111+blockToDokuWiki _ HorizontalRule = return "\n-----\n"
112+
113+blockToDokuWiki opts (Header level _ inlines) = do
114+ contents <- inlineListToDokuWiki opts inlines
115+ let eqs = replicate level '='
116+ return $ eqs ++ " " ++ contents ++ " " ++ eqs ++ "\n"
117+
118+blockToDokuWiki _ (CodeBlock (_,classes,_) str) = do
119+ let at = classes `intersect` ["actionscript", "ada", "apache", "applescript", "asm", "asp",
120+ "autoit", "bash", "blitzbasic", "bnf", "c", "c_mac", "caddcl", "cadlisp", "cfdg", "cfm",
121+ "cpp", "cpp-qt", "csharp", "css", "d", "delphi", "diff", "div", "dos", "eiffel", "fortran",
122+ "freebasic", "gml", "groovy", "html4strict", "idl", "ini", "inno", "io", "java", "java5",
123+ "javascript", "latex", "lisp", "lua", "matlab", "mirc", "mpasm", "mysql", "nsis", "objc",
124+ "ocaml", "ocaml-brief", "oobas", "oracle8", "pascal", "perl", "php", "php-brief", "plsql",
125+ "python", "qbasic", "rails", "reg", "robots", "ruby", "sas", "scheme", "sdlbasic",
126+ "smalltalk", "smarty", "sql", "tcl", "", "thinbasic", "tsql", "vb", "vbnet", "vhdl",
127+ "visualfoxpro", "winbatch", "xml", "xpp", "z80"]
128+ let (beg, end) = if null at
129+ then ("<pre" ++ if null classes then ">" else " class=\"" ++ unwords classes ++ "\">", "</pre>")
130+ else ("<source lang=\"" ++ head at ++ "\">", "</source>")
131+ return $ beg ++ escapeString str ++ end
132+
133+blockToDokuWiki opts (BlockQuote blocks) = do
134+ contents <- blockListToDokuWiki opts blocks
135+ return $ "<blockquote>" ++ contents ++ "</blockquote>"
136+
137+blockToDokuWiki opts (Table capt aligns widths headers rows') = do
138+ let alignStrings = map alignmentToString aligns
139+ captionDoc <- if null capt
140+ then return ""
141+ else do
142+ c <- inlineListToDokuWiki opts capt
143+ return $ "<caption>" ++ c ++ "</caption>\n"
144+ let percent w = show (truncate (100*w) :: Integer) ++ "%"
145+ let coltags = if all (== 0.0) widths
146+ then ""
147+ else unlines $ map
148+ (\w -> "<col width=\"" ++ percent w ++ "\" />") widths
149+ head' <- if all null headers
150+ then return ""
151+ else do
152+ hs <- tableRowToDokuWiki opts alignStrings 0 headers
153+ return $ "<thead>\n" ++ hs ++ "\n</thead>\n"
154+ body' <- zipWithM (tableRowToDokuWiki opts alignStrings) [1..] rows'
155+ return $ "<table>\n" ++ captionDoc ++ coltags ++ head' ++
156+ "<tbody>\n" ++ unlines body' ++ "</tbody>\n</table>\n"
157+
158+blockToDokuWiki opts x@(BulletList items) = do
159+ oldUseTags <- get >>= return . stUseTags
160+ listLevel <- get >>= return . stListLevel
161+ let useTags = oldUseTags || not (isSimpleList x)
162+ if useTags
163+ then do
164+ modify $ \s -> s { stUseTags = True }
165+ contents <- mapM (listItemToDokuWiki opts) items
166+ modify $ \s -> s { stUseTags = oldUseTags }
167+ return $ "<ul>\n" ++ vcat contents ++ "</ul>\n"
168+ else do
169+ modify $ \s -> s { stListLevel = stListLevel s ++ "*" }
170+ contents <- mapM (listItemToDokuWiki opts) items
171+ modify $ \s -> s { stListLevel = init (stListLevel s) }
172+ return $ vcat contents ++ if null listLevel then "\n" else ""
173+
174+blockToDokuWiki opts x@(OrderedList attribs items) = do
175+ oldUseTags <- get >>= return . stUseTags
176+ listLevel <- get >>= return . stListLevel
177+ let useTags = oldUseTags || not (isSimpleList x)
178+ if useTags
179+ then do
180+ modify $ \s -> s { stUseTags = True }
181+ contents <- mapM (listItemToDokuWiki opts) items
182+ modify $ \s -> s { stUseTags = oldUseTags }
183+ return $ "<ol" ++ listAttribsToString attribs ++ ">\n" ++ vcat contents ++ "</ol>\n"
184+ else do
185+ modify $ \s -> s { stListLevel = stListLevel s ++ "#" }
186+ contents <- mapM (listItemToDokuWiki opts) items
187+ modify $ \s -> s { stListLevel = init (stListLevel s) }
188+ return $ vcat contents ++ if null listLevel then "\n" else ""
189+
190+blockToDokuWiki opts x@(DefinitionList items) = do
191+ oldUseTags <- get >>= return . stUseTags
192+ listLevel <- get >>= return . stListLevel
193+ let useTags = oldUseTags || not (isSimpleList x)
194+ if useTags
195+ then do
196+ modify $ \s -> s { stUseTags = True }
197+ contents <- mapM (definitionListItemToDokuWiki opts) items
198+ modify $ \s -> s { stUseTags = oldUseTags }
199+ return $ "<dl>\n" ++ vcat contents ++ "</dl>\n"
200+ else do
201+ modify $ \s -> s { stListLevel = stListLevel s ++ ";" }
202+ contents <- mapM (definitionListItemToDokuWiki opts) items
203+ modify $ \s -> s { stListLevel = init (stListLevel s) }
204+ return $ vcat contents ++ if null listLevel then "\n" else ""
205+
206+-- Auxiliary functions for lists:
207+
208+-- | Convert ordered list attributes to HTML attribute string
209+listAttribsToString :: ListAttributes -> String
210+listAttribsToString (startnum, numstyle, _) =
211+ let numstyle' = camelCaseToHyphenated $ show numstyle
212+ in (if startnum /= 1
213+ then " start=\"" ++ show startnum ++ "\""
214+ else "") ++
215+ (if numstyle /= DefaultStyle
216+ then " style=\"list-style-type: " ++ numstyle' ++ ";\""
217+ else "")
218+
219+-- | Convert bullet or ordered list item (list of blocks) to DokuWiki.
220+listItemToDokuWiki :: WriterOptions -> [Block] -> State WriterState String
221+listItemToDokuWiki opts items = do
222+ contents <- blockListToDokuWiki opts items
223+ useTags <- get >>= return . stUseTags
224+ if useTags
225+ then return $ "<li>" ++ contents ++ "</li>"
226+ else do
227+ marker <- get >>= return . stListLevel
228+ return $ marker ++ " " ++ contents
229+
230+-- | Convert definition list item (label, list of blocks) to DokuWiki.
231+definitionListItemToDokuWiki :: WriterOptions
232+ -> ([Inline],[[Block]])
233+ -> State WriterState String
234+definitionListItemToDokuWiki opts (label, items) = do
235+ labelText <- inlineListToDokuWiki opts label
236+ contents <- mapM (blockListToDokuWiki opts) items
237+ useTags <- get >>= return . stUseTags
238+ if useTags
239+ then return $ "<dt>" ++ labelText ++ "</dt>\n" ++
240+ (intercalate "\n" $ map (\d -> "<dd>" ++ d ++ "</dd>") contents)
241+ else do
242+ marker <- get >>= return . stListLevel
243+ return $ marker ++ " " ++ labelText ++ "\n" ++
244+ (intercalate "\n" $ map (\d -> init marker ++ ": " ++ d) contents)
245+
246+-- | True if the list can be handled by simple wiki markup, False if HTML tags will be needed.
247+isSimpleList :: Block -> Bool
248+isSimpleList x =
249+ case x of
250+ BulletList items -> all isSimpleListItem items
251+ OrderedList (num, sty, _) items -> all isSimpleListItem items &&
252+ num == 1 && sty `elem` [DefaultStyle, Decimal]
253+ DefinitionList items -> all isSimpleListItem $ concatMap snd items
254+ _ -> False
255+
256+-- | True if list item can be handled with the simple wiki syntax. False if
257+-- HTML tags will be needed.
258+isSimpleListItem :: [Block] -> Bool
259+isSimpleListItem [] = True
260+isSimpleListItem [x] =
261+ case x of
262+ Plain _ -> True
263+ Para _ -> True
264+ BulletList _ -> isSimpleList x
265+ OrderedList _ _ -> isSimpleList x
266+ DefinitionList _ -> isSimpleList x
267+ _ -> False
268+isSimpleListItem [x, y] | isPlainOrPara x =
269+ case y of
270+ BulletList _ -> isSimpleList y
271+ OrderedList _ _ -> isSimpleList y
272+ DefinitionList _ -> isSimpleList y
273+ _ -> False
274+isSimpleListItem _ = False
275+
276+isPlainOrPara :: Block -> Bool
277+isPlainOrPara (Plain _) = True
278+isPlainOrPara (Para _) = True
279+isPlainOrPara _ = False
280+
281+-- | Concatenates strings with line breaks between them.
282+vcat :: [String] -> String
283+vcat = intercalate "\n"
284+
285+-- Auxiliary functions for tables:
286+
287+tableRowToDokuWiki :: WriterOptions
288+ -> [String]
289+ -> Int
290+ -> [[Block]]
291+ -> State WriterState String
292+tableRowToDokuWiki opts alignStrings rownum cols' = do
293+ let celltype = if rownum == 0 then "th" else "td"
294+ let rowclass = case rownum of
295+ 0 -> "header"
296+ x | x `rem` 2 == 1 -> "odd"
297+ _ -> "even"
298+ cols'' <- sequence $ zipWith
299+ (\alignment item -> tableItemToDokuWiki opts celltype alignment item)
300+ alignStrings cols'
301+ return $ "<tr class=\"" ++ rowclass ++ "\">\n" ++ unlines cols'' ++ "</tr>"
302+
303+alignmentToString :: Alignment -> [Char]
304+alignmentToString alignment = case alignment of
305+ AlignLeft -> "left"
306+ AlignRight -> "right"
307+ AlignCenter -> "center"
308+ AlignDefault -> "left"
309+
310+tableItemToDokuWiki :: WriterOptions
311+ -> String
312+ -> String
313+ -> [Block]
314+ -> State WriterState String
315+tableItemToDokuWiki opts celltype align' item = do
316+ let mkcell x = "<" ++ celltype ++ " align=\"" ++ align' ++ "\">" ++
317+ x ++ "</" ++ celltype ++ ">"
318+ contents <- blockListToDokuWiki opts item
319+ return $ mkcell contents
320+
321+-- | Convert list of Pandoc block elements to DokuWiki.
322+blockListToDokuWiki :: WriterOptions -- ^ Options
323+ -> [Block] -- ^ List of block elements
324+ -> State WriterState String
325+blockListToDokuWiki opts blocks =
326+ mapM (blockToDokuWiki opts) blocks >>= return . vcat
327+
328+-- | Convert list of Pandoc inline elements to DokuWiki.
329+inlineListToDokuWiki :: WriterOptions -> [Inline] -> State WriterState String
330+inlineListToDokuWiki opts lst =
331+ mapM (inlineToDokuWiki opts) lst >>= return . concat
332+
333+-- | Convert Pandoc inline element to DokuWiki.
334+inlineToDokuWiki :: WriterOptions -> Inline -> State WriterState String
335+
336+inlineToDokuWiki opts (Emph lst) = do
337+ contents <- inlineListToDokuWiki opts lst
338+ return $ "''" ++ contents ++ "''"
339+
340+inlineToDokuWiki opts (Strong lst) = do
341+ contents <- inlineListToDokuWiki opts lst
342+ return $ "'''" ++ contents ++ "'''"
343+
344+inlineToDokuWiki opts (Strikeout lst) = do
345+ contents <- inlineListToDokuWiki opts lst
346+ return $ "<s>" ++ contents ++ "</s>"
347+
348+inlineToDokuWiki opts (Superscript lst) = do
349+ contents <- inlineListToDokuWiki opts lst
350+ return $ "<sup>" ++ contents ++ "</sup>"
351+
352+inlineToDokuWiki opts (Subscript lst) = do
353+ contents <- inlineListToDokuWiki opts lst
354+ return $ "<sub>" ++ contents ++ "</sub>"
355+
356+inlineToDokuWiki opts (SmallCaps lst) = inlineListToDokuWiki opts lst
357+
358+inlineToDokuWiki opts (Quoted SingleQuote lst) = do
359+ contents <- inlineListToDokuWiki opts lst
360+ return $ "\8216" ++ contents ++ "\8217"
361+
362+inlineToDokuWiki opts (Quoted DoubleQuote lst) = do
363+ contents <- inlineListToDokuWiki opts lst
364+ return $ "\8220" ++ contents ++ "\8221"
365+
366+inlineToDokuWiki opts (Cite _ lst) = inlineListToDokuWiki opts lst
367+
368+inlineToDokuWiki _ (Code _ str) =
369+ return $ "<code>" ++ (escapeString str) ++ "</code>"
370+
371+inlineToDokuWiki _ (Str str) = return $ escapeString str
372+
373+inlineToDokuWiki _ (Math _ str) = return $ "<math>" ++ str ++ "</math>"
374+ -- note: str should NOT be escaped
375+
376+inlineToDokuWiki _ (RawInline "mediawiki" str) = return str
377+inlineToDokuWiki _ (RawInline "html" str) = return str
378+inlineToDokuWiki _ (RawInline _ _) = return ""
379+
380+inlineToDokuWiki _ (LineBreak) = return "<br />"
381+
382+inlineToDokuWiki _ Space = return " "
383+
384+inlineToDokuWiki opts (Link txt (src, _)) = do
385+ label <- inlineListToDokuWiki opts txt
386+ case txt of
387+ [Str s] | escapeURI s == src -> return src
388+ _ -> if isURI src
389+ then return $ "[" ++ src ++ " " ++ label ++ "]"
390+ else return $ "[[" ++ src' ++ "|" ++ label ++ "]]"
391+ where src' = case src of
392+ '/':xs -> xs -- with leading / it's a
393+ _ -> src -- link to a help page
394+inlineToDokuWiki opts (Image alt (source, tit)) = do
395+ alt' <- inlineListToDokuWiki opts alt
396+ let txt = if (null tit)
397+ then if null alt
398+ then ""
399+ else "|" ++ alt'
400+ else "|" ++ tit
401+ return $ "[[Image:" ++ source ++ txt ++ "]]"
402+
403+inlineToDokuWiki opts (Note contents) = do
404+ contents' <- blockListToDokuWiki opts contents
405+ modify (\s -> s { stNotes = True })
406+ return $ "<ref>" ++ contents' ++ "</ref>"
407+ -- note - may not work for notes with multiple blocks