{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {- Copyright (C) 2008-2017 John MacFarlane 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 Stability : alpha Portability : portable Conversion of 'Pandoc' documents to XWiki markup. XWiki: XWiki Syntax: -} 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 ["--", "**", "//", "^^", ",,", "~"] ["~-~-", "~*~*", "~/~/", "~^~^", "~,~,", "~~"]