diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Text/Pandoc/Writers.hs | 3 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/MediaWiki.hs | 2 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/XWiki.hs | 266 |
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 ["--", "**", "//", "^^", ",,", "~"] ["~-~-", "~*~*", "~/~/", "~^~^", "~,~,", "~~"] + |