aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers/XWiki.hs
blob: 486de943faf5f28dfa1c01cc6d602a5c8fb6ee6b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
{-# LANGUAGE OverloadedStrings #-}
{-
Copyright (C) 2008-2017 John MacFarlane <jgm@berkeley.edu>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}

{- |
   Module      : Text.Pandoc.Writers.XWiki
   Copyright   : Copyright (C) 2008-2017 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : Derek Chen-Becker <dchenbecker@gmail.com>
   Stability   : alpha
   Portability : portable

Conversion of 'Pandoc' documents to XWiki markup.

XWiki:  <http://www.xwiki.org/>
XWiki Syntax:  <http://www.xwiki.org/xwiki/bin/view/Documentation/UserGuide/Features/XWikiSyntax/>
-}

module Text.Pandoc.Writers.XWiki ( writeXWiki ) where
import Control.Monad.Reader (ReaderT, asks, local, runReaderT)
import qualified Data.Set as Set
import qualified Data.Text as Text
import Data.Text (Text, intercalate, replace, split)
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Shared
import Text.Pandoc.Writers.MediaWiki (highlightingLangs)
import Text.Pandoc.Writers.Shared (toLegacyTable)

data WriterState = WriterState {
  listLevel :: Text -- String at the beginning of items
}

type XWikiReader m = ReaderT WriterState m

-- | Convert Pandoc to XWiki.
writeXWiki :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeXWiki _ (Pandoc _ blocks) =
  let env = WriterState { listLevel = "" }
  in runReaderT (blockListToXWiki blocks) env

-- | Concatenates strings with line breaks between them.
vcat :: [Text] -> Text
vcat = intercalate "\n"

-- If an id is provided, we can generate an anchor using the id macro
-- https://extensions.xwiki.org/xwiki/bin/view/Extension/Id%20Macro
genAnchor :: Text -> Text
genAnchor id' = if Text.null id'
  then ""
  else "{{id name=\"" <> id' <> "\" /}}"

blockListToXWiki :: PandocMonad m => [Block] -> XWikiReader m Text
blockListToXWiki blocks =
  vcat <$> mapM blockToXWiki blocks

blockToXWiki :: PandocMonad m => Block -> XWikiReader m Text

blockToXWiki Null = return ""

blockToXWiki (Div (id', _, _) blocks) = do
  content <- blockListToXWiki blocks
  return $ genAnchor id' <> content

blockToXWiki (Plain inlines) =
  inlineListToXWiki inlines

blockToXWiki (Para inlines) = do
  contents <- inlineListToXWiki inlines
  return $ contents <> "\n"

blockToXWiki (LineBlock lns) =
  blockToXWiki $ linesToPara lns

blockToXWiki b@(RawBlock f str)
  | f == Format "xwiki" = return str
  | otherwise           = "" <$ report (BlockNotRendered b)

blockToXWiki HorizontalRule = return "\n----\n"

blockToXWiki (Header level (id', _, _) inlines) = do
  contents <- inlineListToXWiki inlines
  let eqs = Text.replicate level "="
  return $ eqs <> " " <> contents <> " " <> genAnchor id' <> eqs <> "\n"

-- XWiki doesn't appear to differentiate between inline and block-form code, so we delegate
-- We do amend the text to ensure that the code markers are on their own lines, since this is a block
blockToXWiki (CodeBlock attrs str) = do
  contents <- inlineToXWiki (Code attrs ("\n" <> str <> "\n"))
  return $ "\n" <> contents <> "\n"

blockToXWiki (BlockQuote blocks) = do
  blockText <- blockListToXWiki blocks
  let quoteLines = split (== '\n') blockText
  let prefixed = map (">" <>) quoteLines
  return $ vcat prefixed

blockToXWiki (BulletList contents) = blockToXWikiList "*" contents

blockToXWiki (OrderedList _ contents) = blockToXWikiList "1" contents

blockToXWiki (DefinitionList items) = do
  lev <- asks listLevel
  contents <- local (\s -> s { listLevel = listLevel s <> ";" }) $ mapM definitionListItemToMediaWiki items
  return $ vcat contents <> if Text.null lev then "\n" else ""

-- TODO: support more features
blockToXWiki (Table _ blkCapt specs thead tbody tfoot) = do
  let (_, _, _, headers, rows') = toLegacyTable blkCapt specs thead tbody tfoot
  headers' <- mapM (tableCellXWiki True) $ take (length specs) $ headers ++ repeat []
  otherRows <- mapM formRow rows'
  return $ Text.unlines (Text.unwords headers':otherRows)

formRow :: PandocMonad m => [[Block]] -> XWikiReader m Text
formRow row = do
  cellStrings <- mapM (tableCellXWiki False) row
  return $ Text.unwords cellStrings


tableCellXWiki :: PandocMonad m => Bool -> [Block] -> XWikiReader m Text
tableCellXWiki isHeader cell = do
  contents <- blockListToXWiki cell
  let isMultiline = (length . split (== '\n')) contents > 1
  let contents' = intercalate contents $ if isMultiline then ["(((", ")))"] else [mempty, mempty]
  let cellBorder = if isHeader then "|=" else "|"
  return $ cellBorder <> contents'


inlineListToXWiki :: PandocMonad m => [Inline] -> XWikiReader m Text
inlineListToXWiki lst =
  mconcat <$> mapM inlineToXWiki lst

inlineToXWiki :: PandocMonad m => Inline -> XWikiReader m Text

inlineToXWiki (Str str) = return $ escapeXWikiString str

inlineToXWiki Space = return " "

-- Special syntax for XWiki 2.0. This won't break table cells
inlineToXWiki LineBreak = return "\\\\"

inlineToXWiki SoftBreak = return " "

inlineToXWiki (Emph lst) = do
  contents <- inlineListToXWiki lst
  return $ "//" <> contents <> "//"

inlineToXWiki (Strong lst) = do
  contents <- inlineListToXWiki lst
  return $ "**" <> contents <> "**"

inlineToXWiki (Strikeout lst) = do
  contents <- inlineListToXWiki lst
  return $ "--" <> contents <> "--"

inlineToXWiki (Superscript lst) = do
  contents <- inlineListToXWiki lst
  return $ "^^" <> contents <> "^^"

inlineToXWiki (Subscript lst) = do
  contents <- inlineListToXWiki lst
  return $ ",," <> contents <> ",,"

-- TODO: Not supported. Maybe escape to HTML?
inlineToXWiki (SmallCaps lst) =
  inlineListToXWiki lst

inlineToXWiki (Quoted SingleQuote lst) = do
  contents <- inlineListToXWiki lst
  return $ "‘" <> contents <> "’"

inlineToXWiki (Quoted DoubleQuote lst) = do
  contents <- inlineListToXWiki lst
  return $ "“" <> contents <> "”"

inlineToXWiki (Code (_,classes,_) contents) = do
  let at  = Set.fromList classes `Set.intersection` highlightingLangs
  return $
    case Set.toList at of
      [] -> "{{code}}" <> contents <> "{{/code}}"
      (l:_) -> "{{code language=\"" <> l <> "\"}}" <> contents <> "{{/code}}"

inlineToXWiki (Cite _ lst) = inlineListToXWiki lst

-- FIXME: optionally support this (plugin?)
inlineToXWiki (Math _ str) = return $ "{{formula}}" <> str <> "{{/formula}}"

inlineToXWiki il@(RawInline frmt str)
  | frmt == Format "xwiki" = return str
  | otherwise              = "" <$ report (InlineNotRendered il)

-- TODO: Handle anchors
inlineToXWiki (Link (id', _, _) txt (src, _)) = do
  label <- inlineListToXWiki txt
  case txt of
     [Str s] | isURI src && escapeURI s == src -> return $ src <> genAnchor id'
     _  -> return $ "[[" <> label <> ">>" <> src <> "]]" <> genAnchor id'

inlineToXWiki (Image _ alt (source, tit)) = do
  alt' <- inlineListToXWiki alt
  let
    params = Text.unwords $ filter (not . Text.null) [
        if Text.null alt' then "" else "alt=\"" <> alt' <> "\"",
          if Text.null tit then "" else "title=\"" <> tit <> "\""
        ]
  return $ "[[image:" <> source <> (if Text.null params then "" else "||" <> params) <> "]]"

inlineToXWiki (Note contents) = do
  contents' <- blockListToXWiki contents
  return $ "{{footnote}}" <> Text.strip contents' <> "{{/footnote}}"

-- TODO: support attrs other than id (anchor)
inlineToXWiki (Span (id', _, _) contents) = do
  contents' <- inlineListToXWiki contents
  return $ genAnchor id' <> contents'

-- Utility method since (for now) all lists are handled the same way
blockToXWikiList :: PandocMonad m => Text -> [[Block]] -> XWikiReader m Text
blockToXWikiList marker contents = do
  lev <- asks listLevel
  contents' <- local (\s -> s { listLevel = listLevel s <> marker } ) $ mapM listItemToXWiki contents
  return $ vcat contents' <> if Text.null lev then "\n" else ""


listItemToXWiki :: PandocMonad m => [Block] -> XWikiReader m Text
listItemToXWiki contents = do
  marker <- asks listLevel
  contents' <- blockListToXWiki contents
  return $ marker <> ". " <> Text.strip contents'


-- | Convert definition list item (label, list of blocks) to MediaWiki.
definitionListItemToMediaWiki :: PandocMonad m
                              => ([Inline],[[Block]])
                              -> XWikiReader m Text
definitionListItemToMediaWiki (label, items) = do
  labelText <- inlineListToXWiki label
  contents <- mapM blockListToXWiki items
  marker <- asks listLevel
  return $ marker <> " " <> labelText <> "\n" <>
    intercalate "\n" (map (\d -> Text.init marker <> ": " <> d) contents)

-- Escape the escape character, as well as formatting pairs
escapeXWikiString :: Text -> Text
escapeXWikiString s = foldr (uncurry replace) s $ zip ["--", "**", "//", "^^", ",,", "~"] ["~-~-", "~*~*", "~/~/", "~^~^", "~,~,", "~~"]