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