@@ -0,0 +1,266 @@
1+{-# LANGUAGE NoImplicitPrelude #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-
4+Copyright (C) 2008-2017 John MacFarlane <jgm@berkeley.edu>
5+
6+This program is free software; you can redistribute it and/or modify
7+it under the terms of the GNU General Public License as published by
8+the Free Software Foundation; either version 2 of the License, or
9+(at your option) any later version.
10+
11+This program is distributed in the hope that it will be useful,
12+but WITHOUT ANY WARRANTY; without even the implied warranty of
13+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14+GNU General Public License for more details.
15+
16+You should have received a copy of the GNU General Public License
17+along with this program; if not, write to the Free Software
18+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19+-}
20+
21+{- |
22+ Module : Text.Pandoc.Writers.XWiki
23+ Copyright : Copyright (C) 2008-2017 John MacFarlane
24+ License : GNU GPL, version 2 or above
25+
26+ Maintainer : Derek Chen-Becker <dchenbecker@gmail.com>
27+ Stability : alpha
28+ Portability : portable
29+
30+Conversion of 'Pandoc' documents to XWiki markup.
31+
32+XWiki: <http://www.xwiki.org/>
33+XWiki Syntax: <http://www.xwiki.org/xwiki/bin/view/Documentation/UserGuide/Features/XWikiSyntax/>
34+-}
35+
36+module Text.Pandoc.Writers.XWiki ( writeXWiki ) where
37+import Prelude
38+import Control.Monad.Reader (ReaderT, asks, local, runReaderT)
39+import qualified Data.Set as Set
40+import qualified Data.Text as Text
41+import Data.Text (Text, intercalate, pack, replace, split)
42+import Text.Pandoc.Class (PandocMonad, report)
43+import Text.Pandoc.Definition
44+import Text.Pandoc.Logging
45+import Text.Pandoc.Options
46+import Text.Pandoc.Shared (escapeURI, isURI, linesToPara)
47+import Text.Pandoc.Writers.MediaWiki (highlightingLangs)
48+
49+data WriterState = WriterState {
50+ listLevel :: Text -- String at the beginning of items
51+}
52+
53+type XWikiReader m = ReaderT WriterState m
54+
55+-- | Convert Pandoc to XWiki.
56+writeXWiki :: PandocMonad m => WriterOptions -> Pandoc -> m Text
57+writeXWiki _ (Pandoc _ blocks) = do
58+ let env = WriterState { listLevel = "" }
59+ body <- runReaderT (blockListToXWiki blocks) env
60+ return $ body
61+
62+-- | Concatenates strings with line breaks between them.
63+vcat :: [Text] -> Text
64+vcat = intercalate "\n"
65+
66+-- If an id is provided, we can generate an anchor using the id macro
67+-- https://extensions.xwiki.org/xwiki/bin/view/Extension/Id%20Macro
68+genAnchor :: String -> Text
69+genAnchor id' = if null id'
70+ then ""
71+ else pack $ "{{id name=\"" ++ id' ++ "\" /}}"
72+
73+blockListToXWiki :: PandocMonad m => [Block] -> XWikiReader m Text
74+blockListToXWiki blocks =
75+ fmap vcat $ mapM blockToXWiki blocks
76+
77+blockToXWiki :: PandocMonad m => Block -> XWikiReader m Text
78+
79+blockToXWiki Null = return ""
80+
81+blockToXWiki (Div (id', _, _) blocks) = do
82+ content <- blockListToXWiki blocks
83+ return $ (genAnchor id') <> content
84+
85+blockToXWiki (Plain inlines) =
86+ inlineListToXWiki inlines
87+
88+blockToXWiki (Para inlines) = do
89+ contents <- inlineListToXWiki inlines
90+ return $ contents <> "\n"
91+
92+blockToXWiki (LineBlock lns) =
93+ blockToXWiki $ linesToPara lns
94+
95+blockToXWiki b@(RawBlock f str)
96+ | f == Format "xwiki" = return $ pack str
97+ | otherwise = "" <$ report (BlockNotRendered b)
98+
99+blockToXWiki HorizontalRule = return "\n----\n"
100+
101+blockToXWiki (Header level (id', _, _) inlines) = do
102+ contents <- inlineListToXWiki inlines
103+ let eqs = Text.replicate level "="
104+ return $ eqs <> " " <> contents <> " " <> (genAnchor id') <> eqs <> "\n"
105+
106+-- XWiki doesn't appear to differentiate between inline and block-form code, so we delegate
107+-- We do amend the text to ensure that the code markers are on their own lines, since this is a block
108+blockToXWiki (CodeBlock attrs str) = do
109+ contents <- inlineToXWiki (Code attrs ("\n" <> str <> "\n"))
110+ return $ "\n" <> contents <> "\n"
111+
112+blockToXWiki (BlockQuote blocks) = do
113+ blockText <- blockListToXWiki blocks
114+ let quoteLines = split (== '\n') blockText
115+ let prefixed = map (">" <>) quoteLines
116+ return $ vcat prefixed
117+
118+blockToXWiki (BulletList contents) = blockToXWikiList "*" $ contents
119+
120+blockToXWiki (OrderedList _ contents) = blockToXWikiList "1" $ contents
121+
122+blockToXWiki (DefinitionList items) = do
123+ lev <- asks listLevel
124+ contents <- local (\s -> s { listLevel = listLevel s <> ";" }) $ mapM definitionListItemToMediaWiki items
125+ return $ vcat contents <> if Text.null lev then "\n" else ""
126+
127+-- TODO: support more features
128+blockToXWiki (Table _ _ _ headers rows') = do
129+ headers' <- mapM (tableCellXWiki True) headers
130+ otherRows <- mapM formRow rows'
131+ return $ Text.unlines (Text.unwords headers':otherRows)
132+
133+formRow :: PandocMonad m => [[Block]] -> XWikiReader m Text
134+formRow row = do
135+ cellStrings <- mapM (tableCellXWiki False) row
136+ return $ Text.unwords cellStrings
137+
138+
139+tableCellXWiki :: PandocMonad m => Bool -> [Block] -> XWikiReader m Text
140+tableCellXWiki isHeader cell = do
141+ contents <- blockListToXWiki cell
142+ let cellBorder = if isHeader then "|=" else "|"
143+ return $ cellBorder <> contents
144+
145+
146+inlineListToXWiki :: PandocMonad m => [Inline] -> XWikiReader m Text
147+inlineListToXWiki lst =
148+ mconcat <$> mapM inlineToXWiki lst
149+
150+inlineToXWiki :: PandocMonad m => Inline -> XWikiReader m Text
151+
152+inlineToXWiki (Str str) = return $ escapeXWikiString $ pack str
153+
154+inlineToXWiki Space = return " "
155+
156+-- Special syntax for XWiki 2.0. This won't break table cells
157+inlineToXWiki LineBreak = return "\\\\"
158+
159+inlineToXWiki SoftBreak = return " "
160+
161+inlineToXWiki (Emph lst) = do
162+ contents <- inlineListToXWiki lst
163+ return $ "//" <> contents <> "//"
164+
165+inlineToXWiki (Strong lst) = do
166+ contents <- inlineListToXWiki lst
167+ return $ "**" <> contents <> "**"
168+
169+inlineToXWiki (Strikeout lst) = do
170+ contents <- inlineListToXWiki lst
171+ return $ "--" <> contents <> "--"
172+
173+inlineToXWiki (Superscript lst) = do
174+ contents <- inlineListToXWiki lst
175+ return $ "^^" <> contents <> "^^"
176+
177+inlineToXWiki (Subscript lst) = do
178+ contents <- inlineListToXWiki lst
179+ return $ ",," <> contents <> ",,"
180+
181+-- TODO: Not supported. Maybe escape to HTML?
182+inlineToXWiki (SmallCaps lst) = do
183+ contents <- inlineListToXWiki lst
184+ return contents
185+
186+inlineToXWiki (Quoted SingleQuote lst) = do
187+ contents <- inlineListToXWiki lst
188+ return $ "‘" <> contents <> "’"
189+
190+inlineToXWiki (Quoted DoubleQuote lst) = do
191+ contents <- inlineListToXWiki lst
192+ return $ "“" <> contents <> "”"
193+
194+inlineToXWiki (Code (_,classes,_) contents') = do
195+ let at = Set.fromList classes `Set.intersection` highlightingLangs
196+ let contents = pack contents'
197+ return $
198+ case Set.toList at of
199+ [] -> "{{code}}" <> contents <> "{{/code}}"
200+ (l:_) -> "{{code language=\"" <> (pack l) <> "\"}}" <> contents <> "{{/code}}"
201+
202+inlineToXWiki (Cite _ lst) = inlineListToXWiki lst
203+
204+-- FIXME: optionally support this (plugin?)
205+inlineToXWiki (Math _ str) = return $ "{{formula}}" <> (pack str) <> "{{/formula}}"
206+
207+inlineToXWiki il@(RawInline frmt str)
208+ | frmt == Format "xwiki" = return $ pack str
209+ | otherwise = "" <$ report (InlineNotRendered il)
210+
211+-- TODO: Handle anchors
212+inlineToXWiki (Link (id', _, _) txt (src, _)) = do
213+ label <- inlineListToXWiki txt
214+ case txt of
215+ [Str s] | isURI src && escapeURI s == src -> return $ (pack src) <> (genAnchor id')
216+ _ -> return $ "[[" <> label <> ">>" <> (pack src) <> "]]" <> (genAnchor id')
217+
218+inlineToXWiki (Image _ alt (source, tit)) = do
219+ alt' <- inlineListToXWiki alt
220+ let
221+ titText = pack tit
222+ params = intercalate " " $ filter (not . Text.null) [
223+ if Text.null alt' then "" else "alt=\"" <> alt' <> "\"",
224+ if Text.null titText then "" else "title=\"" <> titText <> "\""
225+ ]
226+ return $ "[[image:" <> (pack source) <> (if Text.null params then "" else "||" <> params) <> "]]"
227+
228+inlineToXWiki (Note contents) = do
229+ contents' <- blockListToXWiki contents
230+ return $ "{{footnote}}" <> (Text.strip contents') <> "{{/footnote}}"
231+
232+-- TODO: support attrs other than id (anchor)
233+inlineToXWiki (Span (id', _, _) contents) = do
234+ contents' <- inlineListToXWiki contents
235+ return $ (genAnchor id') <> contents'
236+
237+-- Utility method since (for now) all lists are handled the same way
238+blockToXWikiList :: PandocMonad m => Text -> [[Block]] -> XWikiReader m Text
239+blockToXWikiList marker contents = do
240+ lev <- asks listLevel
241+ contents' <- local (\s -> s { listLevel = listLevel s <> marker } ) $ mapM listItemToXWiki contents
242+ return $ vcat contents' <> if Text.null lev then "\n" else ""
243+
244+
245+listItemToXWiki :: PandocMonad m => [Block] -> XWikiReader m Text
246+listItemToXWiki contents = do
247+ marker <- asks listLevel
248+ contents' <- blockListToXWiki contents
249+ return $ marker <> ". " <> (Text.strip contents')
250+
251+
252+-- | Convert definition list item (label, list of blocks) to MediaWiki.
253+definitionListItemToMediaWiki :: PandocMonad m
254+ => ([Inline],[[Block]])
255+ -> XWikiReader m Text
256+definitionListItemToMediaWiki (label, items) = do
257+ labelText <- inlineListToXWiki label
258+ contents <- mapM blockListToXWiki items
259+ marker <- asks listLevel
260+ return $ marker <> " " <> labelText <> "\n" <>
261+ intercalate "\n" (map (\d -> (Text.init marker) <> ": " <> d) contents)
262+
263+-- Escape the escape character, as well as formatting pairs
264+escapeXWikiString :: Text -> Text
265+escapeXWikiString s = foldr (uncurry replace) s $ zip ["--", "**", "//", "^^", ",,", "~"] ["~-~-", "~*~*", "~/~/", "~^~^", "~,~,", "~~"]
266+