Add XWiki Support (#4167)

Add XWiki Support

Closes #1800  
 

3 files changed, 270 insertions, 1 deletions

diff --git a/src/Text/Pandoc/Writers.hs b/src/Text/Pandoc/Writers.hs
index 27df6ee8c..d93128731 100644
--- a/src/Text/Pandoc/Writers.hs
+++ b/src/Text/Pandoc/Writers.hs
@@ -63,6 +63,7 @@ module Text.Pandoc.Writers
     , writeTEI
     , writeTexinfo
     , writeTextile
+    , writeXWiki
     , writeZimWiki
     , getWriter
     ) where
@@ -107,6 +108,7 @@ import Text.Pandoc.Writers.RTF
 import Text.Pandoc.Writers.TEI
 import Text.Pandoc.Writers.Texinfo
 import Text.Pandoc.Writers.Textile
+import Text.Pandoc.Writers.XWiki
 import Text.Pandoc.Writers.ZimWiki
 import Text.Parsec.Error
 
@@ -156,6 +158,7 @@ writers = [
   ,("rst"          , TextWriter writeRST)
   ,("mediawiki"    , TextWriter writeMediaWiki)
   ,("dokuwiki"     , TextWriter writeDokuWiki)
+  ,("xwiki"        , TextWriter writeXWiki)
   ,("zimwiki"      , TextWriter writeZimWiki)
   ,("textile"      , TextWriter writeTextile)
   ,("rtf"          , TextWriter writeRTF)
diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs
index 6682a31c3..ba15d3a21 100644
--- a/src/Text/Pandoc/Writers/MediaWiki.hs
+++ b/src/Text/Pandoc/Writers/MediaWiki.hs
@@ -12,7 +12,7 @@ Conversion of 'Pandoc' documents to MediaWiki markup.
 
 MediaWiki:  <http://www.mediawiki.org/wiki/MediaWiki>
 -}
-module Text.Pandoc.Writers.MediaWiki ( writeMediaWiki ) where
+module Text.Pandoc.Writers.MediaWiki ( writeMediaWiki, highlightingLangs ) where
 import Prelude
 import Control.Monad.Reader
 import Control.Monad.State.Strict
diff --git a/src/Text/Pandoc/Writers/XWiki.hs b/src/Text/Pandoc/Writers/XWiki.hs
new file mode 100644
index 000000000..ce0f83b61
--- /dev/null
+++ b/src/Text/Pandoc/Writers/XWiki.hs
@@ -0,0 +1,266 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# 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 Prelude
+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, pack, replace, split)
+import Text.Pandoc.Class (PandocMonad, report)
+import Text.Pandoc.Definition
+import Text.Pandoc.Logging
+import Text.Pandoc.Options
+import Text.Pandoc.Shared (escapeURI, isURI, linesToPara)
+import Text.Pandoc.Writers.MediaWiki (highlightingLangs)
+
+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) = do
+  let env = WriterState { listLevel = "" }
+  body <- runReaderT (blockListToXWiki blocks) env
+  return $ body
+
+-- | 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 :: String -> Text
+genAnchor id' = if null id'
+  then ""
+  else pack $ "{{id name=\"" ++ id' ++ "\" /}}"
+
+blockListToXWiki :: PandocMonad m => [Block] -> XWikiReader m Text
+blockListToXWiki blocks =
+  fmap 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 $ pack 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 _ _ _ headers rows') = do
+  headers' <- mapM (tableCellXWiki True) headers
+  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 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 $ pack 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) = do
+  contents <- inlineListToXWiki lst
+  return contents
+
+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
+  let contents = pack contents'
+  return $
+    case Set.toList at of
+      [] -> "{{code}}" <> contents <> "{{/code}}"
+      (l:_) -> "{{code language=\"" <> (pack l) <> "\"}}" <> contents <> "{{/code}}"
+
+inlineToXWiki (Cite _ lst) = inlineListToXWiki lst
+
+-- FIXME: optionally support this (plugin?) 
+inlineToXWiki (Math _ str) = return $ "{{formula}}" <> (pack str) <> "{{/formula}}"
+
+inlineToXWiki il@(RawInline frmt str)
+  | frmt == Format "xwiki" = return $ pack 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 $ (pack src) <> (genAnchor id')
+     _  -> return $ "[[" <> label <> ">>" <> (pack src) <> "]]" <> (genAnchor id')
+
+inlineToXWiki (Image _ alt (source, tit)) = do
+  alt' <- inlineListToXWiki alt
+  let
+    titText = pack tit
+    params = intercalate " " $ filter (not . Text.null) [
+        if Text.null alt' then "" else "alt=\"" <> alt' <> "\"",
+          if Text.null titText then "" else "title=\"" <> titText <> "\""
+        ]
+  return $ "[[image:" <> (pack 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 ["--", "**", "//", "^^", ",,", "~"] ["~-~-", "~*~*", "~/~/", "~^~^", "~,~,", "~~"]
+