{-# LANGUAGE OverloadedStrings #-}
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.URI
import Text.Pandoc.Writers.MediaWiki (highlightingLangs)
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared (defField, metaToContext, toLegacyTable)
import Text.DocLayout (render, literal)
newtype WriterState = WriterState {
WriterState -> Text
listLevel :: Text
}
type XWikiReader m = ReaderT WriterState m
writeXWiki :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeXWiki :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeXWiki WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
let env :: WriterState
env = WriterState { listLevel :: Text
listLevel = Text
"" }
Context Text
metadata <- WriterOptions
-> ([Block] -> m (Doc Text))
-> ([Inline] -> m (Doc Text))
-> Meta
-> m (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
((Text -> Doc Text) -> m Text -> m (Doc Text)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Text -> Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trimr) (m Text -> m (Doc Text))
-> ([Block] -> m Text) -> [Block] -> m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[Block]
bs -> ReaderT WriterState m Text -> WriterState -> m Text
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ([Block] -> ReaderT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
[Block] -> XWikiReader m Text
blockListToXWiki [Block]
bs) WriterState
env))
((Text -> Doc Text) -> m Text -> m (Doc Text)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> (Text -> Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trimr) (m Text -> m (Doc Text))
-> ([Inline] -> m Text) -> [Inline] -> m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[Inline]
is -> ReaderT WriterState m Text -> WriterState -> m Text
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ([Inline] -> ReaderT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> XWikiReader m Text
inlineListToXWiki [Inline]
is) WriterState
env))
Meta
meta
Text
body <- ReaderT WriterState m Text -> WriterState -> m Text
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ([Block] -> ReaderT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
[Block] -> XWikiReader m Text
blockListToXWiki [Block]
blocks) WriterState
env
let context :: Context Text
context = Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Text
body
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"toc" (WriterOptions -> Bool
writerTableOfContents WriterOptions
opts) Context Text
metadata
Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$
case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
Just Template Text
tpl -> Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$ Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context
Maybe (Template Text)
Nothing -> Text
body
vcat :: [Text] -> Text
vcat :: [Text] -> Text
vcat = Text -> [Text] -> Text
intercalate Text
"\n"
genAnchor :: Text -> Text
genAnchor :: Text -> Text
genAnchor Text
id' = if Text -> Bool
Text.null Text
id'
then Text
""
else Text
"{{id name=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
id' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" /}}"
blockListToXWiki :: PandocMonad m => [Block] -> XWikiReader m Text
blockListToXWiki :: forall (m :: * -> *).
PandocMonad m =>
[Block] -> XWikiReader m Text
blockListToXWiki [Block]
blocks =
[Text] -> Text
vcat ([Text] -> Text)
-> ReaderT WriterState m [Text] -> ReaderT WriterState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> ReaderT WriterState m Text)
-> [Block] -> ReaderT WriterState m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Block -> ReaderT WriterState m Text
forall (m :: * -> *). PandocMonad m => Block -> XWikiReader m Text
blockToXWiki [Block]
blocks
blockToXWiki :: PandocMonad m => Block -> XWikiReader m Text
blockToXWiki :: forall (m :: * -> *). PandocMonad m => Block -> XWikiReader m Text
blockToXWiki (Div (Text
id', [Text]
_, [(Text, Text)]
_) [Block]
blocks) = do
Text
content <- [Block] -> XWikiReader m Text
forall (m :: * -> *).
PandocMonad m =>
[Block] -> XWikiReader m Text
blockListToXWiki [Block]
blocks
Text -> XWikiReader m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> XWikiReader m Text) -> Text -> XWikiReader m Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
genAnchor Text
id' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
content
blockToXWiki (Plain [Inline]
inlines) =
[Inline] -> XWikiReader m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> XWikiReader m Text
inlineListToXWiki [Inline]
inlines
blockToXWiki (Para [Inline]
inlines) = do
Text
contents <- [Inline] -> XWikiReader m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> XWikiReader m Text
inlineListToXWiki [Inline]
inlines
Text -> XWikiReader m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> XWikiReader m Text) -> Text -> XWikiReader m Text
forall a b. (a -> b) -> a -> b
$ Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
blockToXWiki (LineBlock [[Inline]]
lns) =
Block -> XWikiReader m Text
forall (m :: * -> *). PandocMonad m => Block -> XWikiReader m Text
blockToXWiki (Block -> XWikiReader m Text) -> Block -> XWikiReader m Text
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToXWiki b :: Block
b@(RawBlock Format
f Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"xwiki" = Text -> XWikiReader m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
str
| Bool
otherwise = Text
"" Text -> ReaderT WriterState m () -> XWikiReader m Text
forall a b. a -> ReaderT WriterState m b -> ReaderT WriterState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> ReaderT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Block -> LogMessage
BlockNotRendered Block
b)
blockToXWiki Block
HorizontalRule = Text -> XWikiReader m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\n----\n"
blockToXWiki (Header Int
level (Text
id', [Text]
_, [(Text, Text)]
_) [Inline]
inlines) = do
Text
contents <- [Inline] -> XWikiReader m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> XWikiReader m Text
inlineListToXWiki [Inline]
inlines
let eqs :: Text
eqs = Int -> Text -> Text
Text.replicate Int
level Text
"="
Text -> XWikiReader m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> XWikiReader m Text) -> Text -> XWikiReader m Text
forall a b. (a -> b) -> a -> b
$ Text
eqs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
genAnchor Text
id' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
eqs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
blockToXWiki (CodeBlock (Text, [Text], [(Text, Text)])
attrs Text
str) = do
Text
contents <- Inline -> XWikiReader m Text
forall (m :: * -> *). PandocMonad m => Inline -> XWikiReader m Text
inlineToXWiki ((Text, [Text], [(Text, Text)]) -> Text -> Inline
Code (Text, [Text], [(Text, Text)])
attrs (Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"))
Text -> XWikiReader m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> XWikiReader m Text) -> Text -> XWikiReader m Text
forall a b. (a -> b) -> a -> b
$ Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
blockToXWiki (BlockQuote [Block]
blocks) = do
Text
blockText <- [Block] -> XWikiReader m Text
forall (m :: * -> *).
PandocMonad m =>
[Block] -> XWikiReader m Text
blockListToXWiki [Block]
blocks
let quoteLines :: [Text]
quoteLines = (Char -> Bool) -> Text -> [Text]
split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
blockText
let prefixed :: [Text]
prefixed = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
">" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
quoteLines
Text -> XWikiReader m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> XWikiReader m Text) -> Text -> XWikiReader m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
vcat [Text]
prefixed
blockToXWiki (BulletList [[Block]]
contents) = Text -> [[Block]] -> XWikiReader m Text
forall (m :: * -> *).
PandocMonad m =>
Text -> [[Block]] -> XWikiReader m Text
blockToXWikiList Text
"*" [[Block]]
contents
blockToXWiki (OrderedList ListAttributes
_ [[Block]]
contents) = Text -> [[Block]] -> XWikiReader m Text
forall (m :: * -> *).
PandocMonad m =>
Text -> [[Block]] -> XWikiReader m Text
blockToXWikiList Text
"1" [[Block]]
contents
blockToXWiki (DefinitionList [([Inline], [[Block]])]
items) = do
Text
lev <- (WriterState -> Text) -> XWikiReader m Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterState -> Text
listLevel
[Text]
contents <- (WriterState -> WriterState)
-> ReaderT WriterState m [Text] -> ReaderT WriterState m [Text]
forall a.
(WriterState -> WriterState)
-> ReaderT WriterState m a -> ReaderT WriterState m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterState
s -> WriterState
s { listLevel = listLevel s <> ";" }) (ReaderT WriterState m [Text] -> ReaderT WriterState m [Text])
-> ReaderT WriterState m [Text] -> ReaderT WriterState m [Text]
forall a b. (a -> b) -> a -> b
$ (([Inline], [[Block]]) -> XWikiReader m Text)
-> [([Inline], [[Block]])] -> ReaderT WriterState m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Inline], [[Block]]) -> XWikiReader m Text
forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> XWikiReader m Text
definitionListItemToMediaWiki [([Inline], [[Block]])]
items
Text -> XWikiReader m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> XWikiReader m Text) -> Text -> XWikiReader m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
vcat [Text]
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Text -> Bool
Text.null Text
lev then Text
"\n" else Text
""
blockToXWiki (Figure (Text, [Text], [(Text, Text)])
attr Caption
_ [Block]
body) = do
Text
content <- Block -> XWikiReader m Text
forall (m :: * -> *). PandocMonad m => Block -> XWikiReader m Text
blockToXWiki (Block -> XWikiReader m Text) -> Block -> XWikiReader m Text
forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text, [Text], [(Text, Text)])
attr [Block]
body
Text -> XWikiReader m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> XWikiReader m Text) -> Text -> XWikiReader m Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
intercalate Text
content [Text
"(((\n", Text
"\n)))"]
blockToXWiki (Table (Text, [Text], [(Text, Text)])
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
let ([Inline]
_, [Alignment]
_, [Double]
_, [[Block]]
headers, [[[Block]]]
rows') = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
[Text]
headers' <- ([Block] -> XWikiReader m Text)
-> [[Block]] -> ReaderT WriterState m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Bool -> [Block] -> XWikiReader m Text
forall (m :: * -> *).
PandocMonad m =>
Bool -> [Block] -> XWikiReader m Text
tableCellXWiki Bool
True) ([[Block]] -> ReaderT WriterState m [Text])
-> [[Block]] -> ReaderT WriterState m [Text]
forall a b. (a -> b) -> a -> b
$ Int -> [[Block]] -> [[Block]]
forall a. Int -> [a] -> [a]
take ([ColSpec] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColSpec]
specs) ([[Block]] -> [[Block]]) -> [[Block]] -> [[Block]]
forall a b. (a -> b) -> a -> b
$ [[Block]]
headers [[Block]] -> [[Block]] -> [[Block]]
forall a. [a] -> [a] -> [a]
++ [Block] -> [[Block]]
forall a. a -> [a]
repeat []
[Text]
otherRows <- ([[Block]] -> XWikiReader m Text)
-> [[[Block]]] -> ReaderT WriterState m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [[Block]] -> XWikiReader m Text
forall (m :: * -> *).
PandocMonad m =>
[[Block]] -> XWikiReader m Text
formRow [[[Block]]]
rows'
Text -> XWikiReader m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> XWikiReader m Text) -> Text -> XWikiReader m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unlines ([Text] -> Text
Text.unwords [Text]
headers'Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
otherRows)
formRow :: PandocMonad m => [[Block]] -> XWikiReader m Text
formRow :: forall (m :: * -> *).
PandocMonad m =>
[[Block]] -> XWikiReader m Text
formRow [[Block]]
row = do
[Text]
cellStrings <- ([Block] -> XWikiReader m Text)
-> [[Block]] -> ReaderT WriterState m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Bool -> [Block] -> XWikiReader m Text
forall (m :: * -> *).
PandocMonad m =>
Bool -> [Block] -> XWikiReader m Text
tableCellXWiki Bool
False) [[Block]]
row
Text -> XWikiReader m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> XWikiReader m Text) -> Text -> XWikiReader m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unwords [Text]
cellStrings
tableCellXWiki :: PandocMonad m => Bool -> [Block] -> XWikiReader m Text
tableCellXWiki :: forall (m :: * -> *).
PandocMonad m =>
Bool -> [Block] -> XWikiReader m Text
tableCellXWiki Bool
isHeader [Block]
cell = do
Text
contents <- [Block] -> XWikiReader m Text
forall (m :: * -> *).
PandocMonad m =>
[Block] -> XWikiReader m Text
blockListToXWiki [Block]
cell
let isMultiline :: Bool
isMultiline = ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> Int) -> (Text -> [Text]) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')) Text
contents Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
let contents' :: Text
contents' = Text -> [Text] -> Text
intercalate Text
contents ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ if Bool
isMultiline then [Text
"(((", Text
")))"] else [Text
forall a. Monoid a => a
mempty, Text
forall a. Monoid a => a
mempty]
let cellBorder :: Text
cellBorder = if Bool
isHeader then Text
"|=" else Text
"|"
Text -> XWikiReader m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> XWikiReader m Text) -> Text -> XWikiReader m Text
forall a b. (a -> b) -> a -> b
$ Text
cellBorder Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents'
inlineListToXWiki :: PandocMonad m => [Inline] -> XWikiReader m Text
inlineListToXWiki :: forall (m :: * -> *).
PandocMonad m =>
[Inline] -> XWikiReader m Text
inlineListToXWiki [Inline]
lst =
[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text)
-> ReaderT WriterState m [Text] -> ReaderT WriterState m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> ReaderT WriterState m Text)
-> [Inline] -> ReaderT WriterState m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Inline -> ReaderT WriterState m Text
forall (m :: * -> *). PandocMonad m => Inline -> XWikiReader m Text
inlineToXWiki [Inline]
lst
inlineToXWiki :: PandocMonad m => Inline -> XWikiReader m Text
inlineToXWiki :: forall (m :: * -> *). PandocMonad m => Inline -> XWikiReader m Text
inlineToXWiki (Str Text
str) = Text -> ReaderT WriterState m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterState m Text)
-> Text -> ReaderT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeXWikiString Text
str
inlineToXWiki Inline
Space = Text -> ReaderT WriterState m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
" "
inlineToXWiki Inline
LineBreak = Text -> ReaderT WriterState m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\\\\"
inlineToXWiki Inline
SoftBreak = Text -> ReaderT WriterState m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
" "
inlineToXWiki (Emph [Inline]
lst) = do
Text
contents <- [Inline] -> ReaderT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> XWikiReader m Text
inlineListToXWiki [Inline]
lst
Text -> ReaderT WriterState m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterState m Text)
-> Text -> ReaderT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Text
"//" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"//"
inlineToXWiki (Underline [Inline]
lst) = do
Text
contents <- [Inline] -> ReaderT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> XWikiReader m Text
inlineListToXWiki [Inline]
lst
Text -> ReaderT WriterState m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterState m Text)
-> Text -> ReaderT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Text
"__" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"__"
inlineToXWiki (Strong [Inline]
lst) = do
Text
contents <- [Inline] -> ReaderT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> XWikiReader m Text
inlineListToXWiki [Inline]
lst
Text -> ReaderT WriterState m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterState m Text)
-> Text -> ReaderT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Text
"**" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"**"
inlineToXWiki (Strikeout [Inline]
lst) = do
Text
contents <- [Inline] -> ReaderT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> XWikiReader m Text
inlineListToXWiki [Inline]
lst
Text -> ReaderT WriterState m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterState m Text)
-> Text -> ReaderT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Text
"--" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"--"
inlineToXWiki (Superscript [Inline]
lst) = do
Text
contents <- [Inline] -> ReaderT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> XWikiReader m Text
inlineListToXWiki [Inline]
lst
Text -> ReaderT WriterState m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterState m Text)
-> Text -> ReaderT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Text
"^^" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"^^"
inlineToXWiki (Subscript [Inline]
lst) = do
Text
contents <- [Inline] -> ReaderT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> XWikiReader m Text
inlineListToXWiki [Inline]
lst
Text -> ReaderT WriterState m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterState m Text)
-> Text -> ReaderT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Text
",," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
",,"
inlineToXWiki (SmallCaps [Inline]
lst) =
[Inline] -> ReaderT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> XWikiReader m Text
inlineListToXWiki [Inline]
lst
inlineToXWiki (Quoted QuoteType
SingleQuote [Inline]
lst) = do
Text
contents <- [Inline] -> ReaderT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> XWikiReader m Text
inlineListToXWiki [Inline]
lst
Text -> ReaderT WriterState m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterState m Text)
-> Text -> ReaderT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Text
"‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"’"
inlineToXWiki (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
Text
contents <- [Inline] -> ReaderT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> XWikiReader m Text
inlineListToXWiki [Inline]
lst
Text -> ReaderT WriterState m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterState m Text)
-> Text -> ReaderT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Text
"“" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"”"
inlineToXWiki (Code (Text
_,[Text]
classes,[(Text, Text)]
_) Text
contents) = do
let at :: Set Text
at = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList [Text]
classes Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set Text
highlightingLangs
Text -> ReaderT WriterState m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterState m Text)
-> Text -> ReaderT WriterState m Text
forall a b. (a -> b) -> a -> b
$
case Set Text -> [Text]
forall a. Set a -> [a]
Set.toList Set Text
at of
[] -> Text
"{{code}}" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"{{/code}}"
(Text
l:[Text]
_) -> Text
"{{code language=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"}}" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"{{/code}}"
inlineToXWiki (Cite [Citation]
_ [Inline]
lst) = [Inline] -> ReaderT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> XWikiReader m Text
inlineListToXWiki [Inline]
lst
inlineToXWiki (Math MathType
_ Text
str) = Text -> ReaderT WriterState m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterState m Text)
-> Text -> ReaderT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Text
"{{formula}}" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"{{/formula}}"
inlineToXWiki il :: Inline
il@(RawInline Format
frmt Text
str)
| Format
frmt Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"xwiki" = Text -> ReaderT WriterState m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
str
| Bool
otherwise = Text
"" Text -> ReaderT WriterState m () -> ReaderT WriterState m Text
forall a b. a -> ReaderT WriterState m b -> ReaderT WriterState m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> ReaderT WriterState m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Inline -> LogMessage
InlineNotRendered Inline
il)
inlineToXWiki (Link (Text
id', [Text]
_, [(Text, Text)]
_) [Inline]
txt (Text
src, Text
_)) = do
Text
label <- [Inline] -> ReaderT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> XWikiReader m Text
inlineListToXWiki [Inline]
txt
case [Inline]
txt of
[Str Text
s] | Text -> Bool
isURI Text
src Bool -> Bool -> Bool
&& Text -> Text
escapeURI Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
src -> Text -> ReaderT WriterState m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterState m Text)
-> Text -> ReaderT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Text
src Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
genAnchor Text
id'
[Inline]
_ -> Text -> ReaderT WriterState m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterState m Text)
-> Text -> ReaderT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Text
"[[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]]" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
genAnchor Text
id'
inlineToXWiki (Image (Text, [Text], [(Text, Text)])
_ [Inline]
alt (Text
source, Text
tit)) = do
Text
alt' <- [Inline] -> ReaderT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> XWikiReader m Text
inlineListToXWiki [Inline]
alt
let
params :: Text
params = [Text] -> Text
Text.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null) [
if Text -> Bool
Text.null Text
alt' then Text
"" else Text
"alt=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
alt' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"",
if Text -> Bool
Text.null Text
tit then Text
"" else Text
"title=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tit Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
]
Text -> ReaderT WriterState m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterState m Text)
-> Text -> ReaderT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Text
"[[image:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
source Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Text -> Bool
Text.null Text
params then Text
"" else Text
"||" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
params) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]]"
inlineToXWiki (Note [Block]
contents) = do
Text
contents' <- [Block] -> ReaderT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
[Block] -> XWikiReader m Text
blockListToXWiki [Block]
contents
Text -> ReaderT WriterState m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterState m Text)
-> Text -> ReaderT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Text
"{{footnote}}" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
Text.strip Text
contents' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"{{/footnote}}"
inlineToXWiki (Span (Text
id', [Text]
_, [(Text, Text)]
_) [Inline]
contents) = do
Text
contents' <- [Inline] -> ReaderT WriterState m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> XWikiReader m Text
inlineListToXWiki [Inline]
contents
Text -> ReaderT WriterState m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderT WriterState m Text)
-> Text -> ReaderT WriterState m Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
genAnchor Text
id' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents'
blockToXWikiList :: PandocMonad m => Text -> [[Block]] -> XWikiReader m Text
blockToXWikiList :: forall (m :: * -> *).
PandocMonad m =>
Text -> [[Block]] -> XWikiReader m Text
blockToXWikiList Text
marker [[Block]]
contents = do
Text
lev <- (WriterState -> Text) -> XWikiReader m Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterState -> Text
listLevel
[Text]
contents' <- (WriterState -> WriterState)
-> ReaderT WriterState m [Text] -> ReaderT WriterState m [Text]
forall a.
(WriterState -> WriterState)
-> ReaderT WriterState m a -> ReaderT WriterState m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterState
s -> WriterState
s { listLevel = listLevel s <> marker } ) (ReaderT WriterState m [Text] -> ReaderT WriterState m [Text])
-> ReaderT WriterState m [Text] -> ReaderT WriterState m [Text]
forall a b. (a -> b) -> a -> b
$ ([Block] -> XWikiReader m Text)
-> [[Block]] -> ReaderT WriterState m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> XWikiReader m Text
forall (m :: * -> *).
PandocMonad m =>
[Block] -> XWikiReader m Text
listItemToXWiki [[Block]]
contents
Text -> XWikiReader m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> XWikiReader m Text) -> Text -> XWikiReader m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
vcat [Text]
contents' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Text -> Bool
Text.null Text
lev then Text
"\n" else Text
""
listItemToXWiki :: PandocMonad m => [Block] -> XWikiReader m Text
listItemToXWiki :: forall (m :: * -> *).
PandocMonad m =>
[Block] -> XWikiReader m Text
listItemToXWiki [Block]
contents = do
Text
marker <- (WriterState -> Text) -> XWikiReader m Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterState -> Text
listLevel
Text
contents' <- [Block] -> XWikiReader m Text
forall (m :: * -> *).
PandocMonad m =>
[Block] -> XWikiReader m Text
blockListToXWiki [Block]
contents
Text -> XWikiReader m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> XWikiReader m Text) -> Text -> XWikiReader m Text
forall a b. (a -> b) -> a -> b
$ Text
marker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
Text.strip Text
contents'
definitionListItemToMediaWiki :: PandocMonad m
=> ([Inline],[[Block]])
-> XWikiReader m Text
definitionListItemToMediaWiki :: forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> XWikiReader m Text
definitionListItemToMediaWiki ([Inline]
label, [[Block]]
items) = do
Text
labelText <- [Inline] -> XWikiReader m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> XWikiReader m Text
inlineListToXWiki [Inline]
label
[Text]
contents <- ([Block] -> XWikiReader m Text)
-> [[Block]] -> ReaderT WriterState m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Block] -> XWikiReader m Text
forall (m :: * -> *).
PandocMonad m =>
[Block] -> XWikiReader m Text
blockListToXWiki [[Block]]
items
Text
marker <- (WriterState -> Text) -> XWikiReader m Text
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterState -> Text
listLevel
Text -> XWikiReader m Text
forall a. a -> ReaderT WriterState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> XWikiReader m Text) -> Text -> XWikiReader m Text
forall a b. (a -> b) -> a -> b
$ Text
marker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
labelText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> [Text] -> Text
intercalate Text
"\n" ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
d -> HasCallStack => Text -> Text
Text -> Text
Text.init Text
marker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d) [Text]
contents)
escapeXWikiString :: Text -> Text
escapeXWikiString :: Text -> Text
escapeXWikiString Text
s = ((Text, Text) -> Text -> Text) -> Text -> [(Text, Text)] -> Text
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Text -> Text -> Text -> Text) -> (Text, Text) -> Text -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
replace) Text
s ([(Text, Text)] -> Text) -> [(Text, Text)] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text
"--", Text
"**", Text
"//", Text
"^^", Text
",,", Text
"~"] [Text
"~-~-", Text
"~*~*", Text
"~/~/", Text
"~^~^", Text
"~,~,", Text
"~~"]