@@ -0,0 +1,369 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-
3+Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
4+
5+This program is free software; you can redistribute it and/or modify
6+it under the terms of the GNU General Public License as published by
7+the Free Software Foundation; either version 2 of the License, or
8+(at your option) any later version.
9+
10+This program is distributed in the hope that it will be useful,
11+but WITHOUT ANY WARRANTY; without even the implied warranty of
12+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13+GNU General Public License for more details.
14+
15+You should have received a copy of the GNU General Public License
16+along with this program; if not, write to the Free Software
17+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
18+-}
19+
20+{- |
21+ Module : Text.Pandoc.Writers.Asciidoc
22+ Copyright : Copyright (C) 2006-2010 John MacFarlane
23+ License : GNU GPL, version 2 or above
24+
25+ Maintainer : John MacFarlane <jgm@berkeley.edu>
26+ Stability : alpha
27+ Portability : portable
28+
29+Conversion of 'Pandoc' documents to asciidoc.
30+
31+Note that some information may be lost in conversion, due to
32+expressive limitations of asciidoc. Footnotes and table cells with
33+paragraphs (or other block items) are not possible in asciidoc.
34+If pandoc encounters one of these, it will insert a message indicating
35+that it has omitted the construct.
36+
37+Asciidoc: <http://www.methods.co.nz/asciidoc/>
38+-}
39+module Text.Pandoc.Writers.Asciidoc (writeAsciidoc) where
40+import Text.Pandoc.Definition
41+import Text.Pandoc.Templates (renderTemplate)
42+import Text.Pandoc.Shared
43+import Text.Pandoc.Parsing hiding (blankline)
44+import Text.ParserCombinators.Parsec ( runParser, GenParser )
45+import Data.List ( isPrefixOf, intersperse, intercalate )
46+import Text.Pandoc.Pretty
47+import Control.Monad.State
48+
49+data WriterState = WriterState { defListMarker :: String
50+ , orderedListLevel :: Int
51+ , bulletListLevel :: Int
52+ }
53+
54+-- | Convert Pandoc to Asciidoc.
55+writeAsciidoc :: WriterOptions -> Pandoc -> String
56+writeAsciidoc opts document =
57+ evalState (pandocToAsciidoc opts document) WriterState{
58+ defListMarker = "::"
59+ , orderedListLevel = 1
60+ , bulletListLevel = 1
61+ }
62+
63+-- | Return markdown representation of document.
64+pandocToAsciidoc :: WriterOptions -> Pandoc -> State WriterState String
65+pandocToAsciidoc opts (Pandoc (Meta title authors date) blocks) = do
66+ title' <- inlineListToAsciidoc opts title
67+ let title'' = title' $$ text (replicate (offset title') '=')
68+ authors' <- mapM (inlineListToAsciidoc opts) authors
69+ -- asciidoc only allows a singel author
70+ date' <- inlineListToAsciidoc opts date
71+ let titleblock = not $ null title && null authors && null date
72+ body <- blockListToAsciidoc opts blocks
73+ let colwidth = if writerWrapText opts
74+ then Just $ writerColumns opts
75+ else Nothing
76+ let main = render colwidth body
77+ let context = writerVariables opts ++
78+ [ ("body", main)
79+ , ("title", render colwidth title'')
80+ , ("date", render colwidth date')
81+ ] ++
82+ [ ("toc", "yes") | writerTableOfContents opts &&
83+ writerStandalone opts ] ++
84+ [ ("titleblock", "yes") | titleblock ] ++
85+ [ ("author", render colwidth a) | a <- authors' ]
86+ if writerStandalone opts
87+ then return $ renderTemplate context $ writerTemplate opts
88+ else return main
89+
90+-- | Escape special characters for Asciidoc.
91+escapeString :: String -> String
92+escapeString = escapeStringUsing markdownEscapes
93+ where markdownEscapes = backslashEscapes "\\`*_>#~^{+"
94+
95+-- | Ordered list start parser for use in Para below.
96+olMarker :: GenParser Char ParserState Char
97+olMarker = do (start, style', delim) <- anyOrderedListMarker
98+ if delim == Period &&
99+ (style' == UpperAlpha || (style' == UpperRoman &&
100+ start `elem` [1, 5, 10, 50, 100, 500, 1000]))
101+ then spaceChar >> spaceChar
102+ else spaceChar
103+
104+-- | True if string begins with an ordered list marker
105+beginsWithOrderedListMarker :: String -> Bool
106+beginsWithOrderedListMarker str =
107+ case runParser olMarker defaultParserState "para start" (take 10 str) of
108+ Left _ -> False
109+ Right _ -> True
110+
111+-- | Convert Pandoc block element to markdown.
112+blockToAsciidoc :: WriterOptions -- ^ Options
113+ -> Block -- ^ Block element
114+ -> State WriterState Doc
115+blockToAsciidoc _ Null = return empty
116+blockToAsciidoc opts (Plain inlines) = do
117+ contents <- inlineListToAsciidoc opts inlines
118+ return $ contents <> cr
119+blockToAsciidoc opts (Para inlines) = do
120+ contents <- inlineListToAsciidoc opts inlines
121+ -- escape if para starts with ordered list marker
122+ let esc = if beginsWithOrderedListMarker (render Nothing contents)
123+ then text "\\"
124+ else empty
125+ return $ esc <> contents <> blankline
126+blockToAsciidoc _ (RawBlock _ _) = return empty
127+blockToAsciidoc _ HorizontalRule =
128+ return $ blankline <> text "'''''" <> blankline
129+blockToAsciidoc opts (Header level inlines) = do
130+ contents <- inlineListToAsciidoc opts inlines
131+ let len = offset contents
132+ return $ contents <> cr <>
133+ (case level of
134+ 1 -> text $ replicate len '-'
135+ 2 -> text $ replicate len '~'
136+ 3 -> text $ replicate len '^'
137+ 4 -> text $ replicate len '+'
138+ _ -> empty) <> blankline
139+blockToAsciidoc _ (CodeBlock (_,classes,_) str) = return $
140+ flush (attrs <> dashes <> space <> attrs <> cr <> text str <>
141+ cr <> dashes) <> blankline
142+ where dashes = text $ replicate (maximum $ map length $ lines str) '-'
143+ attrs = if null classes
144+ then empty
145+ else text $ intercalate "," $ "code" : classes
146+blockToAsciidoc opts (BlockQuote blocks) = do
147+ contents <- blockListToAsciidoc opts blocks
148+ let isBlock (BlockQuote _) = True
149+ isBlock _ = False
150+ -- if there are nested block quotes, put in an open block
151+ let contents' = if any isBlock blocks
152+ then "--" $$ contents $$ "--"
153+ else contents
154+ let cols = offset contents'
155+ let bar = text $ replicate cols '_'
156+ return $ bar $$ chomp contents' $$ bar <> blankline
157+blockToAsciidoc opts (Table caption aligns widths headers rows) = do
158+ caption' <- inlineListToAsciidoc opts caption
159+ let caption'' = if null caption
160+ then empty
161+ else "." <> caption' <> cr
162+ let isSimple = all (== 0) widths
163+ let relativePercentWidths = if isSimple
164+ then widths
165+ else map (/ (sum widths)) widths
166+ let widths'' :: [Integer]
167+ widths'' = map (floor . (* 100)) relativePercentWidths
168+ -- ensure that the widths sum to 100
169+ let widths' = case widths'' of
170+ _ | isSimple -> widths''
171+ (w:ws) | sum (w:ws) < 100
172+ -> (100 - sum ws) : ws
173+ ws -> ws
174+ let totalwidth :: Integer
175+ totalwidth = floor $ sum widths * 100
176+ let colspec al wi = (case al of
177+ AlignLeft -> "<"
178+ AlignCenter -> "^"
179+ AlignRight -> ">"
180+ AlignDefault -> "") ++
181+ if wi == 0 then "" else (show wi ++ "%")
182+ let headerspec = if all null headers
183+ then empty
184+ else text "options=\"header\","
185+ let widthspec = if totalwidth == 0
186+ then empty
187+ else text "width="
188+ <> doubleQuotes (text $ show totalwidth ++ "%")
189+ <> text ","
190+ let tablespec = text "["
191+ <> widthspec
192+ <> text "cols="
193+ <> doubleQuotes (text $ intercalate ","
194+ $ zipWith colspec aligns widths')
195+ <> text ","
196+ <> headerspec <> text "]"
197+ let makeCell [Plain x] = do d <- blockListToAsciidoc opts [Plain x]
198+ return $ text "|" <> chomp d
199+ makeCell [Para x] = makeCell [Plain x]
200+ makeCell _ = return $ text "|" <> "[multiblock cell omitted]"
201+ let makeRow cells = hsep `fmap` mapM makeCell cells
202+ rows' <- mapM makeRow rows
203+ head' <- makeRow headers
204+ let head'' = if all null headers then empty else head'
205+ let colwidth = if writerWrapText opts
206+ then writerColumns opts
207+ else 100000
208+ let maxwidth = maximum $ map offset (head':rows')
209+ let body = if maxwidth > colwidth then vsep rows' else vcat rows'
210+ let border = text $ "|" ++ replicate ((min maxwidth colwidth) - 1) '='
211+ return $
212+ caption'' $$ tablespec $$ border $$ head'' $$ body $$ border $$ blankline
213+blockToAsciidoc opts (BulletList items) = do
214+ contents <- mapM (bulletListItemToAsciidoc opts) items
215+ return $ cat contents <> blankline
216+blockToAsciidoc opts (OrderedList (start, sty, _delim) items) = do
217+ let markers = orderedListMarkers (start, sty, Period)
218+ let markers' = map (\m -> if length m < 3
219+ then m ++ replicate (3 - length m) ' '
220+ else m) markers
221+ contents <- mapM (\(item, num) -> orderedListItemToAsciidoc opts item num) $
222+ zip markers' items
223+ return $ cat contents <> blankline
224+blockToAsciidoc opts (DefinitionList items) = do
225+ contents <- mapM (definitionListItemToAsciidoc opts) items
226+ return $ cat contents <> blankline
227+
228+-- | Convert bullet list item (list of blocks) to markdown.
229+bulletListItemToAsciidoc :: WriterOptions -> [Block] -> State WriterState Doc
230+bulletListItemToAsciidoc opts blocks = do
231+ let addBlock :: Doc -> Block -> State WriterState Doc
232+ addBlock d b | isEmpty d = chomp `fmap` blockToAsciidoc opts b
233+ addBlock d b@(BulletList _) = do x <- blockToAsciidoc opts b
234+ return $ d <> cr <> chomp x
235+ addBlock d b@(OrderedList _ _) = do x <- blockToAsciidoc opts b
236+ return $ d <> cr <> chomp x
237+ addBlock d b = do x <- blockToAsciidoc opts b
238+ return $ d <> cr <> text "+" <> cr <> chomp x
239+ lev <- bulletListLevel `fmap` get
240+ modify $ \s -> s{ bulletListLevel = lev + 1 }
241+ contents <- foldM addBlock empty blocks
242+ modify $ \s -> s{ bulletListLevel = lev }
243+ let marker = text (replicate lev '*')
244+ return $ marker <> space <> contents <> cr
245+
246+-- | Convert ordered list item (a list of blocks) to markdown.
247+orderedListItemToAsciidoc :: WriterOptions -- ^ options
248+ -> String -- ^ list item marker
249+ -> [Block] -- ^ list item (list of blocks)
250+ -> State WriterState Doc
251+orderedListItemToAsciidoc opts marker blocks = do
252+ let addBlock :: Doc -> Block -> State WriterState Doc
253+ addBlock d b | isEmpty d = chomp `fmap` blockToAsciidoc opts b
254+ addBlock d b@(BulletList _) = do x <- blockToAsciidoc opts b
255+ return $ d <> cr <> chomp x
256+ addBlock d b@(OrderedList _ _) = do x <- blockToAsciidoc opts b
257+ return $ d <> cr <> chomp x
258+ addBlock d b = do x <- blockToAsciidoc opts b
259+ return $ d <> cr <> text "+" <> cr <> chomp x
260+ lev <- orderedListLevel `fmap` get
261+ modify $ \s -> s{ orderedListLevel = lev + 1 }
262+ contents <- foldM addBlock empty blocks
263+ modify $ \s -> s{ orderedListLevel = lev }
264+ return $ text marker <> space <> contents <> cr
265+
266+-- | Convert definition list item (label, list of blocks) to markdown.
267+definitionListItemToAsciidoc :: WriterOptions
268+ -> ([Inline],[[Block]])
269+ -> State WriterState Doc
270+definitionListItemToAsciidoc opts (label, defs) = do
271+ labelText <- inlineListToAsciidoc opts label
272+ marker <- defListMarker `fmap` get
273+ if marker == "::"
274+ then modify (\st -> st{ defListMarker = ";;"})
275+ else modify (\st -> st{ defListMarker = "::"})
276+ let divider = cr <> text "+" <> cr
277+ let defsToAsciidoc :: [Block] -> State WriterState Doc
278+ defsToAsciidoc ds = (vcat . intersperse divider . map chomp)
279+ `fmap` mapM (blockToAsciidoc opts) ds
280+ defs' <- mapM defsToAsciidoc defs
281+ modify (\st -> st{ defListMarker = marker })
282+ let contents = nest 2 $ vcat $ intersperse divider $ map chomp defs'
283+ return $ labelText <> text marker <> cr <> contents <> cr
284+
285+-- | Convert list of Pandoc block elements to markdown.
286+blockListToAsciidoc :: WriterOptions -- ^ Options
287+ -> [Block] -- ^ List of block elements
288+ -> State WriterState Doc
289+blockListToAsciidoc opts blocks = cat `fmap` mapM (blockToAsciidoc opts) blocks
290+
291+-- | Convert list of Pandoc inline elements to markdown.
292+inlineListToAsciidoc :: WriterOptions -> [Inline] -> State WriterState Doc
293+inlineListToAsciidoc opts lst =
294+ mapM (inlineToAsciidoc opts) lst >>= return . cat
295+
296+-- | Convert Pandoc inline element to markdown.
297+inlineToAsciidoc :: WriterOptions -> Inline -> State WriterState Doc
298+inlineToAsciidoc opts (Emph lst) = do
299+ contents <- inlineListToAsciidoc opts lst
300+ return $ "_" <> contents <> "_"
301+inlineToAsciidoc opts (Strong lst) = do
302+ contents <- inlineListToAsciidoc opts lst
303+ return $ "*" <> contents <> "*"
304+inlineToAsciidoc opts (Strikeout lst) = do
305+ contents <- inlineListToAsciidoc opts lst
306+ return $ "[line-through]*" <> contents <> "*"
307+inlineToAsciidoc opts (Superscript lst) = do
308+ contents <- inlineListToAsciidoc opts lst
309+ return $ "^" <> contents <> "^"
310+inlineToAsciidoc opts (Subscript lst) = do
311+ contents <- inlineListToAsciidoc opts lst
312+ return $ "~" <> contents <> "~"
313+inlineToAsciidoc opts (SmallCaps lst) = inlineListToAsciidoc opts lst
314+inlineToAsciidoc opts (Quoted SingleQuote lst) = do
315+ contents <- inlineListToAsciidoc opts lst
316+ return $ "`" <> contents <> "'"
317+inlineToAsciidoc opts (Quoted DoubleQuote lst) = do
318+ contents <- inlineListToAsciidoc opts lst
319+ return $ "``" <> contents <> "''"
320+inlineToAsciidoc _ EmDash = return "\8212"
321+inlineToAsciidoc _ EnDash = return "\8211"
322+inlineToAsciidoc _ Apostrophe = return "\8217"
323+inlineToAsciidoc _ Ellipses = return "\8230"
324+inlineToAsciidoc _ (Code _ str) = return $
325+ text "`" <> text (escapeStringUsing (backslashEscapes "`") str) <> "`"
326+inlineToAsciidoc _ (Str str) = return $ text $ escapeString str
327+inlineToAsciidoc _ (Math InlineMath str) =
328+ return $ "latexmath:[$" <> text str <> "$]"
329+inlineToAsciidoc _ (Math DisplayMath str) =
330+ return $ "latexmath:[$$" <> text str <> "$$]"
331+inlineToAsciidoc _ (RawInline _ _) = return empty
332+inlineToAsciidoc _ (LineBreak) = return $ " +" <> cr
333+inlineToAsciidoc _ Space = return space
334+inlineToAsciidoc opts (Cite _ lst) = inlineListToAsciidoc opts lst
335+inlineToAsciidoc opts (Link txt (src', _tit)) = do
336+-- relative: link:downloads/foo.zip[download foo.zip]
337+-- abs: http://google.cod[Google]
338+-- or my@email.com[email john]
339+ linktext <- inlineListToAsciidoc opts txt
340+ let src = unescapeURI src'
341+ let isRelative = ':' `notElem` src
342+ let prefix = if isRelative
343+ then text "link:"
344+ else empty
345+ let srcSuffix = if isPrefixOf "mailto:" src then drop 7 src else src
346+ let useAuto = case txt of
347+ [Code _ s] | s == srcSuffix -> True
348+ _ -> False
349+ return $ if useAuto
350+ then text srcSuffix
351+ else prefix <> text src <> "[" <> linktext <> "]"
352+inlineToAsciidoc opts (Image alternate (src', tit)) = do
353+-- image:images/logo.png[Company logo, title="blah"]
354+ let txt = if (null alternate) || (alternate == [Str ""])
355+ then [Str "image"]
356+ else alternate
357+ linktext <- inlineListToAsciidoc opts txt
358+ let linktitle = if null tit
359+ then empty
360+ else text $ ",title=\"" ++ tit ++ "\""
361+ let src = unescapeURI src'
362+ return $ "image:" <> text src <> "[" <> linktext <> linktitle <> "]"
363+inlineToAsciidoc opts (Note [Para inlines]) =
364+ inlineToAsciidoc opts (Note [Plain inlines])
365+inlineToAsciidoc opts (Note [Plain inlines]) = do
366+ contents <- inlineListToAsciidoc opts inlines
367+ return $ text "footnote:[" <> contents <> "]"
368+-- asciidoc can't handle blank lines in notes
369+inlineToAsciidoc _ (Note _) = return "[multiblock footnote omitted]"