@@ -0,0 +1,415 @@
1+{-
2+Copyright (C) 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.Textile
21+ Copyright : Copyright (C) 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 Textile markup.
29+
30+Textile: <http://thresholdstate.com/articles/4312/the-textile-reference-manual>
31+-}
32+module Text.Pandoc.Writers.Textile ( writeTextile ) 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 ( intercalate )
38+import Control.Monad.State
39+import Data.Char ( isSpace )
40+
41+data WriterState = WriterState {
42+ stNotes :: [String] -- Footnotes
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 Textile.
48+writeTextile :: WriterOptions -> Pandoc -> String
49+writeTextile opts document =
50+ evalState (pandocToTextile opts document)
51+ (WriterState { stNotes = [], stListLevel = [], stUseTags = False })
52+
53+-- | Return Textile representation of document.
54+pandocToTextile :: WriterOptions -> Pandoc -> State WriterState String
55+pandocToTextile opts (Pandoc _ blocks) = do
56+ body <- blockListToTextile opts blocks
57+ notes <- liftM (unlines . reverse . stNotes) get
58+ let main = body ++ if null notes then "" else ("\n\n" ++ notes)
59+ let context = writerVariables opts ++ [ ("body", main) ]
60+ if writerStandalone opts
61+ then return $ renderTemplate context $ writerTemplate opts
62+ else return main
63+
64+withUseTags :: State WriterState a -> State WriterState a
65+withUseTags action = do
66+ oldUseTags <- liftM stUseTags get
67+ modify $ \s -> s { stUseTags = True }
68+ result <- action
69+ modify $ \s -> s { stUseTags = oldUseTags }
70+ return result
71+
72+-- | Escape one character as needed for Textile.
73+escapeCharForTextile :: Char -> String
74+escapeCharForTextile x = case x of
75+ '&' -> "&"
76+ '<' -> "<"
77+ '>' -> ">"
78+ '"' -> """
79+ '*' -> "*"
80+ '_' -> "_"
81+ '@' -> "@"
82+ '|' -> "|"
83+ c -> [c]
84+
85+-- | Escape string as needed for Textile.
86+escapeStringForTextile :: String -> String
87+escapeStringForTextile = concatMap escapeCharForTextile
88+
89+-- | Convert Pandoc block element to Textile.
90+blockToTextile :: WriterOptions -- ^ Options
91+ -> Block -- ^ Block element
92+ -> State WriterState String
93+
94+blockToTextile _ Null = return ""
95+
96+blockToTextile opts (Plain inlines) =
97+ inlineListToTextile opts inlines
98+
99+blockToTextile opts (Para [Image txt (src,tit)]) = do
100+ capt <- blockToTextile opts (Para txt)
101+ im <- inlineToTextile opts (Image txt (src,tit))
102+ return $ im ++ "\n" ++ capt
103+
104+blockToTextile opts (Para inlines) = do
105+ useTags <- liftM stUseTags get
106+ listLevel <- liftM stListLevel get
107+ contents <- inlineListToTextile opts inlines
108+ return $ if useTags
109+ then " <p>" ++ contents ++ "</p>"
110+ else contents ++ if null listLevel then "\n" else ""
111+
112+blockToTextile _ (RawHtml str) = return str
113+
114+blockToTextile _ HorizontalRule = return "<hr />\n"
115+
116+blockToTextile opts (Header level inlines) = do
117+ contents <- inlineListToTextile opts inlines
118+ let prefix = 'h' : (show level ++ ". ")
119+ return $ prefix ++ contents ++ "\n"
120+
121+blockToTextile _ (CodeBlock (_,classes,_) str) =
122+ return $ "bc" ++ classes' ++ dots ++ escapeStringForXML str ++ "\n"
123+ where classes' = if null classes
124+ then ""
125+ else "(" ++ unwords classes ++ ")"
126+ dots = if any isBlank (lines str)
127+ then ".. "
128+ else ". "
129+ isBlank = all isSpace
130+
131+blockToTextile opts (BlockQuote bs@[Para _]) = do
132+ contents <- blockListToTextile opts bs
133+ return $ "bq. " ++ contents
134+
135+blockToTextile opts (BlockQuote blocks) = do
136+ contents <- blockListToTextile opts blocks
137+ return $ "<blockquote>\n\n" ++ contents ++ "\n</blockquote>\n"
138+
139+blockToTextile opts (Table [] aligns widths headers rows') |
140+ all (==0) widths && all (`elem` [AlignLeft,AlignDefault]) aligns = do
141+ hs <- mapM (liftM (("_. " ++) . stripTrailingNewlines) . blockListToTextile opts) headers
142+ let cellsToRow cells = "|" ++ intercalate "|" cells ++ "|"
143+ let header = if all null headers then "" else cellsToRow hs
144+ let rowToCells = mapM (liftM stripTrailingNewlines . blockListToTextile opts)
145+ bs <- mapM rowToCells rows'
146+ let body = unlines $ map cellsToRow bs
147+ return $ header ++ "\n" ++ body ++ "\n"
148+
149+blockToTextile opts (Table capt aligns widths headers rows') = do
150+ let alignStrings = map alignmentToString aligns
151+ captionDoc <- if null capt
152+ then return ""
153+ else do
154+ c <- inlineListToTextile opts capt
155+ return $ " <caption>" ++ c ++ "</caption>\n"
156+ let percent w = show (truncate (100*w) :: Integer) ++ "%"
157+ let coltags = if all (== 0.0) widths
158+ then ""
159+ else unlines $ map
160+ (\w -> " <col width=\"" ++ percent w ++ "\" />") widths
161+ head' <- if all null headers
162+ then return ""
163+ else do
164+ hs <- tableRowToTextile opts alignStrings 0 headers
165+ return $ " <thead>\n" ++ hs ++ "\n </thead>\n"
166+ body' <- zipWithM (tableRowToTextile opts alignStrings) [1..] rows'
167+ return $ " <table>\n" ++ captionDoc ++ coltags ++ head' ++
168+ " <tbody>\n" ++ unlines body' ++ " </tbody>\n </table>\n"
169+
170+blockToTextile opts x@(BulletList items) = do
171+ oldUseTags <- liftM stUseTags get
172+ let useTags = oldUseTags || not (isSimpleList x)
173+ if useTags
174+ then do
175+ contents <- withUseTags $ mapM (listItemToTextile opts) items
176+ return $ " <ul>\n" ++ vcat contents ++ " </ul>\n"
177+ else do
178+ modify $ \s -> s { stListLevel = stListLevel s ++ "*" }
179+ level <- get >>= return . length . stListLevel
180+ contents <- mapM (listItemToTextile opts) items
181+ modify $ \s -> s { stListLevel = init (stListLevel s) }
182+ return $ vcat contents ++ (if level > 1 then "" else "\n")
183+
184+blockToTextile opts x@(OrderedList attribs items) = do
185+ oldUseTags <- liftM stUseTags get
186+ let useTags = oldUseTags || not (isSimpleList x)
187+ if useTags
188+ then do
189+ contents <- withUseTags $ mapM (listItemToTextile opts) items
190+ return $ " <ol" ++ listAttribsToString attribs ++ ">\n" ++ vcat contents ++
191+ " </ol>\n"
192+ else do
193+ modify $ \s -> s { stListLevel = stListLevel s ++ "#" }
194+ level <- get >>= return . length . stListLevel
195+ contents <- mapM (listItemToTextile opts) items
196+ modify $ \s -> s { stListLevel = init (stListLevel s) }
197+ return $ vcat contents ++ (if level > 1 then "" else "\n")
198+
199+blockToTextile opts (DefinitionList items) = do
200+ contents <- withUseTags $ mapM (definitionListItemToTextile opts) items
201+ return $ " <dl>\n" ++ vcat contents ++ " </dl>\n"
202+
203+-- Auxiliary functions for lists:
204+
205+-- | Convert ordered list attributes to HTML attribute string
206+listAttribsToString :: ListAttributes -> String
207+listAttribsToString (startnum, numstyle, _) =
208+ let numstyle' = camelCaseToHyphenated $ show numstyle
209+ in (if startnum /= 1
210+ then " start=\"" ++ show startnum ++ "\""
211+ else "") ++
212+ (if numstyle /= DefaultStyle
213+ then " style=\"list-style-type: " ++ numstyle' ++ ";\""
214+ else "")
215+
216+-- | Convert bullet or ordered list item (list of blocks) to Textile.
217+listItemToTextile :: WriterOptions -> [Block] -> State WriterState String
218+listItemToTextile opts items = do
219+ contents <- blockListToTextile opts items
220+ useTags <- get >>= return . stUseTags
221+ if useTags
222+ then return $ " <li>" ++ contents ++ "</li>"
223+ else do
224+ marker <- get >>= return . stListLevel
225+ return $ marker ++ " " ++ contents
226+
227+-- | Convert definition list item (label, list of blocks) to Textile.
228+definitionListItemToTextile :: WriterOptions
229+ -> ([Inline],[[Block]])
230+ -> State WriterState String
231+definitionListItemToTextile opts (label, items) = do
232+ labelText <- inlineListToTextile opts label
233+ contents <- mapM (blockListToTextile opts) items
234+ return $ " <dt>" ++ labelText ++ "</dt>\n" ++
235+ (intercalate "\n" $ map (\d -> " <dd>" ++ d ++ "</dd>") contents)
236+
237+-- | True if the list can be handled by simple wiki markup, False if HTML tags will be needed.
238+isSimpleList :: Block -> Bool
239+isSimpleList x =
240+ case x of
241+ BulletList items -> all isSimpleListItem items
242+ OrderedList (num, sty, _) items -> all isSimpleListItem items &&
243+ num == 1 && sty `elem` [DefaultStyle, Decimal]
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+ _ -> False
257+isSimpleListItem [x, y] | isPlainOrPara x =
258+ case y of
259+ BulletList _ -> isSimpleList y
260+ OrderedList _ _ -> isSimpleList y
261+ _ -> False
262+isSimpleListItem _ = False
263+
264+isPlainOrPara :: Block -> Bool
265+isPlainOrPara (Plain _) = True
266+isPlainOrPara (Para _) = True
267+isPlainOrPara _ = False
268+
269+-- | Concatenates strings with line breaks between them.
270+vcat :: [String] -> String
271+vcat = intercalate "\n"
272+
273+-- Auxiliary functions for tables. (TODO: these are common to HTML, MediaWiki,
274+-- and Textile writers, and should be abstracted out.)
275+
276+tableRowToTextile :: WriterOptions
277+ -> [String]
278+ -> Int
279+ -> [[Block]]
280+ -> State WriterState String
281+tableRowToTextile opts alignStrings rownum cols' = do
282+ let celltype = if rownum == 0 then "th" else "td"
283+ let rowclass = case rownum of
284+ 0 -> "header"
285+ x | x `rem` 2 == 1 -> "odd"
286+ _ -> "even"
287+ cols'' <- sequence $ zipWith
288+ (\alignment item -> tableItemToTextile opts celltype alignment item)
289+ alignStrings cols'
290+ return $ "<tr class=\"" ++ rowclass ++ "\">\n" ++ unlines cols'' ++ "</tr>"
291+
292+alignmentToString :: Alignment -> [Char]
293+alignmentToString alignment = case alignment of
294+ AlignLeft -> "left"
295+ AlignRight -> "right"
296+ AlignCenter -> "center"
297+ AlignDefault -> "left"
298+
299+tableItemToTextile :: WriterOptions
300+ -> String
301+ -> String
302+ -> [Block]
303+ -> State WriterState String
304+tableItemToTextile opts celltype align' item = do
305+ let mkcell x = "<" ++ celltype ++ " align=\"" ++ align' ++ "\">" ++
306+ x ++ "</" ++ celltype ++ ">"
307+ contents <- blockListToTextile opts item
308+ return $ mkcell contents
309+
310+-- | Convert list of Pandoc block elements to Textile.
311+blockListToTextile :: WriterOptions -- ^ Options
312+ -> [Block] -- ^ List of block elements
313+ -> State WriterState String
314+blockListToTextile opts blocks =
315+ mapM (blockToTextile opts) blocks >>= return . vcat
316+
317+-- | Convert list of Pandoc inline elements to Textile.
318+inlineListToTextile :: WriterOptions -> [Inline] -> State WriterState String
319+inlineListToTextile opts lst =
320+ mapM (inlineToTextile opts) lst >>= return . concat
321+
322+-- | Convert Pandoc inline element to Textile.
323+inlineToTextile :: WriterOptions -> Inline -> State WriterState String
324+
325+inlineToTextile opts (Emph lst) = do
326+ contents <- inlineListToTextile opts lst
327+ return $ if '_' `elem` contents
328+ then "<em>" ++ contents ++ "</em>"
329+ else "_" ++ contents ++ "_"
330+
331+inlineToTextile opts (Strong lst) = do
332+ contents <- inlineListToTextile opts lst
333+ return $ if '*' `elem` contents
334+ then "<strong>" ++ contents ++ "</strong>"
335+ else "*" ++ contents ++ "*"
336+
337+inlineToTextile opts (Strikeout lst) = do
338+ contents <- inlineListToTextile opts lst
339+ return $ if '-' `elem` contents
340+ then "<del>" ++ contents ++ "</del>"
341+ else "-" ++ contents ++ "-"
342+
343+inlineToTextile opts (Superscript lst) = do
344+ contents <- inlineListToTextile opts lst
345+ return $ if '^' `elem` contents
346+ then "<sup>" ++ contents ++ "</sup>"
347+ else "[^" ++ contents ++ "^]"
348+
349+inlineToTextile opts (Subscript lst) = do
350+ contents <- inlineListToTextile opts lst
351+ return $ if '~' `elem` contents
352+ then "<sub>" ++ contents ++ "</sub>"
353+ else "[~" ++ contents ++ "~]"
354+
355+inlineToTextile opts (SmallCaps lst) = inlineListToTextile opts lst
356+
357+inlineToTextile opts (Quoted SingleQuote lst) = do
358+ contents <- inlineListToTextile opts lst
359+ return $ "'" ++ contents ++ "'"
360+
361+inlineToTextile opts (Quoted DoubleQuote lst) = do
362+ contents <- inlineListToTextile opts lst
363+ return $ "\"" ++ contents ++ "\""
364+
365+inlineToTextile opts (Cite _ lst) = inlineListToTextile opts lst
366+
367+inlineToTextile _ EmDash = return " -- "
368+
369+inlineToTextile _ EnDash = return " - "
370+
371+inlineToTextile _ Apostrophe = return "'"
372+
373+inlineToTextile _ Ellipses = return "..."
374+
375+inlineToTextile _ (Code str) =
376+ return $ if '@' `elem` str
377+ then "<tt>" ++ escapeStringForXML str ++ "</tt>"
378+ else "@" ++ escapeStringForXML str ++ "@"
379+
380+inlineToTextile _ (Str str) = return $ escapeStringForTextile str
381+
382+inlineToTextile _ (Math _ str) =
383+ return $ "<span class=\"math\">" ++ escapeStringForXML str ++ "</math>"
384+
385+inlineToTextile _ (TeX _) = return ""
386+
387+inlineToTextile _ (HtmlInline str) = return str
388+
389+inlineToTextile _ (LineBreak) = return "\n"
390+
391+inlineToTextile _ Space = return " "
392+
393+inlineToTextile opts (Link txt (src, _)) = do
394+ label <- case txt of
395+ [Code s] -> return s
396+ _ -> inlineListToTextile opts txt
397+ return $ "\"" ++ label ++ "\":" ++ src
398+
399+inlineToTextile opts (Image alt (source, tit)) = do
400+ alt' <- inlineListToTextile opts alt
401+ let txt = if null tit
402+ then if null alt'
403+ then ""
404+ else "(" ++ alt' ++ ")"
405+ else "(" ++ tit ++ ")"
406+ return $ "!" ++ source ++ txt ++ "!"
407+
408+inlineToTextile opts (Note contents) = do
409+ curNotes <- liftM stNotes get
410+ let newnum = length curNotes + 1
411+ contents' <- blockListToTextile opts contents
412+ let thisnote = "fn" ++ show newnum ++ ". " ++ contents' ++ "\n"
413+ modify $ \s -> s { stNotes = thisnote : curNotes }
414+ return $ "[" ++ show newnum ++ "]"
415+ -- note - may not work for notes with multiple blocks