{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Writers.MediaWiki ( writeMediaWiki, highlightingLangs ) where
import Control.Monad.Reader
import Control.Monad.State.Strict
import Data.Maybe (fromMaybe)
import qualified Data.List as DL
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Data.List.NonEmpty (NonEmpty((:|)))
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Walk
import Text.DocLayout (render, literal)
import Text.Pandoc.Shared
import Text.Pandoc.URI
import Text.Pandoc.Templates (renderTemplate)
import qualified Text.Pandoc.Writers.AnnotatedTable as Ann
import Text.Pandoc.Writers.Shared
import Text.Pandoc.XML (escapeStringForXML)
data WriterState = WriterState {
WriterState -> Bool
stNotes :: Bool
, WriterState -> WriterOptions
stOptions :: WriterOptions
}
data WriterReader = WriterReader {
WriterReader -> WriterOptions
options :: WriterOptions
, WriterReader -> [Char]
listLevel :: [Char]
, WriterReader -> Bool
useTags :: Bool
}
type MediaWikiWriter m = ReaderT WriterReader (StateT WriterState m)
writeMediaWiki :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeMediaWiki :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeMediaWiki WriterOptions
opts Pandoc
document =
let initialState :: WriterState
initialState = WriterState { stNotes :: Bool
stNotes = Bool
False, stOptions :: WriterOptions
stOptions = WriterOptions
opts }
env :: WriterReader
env = WriterReader { options :: WriterOptions
options = WriterOptions
opts, listLevel :: [Char]
listLevel = [], useTags :: Bool
useTags = Bool
False }
in StateT WriterState m Text -> WriterState -> m Text
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (ReaderT WriterReader (StateT WriterState m) Text
-> WriterReader -> StateT WriterState m Text
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Pandoc -> ReaderT WriterReader (StateT WriterState m) Text
forall (m :: * -> *).
PandocMonad m =>
Pandoc -> MediaWikiWriter m Text
pandocToMediaWiki Pandoc
document) WriterReader
env) WriterState
initialState
pandocToMediaWiki :: PandocMonad m => Pandoc -> MediaWikiWriter m Text
pandocToMediaWiki :: forall (m :: * -> *).
PandocMonad m =>
Pandoc -> MediaWikiWriter m Text
pandocToMediaWiki (Pandoc Meta
meta [Block]
blocks) = do
opts <- (WriterReader -> WriterOptions)
-> ReaderT WriterReader (StateT WriterState m) WriterOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterReader -> WriterOptions
options
metadata <- metaToContext opts
(fmap (literal . trimr) . blockListToMediaWiki)
(fmap (literal . trimr) . inlineListToMediaWiki)
meta
body <- blockListToMediaWiki blocks
notesExist <- gets stNotes
let notes = if Bool
notesExist
then Text
"\n<references />"
else Text
""
let main = Text
body Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
notes
let context = Text -> Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Text
main
(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
return $
case writerTemplate opts of
Maybe (Template Text)
Nothing -> Text
main
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
escapeText :: Text -> Text
escapeText :: Text -> Text
escapeText = Text -> Text
escapeStringForXML
blockToMediaWiki :: PandocMonad m
=> Block
-> MediaWikiWriter m Text
blockToMediaWiki :: forall (m :: * -> *).
PandocMonad m =>
Block -> MediaWikiWriter m Text
blockToMediaWiki (Div Attr
attrs [Block]
bs) = do
contents <- [Block] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Block] -> MediaWikiWriter m Text
blockListToMediaWiki [Block]
bs
return $ render Nothing (tagWithAttrs "div" attrs) <> "\n\n" <>
contents <> "\n\n" <> "</div>"
blockToMediaWiki (Plain [Inline]
inlines) =
[Inline] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> MediaWikiWriter m Text
inlineListToMediaWiki [Inline]
inlines
blockToMediaWiki (SimpleFigure Attr
attr [Inline]
txt (Text
src, Text
tit)) = do
capt <- [Inline] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> MediaWikiWriter m Text
inlineListToMediaWiki [Inline]
txt
img <- imageToMediaWiki attr
let opt = if Text -> Bool
T.null Text
tit
then
if Text -> Bool
T.null Text
capt
then Text
""
else Text
"alt=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
capt
else Text
"alt=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tit
return $ "[[" <>
T.intercalate "|"
(filter (not . T.null) ["File:" <> src
, "thumb"
, "none"
, img
, opt
, capt
]) <>
"]]\n"
blockToMediaWiki (Para [Inline]
inlines) = do
tags <- (WriterReader -> Bool)
-> ReaderT WriterReader (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterReader -> Bool
useTags
lev <- asks listLevel
contents <- inlineListToMediaWiki inlines
let initEsc = if Text -> Bool
startsWithListMarker Text
contents
then Text
"\\"
else Text
""
return $ if tags
then "<p>" <> contents <> "</p>"
else initEsc <> contents <> if null lev then "\n" else ""
blockToMediaWiki (LineBlock [[Inline]]
lns) =
Block -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
Block -> MediaWikiWriter m Text
blockToMediaWiki (Block -> MediaWikiWriter m Text)
-> Block -> MediaWikiWriter m Text
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToMediaWiki b :: Block
b@(RawBlock Format
f Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"mediawiki" = Text -> MediaWikiWriter m Text
forall a. a -> ReaderT WriterReader (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
str
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"html" = Text -> MediaWikiWriter m Text
forall a. a -> ReaderT WriterReader (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
str
| Bool
otherwise = Text
"" Text
-> ReaderT WriterReader (StateT WriterState m) ()
-> MediaWikiWriter m Text
forall a b.
a
-> ReaderT WriterReader (StateT WriterState m) b
-> ReaderT WriterReader (StateT WriterState m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> ReaderT WriterReader (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Block -> LogMessage
BlockNotRendered Block
b)
blockToMediaWiki Block
HorizontalRule = Text -> MediaWikiWriter m Text
forall a. a -> ReaderT WriterReader (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\n-----\n"
blockToMediaWiki (Header Int
level (Text
ident,[Text]
_,[(Text, Text)]
_) [Inline]
inlines) = do
let autoId :: Text
autoId = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
" " Text
"_" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
inlines
contents <- [Inline] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> MediaWikiWriter m Text
inlineListToMediaWiki [Inline]
inlines
let eqs = Int -> Text -> Text
T.replicate Int
level Text
"="
return $
(if T.null ident || autoId == ident
then ""
else "<span id=\"" <> ident <> "\"></span>\n")
<> eqs <> " " <> contents <> " " <> eqs <> "\n"
blockToMediaWiki (CodeBlock (Text
_,[Text]
classes,[(Text, Text)]
keyvals) Text
str) = 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
let numberLines :: Bool
numberLines = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"number",Text
"numberLines", Text
"number-lines"])
[Text]
classes
let start :: Maybe Text
start = Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"startFrom" [(Text, Text)]
keyvals
Text -> MediaWikiWriter m Text
forall a. a -> ReaderT WriterReader (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MediaWikiWriter m Text) -> Text -> MediaWikiWriter 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
"<pre" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
classes
then Text
">"
else Text
" class=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
classes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\">") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> Text
escapeText Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</pre>"
(Text
l:[Text]
_) -> Text
"<syntaxhighlight lang=\"" 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
<>
(if Bool
numberLines then Text
" line" else Text
"") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Text
x -> Text
" start=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"") Maybe Text
start Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
">" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"</syntaxhighlight>"
blockToMediaWiki (BlockQuote [Block]
blocks) = do
contents <- [Block] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Block] -> MediaWikiWriter m Text
blockListToMediaWiki [Block]
blocks
return $ "<blockquote>" <> contents <> "</blockquote>"
blockToMediaWiki (Table Attr
attr Caption
capt [ColSpec]
colSpecs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
Table -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
Table -> MediaWikiWriter m Text
tableToMediaWiki (Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Table
Ann.toTable Attr
attr Caption
capt [ColSpec]
colSpecs TableHead
thead [TableBody]
tbody TableFoot
tfoot)
blockToMediaWiki x :: Block
x@(BulletList [[Block]]
items) = do
tags <-
(Bool -> Bool -> Bool
|| Bool -> Bool
not (Block -> Bool
isSimpleList Block
x)) (Bool -> Bool)
-> ReaderT WriterReader (StateT WriterState m) Bool
-> ReaderT WriterReader (StateT WriterState m) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterReader -> Bool)
-> ReaderT WriterReader (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterReader -> Bool
useTags
if tags
then do
contents <- local (\ WriterReader
s -> WriterReader
s { useTags = True }) $ mapM listItemToMediaWiki items
return $ "<ul>\n" <> vcat contents <> "</ul>\n"
else do
lev <- asks listLevel
contents <- local (\WriterReader
s -> WriterReader
s { listLevel = listLevel s <> "*" }) $ mapM listItemToMediaWiki items
return $ vcat contents <> if null lev then "\n" else ""
blockToMediaWiki x :: Block
x@(OrderedList ListAttributes
attribs [[Block]]
items) = do
tags <-
(Bool -> Bool -> Bool
|| Bool -> Bool
not (Block -> Bool
isSimpleList Block
x)) (Bool -> Bool)
-> ReaderT WriterReader (StateT WriterState m) Bool
-> ReaderT WriterReader (StateT WriterState m) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterReader -> Bool)
-> ReaderT WriterReader (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterReader -> Bool
useTags
if tags
then do
contents <- local (\WriterReader
s -> WriterReader
s { useTags = True }) $ mapM listItemToMediaWiki items
return $ "<ol" <> listAttribsToText attribs <> ">\n" <> vcat contents <> "</ol>\n"
else do
lev <- asks listLevel
contents <- local (\WriterReader
s -> WriterReader
s { listLevel = listLevel s <> "#" }) $ mapM listItemToMediaWiki items
return $ vcat contents <> if null lev then "\n" else ""
blockToMediaWiki x :: Block
x@(DefinitionList [([Inline], [[Block]])]
items) = do
tags <-
(Bool -> Bool -> Bool
|| Bool -> Bool
not (Block -> Bool
isSimpleList Block
x)) (Bool -> Bool)
-> ReaderT WriterReader (StateT WriterState m) Bool
-> ReaderT WriterReader (StateT WriterState m) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterReader -> Bool)
-> ReaderT WriterReader (StateT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterReader -> Bool
useTags
if tags
then do
contents <- local (\WriterReader
s -> WriterReader
s { useTags = True }) $ mapM definitionListItemToMediaWiki items
return $ "<dl>\n" <> vcat contents <> "</dl>\n"
else do
lev <- asks listLevel
contents <- local (\WriterReader
s -> WriterReader
s { listLevel = listLevel s <> ";" }) $ mapM definitionListItemToMediaWiki items
return $ vcat contents <> if null lev then "\n" else ""
blockToMediaWiki (Figure (Text
ident, [Text]
classes, [(Text, Text)]
kvs) Caption
_ [Block]
body) =
Block -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
Block -> MediaWikiWriter m Text
blockToMediaWiki (Attr -> [Block] -> Block
Div (Text
ident, [Text
"figure"] [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
`DL.union` [Text]
classes, [(Text, Text)]
kvs) [Block]
body)
listAttribsToText :: ListAttributes -> Text
listAttribsToText :: ListAttributes -> Text
listAttribsToText (Int
startnum, ListNumberStyle
numstyle, ListNumberDelim
_) =
let numstyle' :: Text
numstyle' = Text -> Text
camelCaseToHyphenated (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ListNumberStyle -> Text
forall a. Show a => a -> Text
tshow ListNumberStyle
numstyle
in (if Int
startnum Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1
then Text
" start=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
startnum Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
else Text
"") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
(if ListNumberStyle
numstyle ListNumberStyle -> ListNumberStyle -> Bool
forall a. Eq a => a -> a -> Bool
/= ListNumberStyle
DefaultStyle
then Text
" style=\"list-style-type: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
numstyle' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";\""
else Text
"")
listItemToMediaWiki :: PandocMonad m => [Block] -> MediaWikiWriter m Text
listItemToMediaWiki :: forall (m :: * -> *).
PandocMonad m =>
[Block] -> MediaWikiWriter m Text
listItemToMediaWiki [Block]
items = do
contents <- [Block] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Block] -> MediaWikiWriter m Text
blockListToMediaWiki [Block]
items
tags <- asks useTags
if tags
then return $ "<li>" <> contents <> "</li>"
else do
marker <- asks listLevel
return $ T.pack marker <> " " <> contents
definitionListItemToMediaWiki :: PandocMonad m
=> ([Inline],[[Block]])
-> MediaWikiWriter m Text
definitionListItemToMediaWiki :: forall (m :: * -> *).
PandocMonad m =>
([Inline], [[Block]]) -> MediaWikiWriter m Text
definitionListItemToMediaWiki ([Inline]
label, [[Block]]
items) = do
labelText <- [Inline] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> MediaWikiWriter m Text
inlineListToMediaWiki [Inline]
label
contents <- mapM blockListToMediaWiki items
tags <- asks useTags
if tags
then return $ "<dt>" <> labelText <> "</dt>\n" <>
T.intercalate "\n" (map (\Text
d -> Text
"<dd>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</dd>") contents)
else do
marker <- asks listLevel
return $ T.pack marker <> " " <> labelText <> "\n" <>
T.intercalate "\n" (map (\Text
d -> [Char] -> Text
T.pack ([Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
init [Char]
marker) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d) contents)
isSimpleList :: Block -> Bool
isSimpleList :: Block -> Bool
isSimpleList Block
x =
case Block
x of
BulletList [[Block]]
items -> ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
isSimpleListItem [[Block]]
items
OrderedList (Int
num, ListNumberStyle
sty, ListNumberDelim
_) [[Block]]
items -> ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
isSimpleListItem [[Block]]
items Bool -> Bool -> Bool
&&
Int
num Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& ListNumberStyle
sty ListNumberStyle -> [ListNumberStyle] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ListNumberStyle
DefaultStyle, ListNumberStyle
Decimal]
DefinitionList [([Inline], [[Block]])]
items -> ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
isSimpleListItem ([[Block]] -> Bool) -> [[Block]] -> Bool
forall a b. (a -> b) -> a -> b
$ (([Inline], [[Block]]) -> [[Block]])
-> [([Inline], [[Block]])] -> [[Block]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Inline], [[Block]]) -> [[Block]]
forall a b. (a, b) -> b
snd [([Inline], [[Block]])]
items
Block
_ -> Bool
False
isSimpleListItem :: [Block] -> Bool
isSimpleListItem :: [Block] -> Bool
isSimpleListItem [] = Bool
True
isSimpleListItem [Block
x] =
case Block
x of
Plain [Inline]
_ -> Bool
True
Para [Inline]
_ -> Bool
True
BulletList [[Block]]
_ -> Block -> Bool
isSimpleList Block
x
OrderedList ListAttributes
_ [[Block]]
_ -> Block -> Bool
isSimpleList Block
x
DefinitionList [([Inline], [[Block]])]
_ -> Block -> Bool
isSimpleList Block
x
Block
_ -> Bool
False
isSimpleListItem [Block
x, Block
y] | Block -> Bool
isPlainOrPara Block
x =
case Block
y of
BulletList [[Block]]
_ -> Block -> Bool
isSimpleList Block
y
OrderedList ListAttributes
_ [[Block]]
_ -> Block -> Bool
isSimpleList Block
y
DefinitionList [([Inline], [[Block]])]
_ -> Block -> Bool
isSimpleList Block
y
Block
_ -> Bool
False
isSimpleListItem [Block]
_ = Bool
False
isPlainOrPara :: Block -> Bool
isPlainOrPara :: Block -> Bool
isPlainOrPara (Plain [Inline]
_) = Bool
True
isPlainOrPara (Para [Inline]
_) = Bool
True
isPlainOrPara Block
_ = Bool
False
vcat :: [Text] -> Text
vcat :: [Text] -> Text
vcat = Text -> [Text] -> Text
T.intercalate Text
"\n"
tableToMediaWiki :: PandocMonad m => Ann.Table -> MediaWikiWriter m Text
tableToMediaWiki :: forall (m :: * -> *).
PandocMonad m =>
Table -> MediaWikiWriter m Text
tableToMediaWiki (Ann.Table Attr
attr Caption
capt [ColSpec]
_ TableHead
thead [TableBody]
tbodies TableFoot
tfoot) = do
let (Text
ident,[Text]
classes,[(Text, Text)]
kvs) = Attr
attr
caption <- case Caption
capt of
Caption Maybe [Inline]
_ [] -> [Text] -> ReaderT WriterReader (StateT WriterState m) [Text]
forall a. a -> ReaderT WriterReader (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
forall a. Monoid a => a
mempty
Caption Maybe [Inline]
_ [Block]
longCapt -> do
c <- [Block] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Block] -> MediaWikiWriter m Text
blockListToMediaWiki [Block]
longCapt
return [ "|+ " <> trimr c ]
head' <- tableHeadToMW thead
bodies' <- concat <$> mapM tableBodyToMW tbodies
foot' <- tableFootToMW tfoot
return $ T.unlines $ [
"{|" <> (render Nothing (htmlAttrs (ident, "wikitable":classes, kvs)))
] <> caption <> head' <> bodies' <> foot' <> [
"|}"
]
tableHeadToMW :: PandocMonad m => Ann.TableHead -> MediaWikiWriter m [Text]
tableHeadToMW :: forall (m :: * -> *).
PandocMonad m =>
TableHead -> MediaWikiWriter m [Text]
tableHeadToMW (Ann.TableHead Attr
_ [HeaderRow]
rows) = [HeaderRow] -> MediaWikiWriter m [Text]
forall (m :: * -> *).
PandocMonad m =>
[HeaderRow] -> MediaWikiWriter m [Text]
headerRowsToMW [HeaderRow]
rows
tableFootToMW :: PandocMonad m => Ann.TableFoot -> MediaWikiWriter m [Text]
(Ann.TableFoot Attr
_ [HeaderRow]
rows) = [HeaderRow] -> MediaWikiWriter m [Text]
forall (m :: * -> *).
PandocMonad m =>
[HeaderRow] -> MediaWikiWriter m [Text]
headerRowsToMW [HeaderRow]
rows
tableBodyToMW :: PandocMonad m => Ann.TableBody -> MediaWikiWriter m [Text]
tableBodyToMW :: forall (m :: * -> *).
PandocMonad m =>
TableBody -> MediaWikiWriter m [Text]
tableBodyToMW (Ann.TableBody Attr
_ RowHeadColumns
_ [HeaderRow]
headerRows [BodyRow]
bodyRows) = do
headerRows' <- [HeaderRow] -> MediaWikiWriter m [Text]
forall (m :: * -> *).
PandocMonad m =>
[HeaderRow] -> MediaWikiWriter m [Text]
headerRowsToMW [HeaderRow]
headerRows
bodyRows' <- bodyRowsToMW bodyRows
return $ headerRows' <> bodyRows'
headerRowsToMW :: PandocMonad m => [Ann.HeaderRow] -> MediaWikiWriter m [Text]
[HeaderRow]
rows = (\[[Text]]
x -> [[Text]] -> [Text]
forall a. Monoid a => [a] -> a
mconcat [[Text]]
x) ([[Text]] -> [Text])
-> ReaderT WriterReader (StateT WriterState m) [[Text]]
-> ReaderT WriterReader (StateT WriterState m) [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HeaderRow -> ReaderT WriterReader (StateT WriterState m) [Text])
-> [HeaderRow]
-> ReaderT WriterReader (StateT 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 HeaderRow -> ReaderT WriterReader (StateT WriterState m) [Text]
forall (m :: * -> *).
PandocMonad m =>
HeaderRow -> MediaWikiWriter m [Text]
headerRowToMW [HeaderRow]
rows
headerRowToMW :: PandocMonad m => Ann.HeaderRow -> MediaWikiWriter m [Text]
(Ann.HeaderRow Attr
attr RowNumber
_ [Cell]
cells) = do
cells' <- (\[[Text]]
x -> [[Text]] -> [Text]
forall a. Monoid a => [a] -> a
mconcat [[Text]]
x) ([[Text]] -> [Text])
-> ReaderT WriterReader (StateT WriterState m) [[Text]]
-> ReaderT WriterReader (StateT WriterState m) [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cell -> ReaderT WriterReader (StateT WriterState m) [Text])
-> [Cell] -> ReaderT WriterReader (StateT 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 (Text -> Cell -> ReaderT WriterReader (StateT WriterState m) [Text]
forall (m :: * -> *).
PandocMonad m =>
Text -> Cell -> MediaWikiWriter m [Text]
cellToMW Text
"!") [Cell]
cells
return $ ["|-" <> (render Nothing (htmlAttrs attr))] <> cells'
bodyRowsToMW :: PandocMonad m => [Ann.BodyRow] -> MediaWikiWriter m [Text]
bodyRowsToMW :: forall (m :: * -> *).
PandocMonad m =>
[BodyRow] -> MediaWikiWriter m [Text]
bodyRowsToMW [BodyRow]
rows = (\[[Text]]
x -> [[Text]] -> [Text]
forall a. Monoid a => [a] -> a
mconcat [[Text]]
x) ([[Text]] -> [Text])
-> ReaderT WriterReader (StateT WriterState m) [[Text]]
-> ReaderT WriterReader (StateT WriterState m) [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BodyRow -> ReaderT WriterReader (StateT WriterState m) [Text])
-> [BodyRow]
-> ReaderT WriterReader (StateT 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 BodyRow -> ReaderT WriterReader (StateT WriterState m) [Text]
forall (m :: * -> *).
PandocMonad m =>
BodyRow -> MediaWikiWriter m [Text]
bodyRowToMW [BodyRow]
rows
bodyRowToMW :: PandocMonad m => Ann.BodyRow -> MediaWikiWriter m [Text]
bodyRowToMW :: forall (m :: * -> *).
PandocMonad m =>
BodyRow -> MediaWikiWriter m [Text]
bodyRowToMW (Ann.BodyRow Attr
attr RowNumber
_ [Cell]
headCells [Cell]
bodyCells) = do
headCells' <- (\[[Text]]
x -> [[Text]] -> [Text]
forall a. Monoid a => [a] -> a
mconcat [[Text]]
x) ([[Text]] -> [Text])
-> ReaderT WriterReader (StateT WriterState m) [[Text]]
-> ReaderT WriterReader (StateT WriterState m) [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cell -> ReaderT WriterReader (StateT WriterState m) [Text])
-> [Cell] -> ReaderT WriterReader (StateT 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 (Text -> Cell -> ReaderT WriterReader (StateT WriterState m) [Text]
forall (m :: * -> *).
PandocMonad m =>
Text -> Cell -> MediaWikiWriter m [Text]
cellToMW Text
"!") [Cell]
headCells
bodyCells' <- (\[[Text]]
x -> [[Text]] -> [Text]
forall a. Monoid a => [a] -> a
mconcat [[Text]]
x) <$> mapM (cellToMW "|") bodyCells
return $ ["|-" <> (render Nothing (htmlAttrs attr))] <> headCells' <> bodyCells'
cellToMW :: PandocMonad m => Text -> Ann.Cell -> MediaWikiWriter m [Text]
cellToMW :: forall (m :: * -> *).
PandocMonad m =>
Text -> Cell -> MediaWikiWriter m [Text]
cellToMW Text
marker (Ann.Cell (ColSpec
colSpec :| [ColSpec]
_) ColNumber
_ (Cell Attr
attr Alignment
align RowSpan
rowspan ColSpan
colspan [Block]
content)) = do
content' <- [Block] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Block] -> MediaWikiWriter m Text
blockListToMediaWiki [Block]
content
let (ident,classes,keyVals) = attr
let align' = case Alignment
align of
Alignment
AlignDefault -> ColSpec -> Alignment
forall a b. (a, b) -> a
fst ColSpec
colSpec
Alignment
_ -> Alignment
align
let keyVals' = case (Alignment -> Maybe Text
htmlAlignmentToString Alignment
align') of
Maybe Text
Nothing -> [(Text, Text)]
keyVals
Just Text
alignStr -> (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
htmlAddStyle (Text
"text-align", Text
alignStr) [(Text, Text)]
keyVals
let rowspan' = case RowSpan
rowspan of
RowSpan Int
1 -> [(Text, Text)]
forall a. Monoid a => a
mempty
RowSpan Int
n -> [(Text
"rowspan", [Char] -> Text
T.pack(Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n))]
let colspan' = case ColSpan
colspan of
ColSpan Int
1 -> [(Text, Text)]
forall a. Monoid a => a
mempty
ColSpan Int
n -> [(Text
"colspan", [Char] -> Text
T.pack(Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n))]
let attrs' = Text -> Text
addPipeIfNotEmpty (Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Attr -> Doc Text
forall a. HasChars a => Attr -> Doc a
htmlAttrs (Text
ident, [Text]
classes, [(Text, Text)]
rowspan' [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
colspan' [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
keyVals')))
return [marker <> attrs' <> addSpaceIfNotEmpty(content')]
addPipeIfNotEmpty :: Text -> Text
addPipeIfNotEmpty :: Text -> Text
addPipeIfNotEmpty Text
f = if Text -> Bool
T.null Text
f then Text
f else Text
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"|"
addSpaceIfNotEmpty :: Text -> Text
addSpaceIfNotEmpty :: Text -> Text
addSpaceIfNotEmpty Text
f = if Text -> Bool
T.null Text
f then Text
f else Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
f
imageToMediaWiki :: PandocMonad m => Attr -> MediaWikiWriter m Text
imageToMediaWiki :: forall (m :: * -> *).
PandocMonad m =>
Attr -> MediaWikiWriter m Text
imageToMediaWiki Attr
attr = do
opts <- (WriterState -> WriterOptions)
-> ReaderT WriterReader (StateT WriterState m) WriterOptions
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> WriterOptions
stOptions
let (_, cls, _) = attr
toPx = (Dimension -> Text) -> Maybe Dimension -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WriterOptions -> Dimension -> Text
showInPixel WriterOptions
opts) (Maybe Dimension -> Maybe Text)
-> (Maybe Dimension -> Maybe Dimension)
-> Maybe Dimension
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Dimension -> Maybe Dimension
checkPct
checkPct (Just (Percent Double
_)) = Maybe Dimension
forall a. Maybe a
Nothing
checkPct Maybe Dimension
maybeDim = Maybe Dimension
maybeDim
go (Just a
w) Maybe a
Nothing = a
w a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"px"
go (Just a
w) (Just a
h) = a
w a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"x" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
h a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"px"
go Maybe a
Nothing (Just a
h) = a
"x" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
h a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"px"
go Maybe a
Nothing Maybe a
Nothing = a
""
dims = Maybe Text -> Maybe Text -> Text
forall {a}. (Semigroup a, IsString a) => Maybe a -> Maybe a -> a
go (Maybe Dimension -> Maybe Text
toPx (Maybe Dimension -> Maybe Text) -> Maybe Dimension -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Direction -> Attr -> Maybe Dimension
dimension Direction
Width Attr
attr) (Maybe Dimension -> Maybe Text
toPx (Maybe Dimension -> Maybe Text) -> Maybe Dimension -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Direction -> Attr -> Maybe Dimension
dimension Direction
Height Attr
attr)
classes = if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
cls
then Text
""
else Text
"class=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
cls
return $ T.intercalate "|" $ filter (not . T.null) [dims, classes]
blockListToMediaWiki :: PandocMonad m
=> [Block]
-> MediaWikiWriter m Text
blockListToMediaWiki :: forall (m :: * -> *).
PandocMonad m =>
[Block] -> MediaWikiWriter m Text
blockListToMediaWiki [Block]
blocks =
[Text] -> Text
vcat ([Text] -> Text)
-> ReaderT WriterReader (StateT WriterState m) [Text]
-> ReaderT WriterReader (StateT WriterState m) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> ReaderT WriterReader (StateT WriterState m) Text)
-> [Block] -> ReaderT WriterReader (StateT 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 WriterReader (StateT WriterState m) Text
forall (m :: * -> *).
PandocMonad m =>
Block -> MediaWikiWriter m Text
blockToMediaWiki [Block]
blocks
inlineListToMediaWiki :: PandocMonad m => [Inline] -> MediaWikiWriter m Text
inlineListToMediaWiki :: forall (m :: * -> *).
PandocMonad m =>
[Inline] -> MediaWikiWriter m Text
inlineListToMediaWiki [Inline]
lst =
([Text] -> Text)
-> ReaderT WriterReader (StateT WriterState m) [Text]
-> ReaderT WriterReader (StateT WriterState m) Text
forall a b.
(a -> b)
-> ReaderT WriterReader (StateT WriterState m) a
-> ReaderT WriterReader (StateT WriterState m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
T.concat (ReaderT WriterReader (StateT WriterState m) [Text]
-> ReaderT WriterReader (StateT WriterState m) Text)
-> ReaderT WriterReader (StateT WriterState m) [Text]
-> ReaderT WriterReader (StateT WriterState m) Text
forall a b. (a -> b) -> a -> b
$ (Inline -> ReaderT WriterReader (StateT WriterState m) Text)
-> [Inline] -> ReaderT WriterReader (StateT 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 WriterReader (StateT WriterState m) Text
forall (m :: * -> *).
PandocMonad m =>
Inline -> MediaWikiWriter m Text
inlineToMediaWiki ([Inline] -> ReaderT WriterReader (StateT WriterState m) [Text])
-> [Inline] -> ReaderT WriterReader (StateT WriterState m) [Text]
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Inline]
fixup [Inline]
lst
where
fixup :: [Inline] -> [Inline]
fixup [] = []
fixup (Str Text
t : Inline
x : [Inline]
xs)
| Bool -> Bool
not (Text -> Bool
T.null Text
t) Bool -> Bool -> Bool
&& HasCallStack => Text -> Char
Text -> Char
T.last Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'['
, Inline -> Bool
isLinkOrImage Inline
x =
Text -> Inline
Str Text
t Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"mediawiki") Text
"<nowiki/>" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
fixup [Inline]
xs
fixup (Inline
x:[Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
fixup [Inline]
xs
isLinkOrImage :: Inline -> Bool
isLinkOrImage Link{} = Bool
True
isLinkOrImage Image{} = Bool
True
isLinkOrImage Inline
_ = Bool
False
inlineToMediaWiki :: PandocMonad m => Inline -> MediaWikiWriter m Text
inlineToMediaWiki :: forall (m :: * -> *).
PandocMonad m =>
Inline -> MediaWikiWriter m Text
inlineToMediaWiki (Span Attr
attrs [Inline]
ils) = do
contents <- [Inline] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> MediaWikiWriter m Text
inlineListToMediaWiki [Inline]
ils
return $ render Nothing (tagWithAttrs "span" attrs) <> contents <> "</span>"
inlineToMediaWiki (Emph [Inline]
lst) = do
contents <- [Inline] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> MediaWikiWriter m Text
inlineListToMediaWiki [Inline]
lst
return $ "''" <> contents <> "''"
inlineToMediaWiki (Underline [Inline]
lst) = do
contents <- [Inline] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> MediaWikiWriter m Text
inlineListToMediaWiki [Inline]
lst
return $ "<u>" <> contents <> "</u>"
inlineToMediaWiki (Strong [Inline]
lst) = do
contents <- [Inline] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> MediaWikiWriter m Text
inlineListToMediaWiki [Inline]
lst
return $ "'''" <> contents <> "'''"
inlineToMediaWiki (Strikeout [Inline]
lst) = do
contents <- [Inline] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> MediaWikiWriter m Text
inlineListToMediaWiki [Inline]
lst
return $ "<s>" <> contents <> "</s>"
inlineToMediaWiki (Superscript [Inline]
lst) = do
contents <- [Inline] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> MediaWikiWriter m Text
inlineListToMediaWiki [Inline]
lst
return $ "<sup>" <> contents <> "</sup>"
inlineToMediaWiki (Subscript [Inline]
lst) = do
contents <- [Inline] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> MediaWikiWriter m Text
inlineListToMediaWiki [Inline]
lst
return $ "<sub>" <> contents <> "</sub>"
inlineToMediaWiki (SmallCaps [Inline]
lst) = [Inline] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> MediaWikiWriter m Text
inlineListToMediaWiki [Inline]
lst
inlineToMediaWiki (Quoted QuoteType
SingleQuote [Inline]
lst) = do
contents <- [Inline] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> MediaWikiWriter m Text
inlineListToMediaWiki [Inline]
lst
return $ "\8216" <> contents <> "\8217"
inlineToMediaWiki (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
contents <- [Inline] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> MediaWikiWriter m Text
inlineListToMediaWiki [Inline]
lst
return $ "\8220" <> contents <> "\8221"
inlineToMediaWiki (Cite [Citation]
_ [Inline]
lst) = [Inline] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> MediaWikiWriter m Text
inlineListToMediaWiki [Inline]
lst
inlineToMediaWiki (Code Attr
_ Text
str) =
Text -> MediaWikiWriter m Text
forall a. a -> ReaderT WriterReader (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MediaWikiWriter m Text) -> Text -> MediaWikiWriter m Text
forall a b. (a -> b) -> a -> b
$ Text
"<code>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeText Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</code>"
inlineToMediaWiki (Str Text
str) = Text -> MediaWikiWriter m Text
forall a. a -> ReaderT WriterReader (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MediaWikiWriter m Text) -> Text -> MediaWikiWriter m Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeText Text
str
inlineToMediaWiki (Math MathType
mt Text
str) = Text -> MediaWikiWriter m Text
forall a. a -> ReaderT WriterReader (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MediaWikiWriter m Text) -> Text -> MediaWikiWriter m Text
forall a b. (a -> b) -> a -> b
$
Text
"<math display=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
(if MathType
mt MathType -> MathType -> Bool
forall a. Eq a => a -> a -> Bool
== MathType
DisplayMath then Text
"block" else Text
"inline") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"\">" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
str Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</math>"
inlineToMediaWiki il :: Inline
il@(RawInline Format
f Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"mediawiki" = Text -> MediaWikiWriter m Text
forall a. a -> ReaderT WriterReader (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
str
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"html" = Text -> MediaWikiWriter m Text
forall a. a -> ReaderT WriterReader (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
str
| Bool
otherwise = Text
"" Text
-> ReaderT WriterReader (StateT WriterState m) ()
-> MediaWikiWriter m Text
forall a b.
a
-> ReaderT WriterReader (StateT WriterState m) b
-> ReaderT WriterReader (StateT WriterState m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> ReaderT WriterReader (StateT WriterState m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Inline -> LogMessage
InlineNotRendered Inline
il)
inlineToMediaWiki Inline
LineBreak = Text -> MediaWikiWriter m Text
forall a. a -> ReaderT WriterReader (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"<br />\n"
inlineToMediaWiki Inline
SoftBreak = do
wrapText <- (WriterState -> WrapOption)
-> ReaderT WriterReader (StateT WriterState m) WrapOption
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (WriterOptions -> WrapOption
writerWrapText (WriterOptions -> WrapOption)
-> (WriterState -> WriterOptions) -> WriterState -> WrapOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterState -> WriterOptions
stOptions)
listlevel <- asks listLevel
case wrapText of
WrapOption
WrapAuto -> Text -> MediaWikiWriter m Text
forall a. a -> ReaderT WriterReader (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
" "
WrapOption
WrapNone -> Text -> MediaWikiWriter m Text
forall a. a -> ReaderT WriterReader (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
" "
WrapOption
WrapPreserve -> if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
listlevel
then Text -> MediaWikiWriter m Text
forall a. a -> ReaderT WriterReader (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
"\n"
else Text -> MediaWikiWriter m Text
forall a. a -> ReaderT WriterReader (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
" "
inlineToMediaWiki Inline
Space = Text -> MediaWikiWriter m Text
forall a. a -> ReaderT WriterReader (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
" "
inlineToMediaWiki (Link Attr
_ [Inline]
txt (Text
src, Text
_)) = do
label <- [Inline] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Inline] -> MediaWikiWriter m Text
inlineListToMediaWiki ([Inline] -> [Inline]
removeLinks [Inline]
txt)
case 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 -> MediaWikiWriter m Text
forall a. a -> ReaderT WriterReader (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
src
[Inline]
_ -> Text -> MediaWikiWriter m Text
forall a. a -> ReaderT WriterReader (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> MediaWikiWriter m Text) -> Text -> MediaWikiWriter m Text
forall a b. (a -> b) -> a -> b
$ if Text -> Bool
isURI Text
src
then 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
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
else
if Text
src Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
label
then Text
"[[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]]"
else 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
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]]"
where src' :: Text
src' = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
src (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripPrefix Text
"/" Text
src
inlineToMediaWiki (Image Attr
attr [Inline]
alt (Text
source, Text
tit)) = do
img <- Attr -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
Attr -> MediaWikiWriter m Text
imageToMediaWiki Attr
attr
alt' <- inlineListToMediaWiki alt
let txt = if Text -> Bool
T.null Text
alt'
then if Text -> Bool
T.null Text
tit
then Text
""
else Text
tit
else Text
alt'
return $ "[[" <>
T.intercalate "|"
(filter (not . T.null)
[ "File:" <> source
, img
, txt
]) <> "]]"
inlineToMediaWiki (Note [Block]
contents) = do
contents' <- [Block] -> MediaWikiWriter m Text
forall (m :: * -> *).
PandocMonad m =>
[Block] -> MediaWikiWriter m Text
blockListToMediaWiki [Block]
contents
modify (\WriterState
s -> WriterState
s { stNotes = True })
return $ "<ref>" <> stripTrailingNewlines contents' <> "</ref>"
removeLinks :: [Inline] -> [Inline]
removeLinks :: [Inline] -> [Inline]
removeLinks = (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
go
where
go :: Inline -> Inline
go (Link Attr
_ [Inline]
ils (Text, Text)
_) = [Inline] -> Inline
SmallCaps [Inline]
ils
go Inline
x = Inline
x
highlightingLangs :: Set.Set Text
highlightingLangs :: Set Text
highlightingLangs = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList [
Text
"abap",
Text
"abl",
Text
"abnf",
Text
"aconf",
Text
"actionscript",
Text
"actionscript3",
Text
"ada",
Text
"ada2005",
Text
"ada95",
Text
"adl",
Text
"agda",
Text
"ahk",
Text
"alloy",
Text
"ambienttalk",
Text
"ambienttalk/2",
Text
"antlr",
Text
"antlr-actionscript",
Text
"antlr-as",
Text
"antlr-c#",
Text
"antlr-cpp",
Text
"antlr-csharp",
Text
"antlr-java",
Text
"antlr-objc",
Text
"antlr-perl",
Text
"antlr-python",
Text
"antlr-rb",
Text
"antlr-ruby",
Text
"apache",
Text
"apacheconf",
Text
"apl",
Text
"applescript",
Text
"arduino",
Text
"arexx",
Text
"as",
Text
"as3",
Text
"asm",
Text
"aspectj",
Text
"aspx-cs",
Text
"aspx-vb",
Text
"asy",
Text
"asymptote",
Text
"at",
Text
"autohotkey",
Text
"autoit",
Text
"awk",
Text
"b3d",
Text
"basemake",
Text
"bash",
Text
"basic",
Text
"bat",
Text
"batch",
Text
"bbcode",
Text
"because",
Text
"befunge",
Text
"bf",
Text
"blitzbasic",
Text
"blitzmax",
Text
"bmax",
Text
"bnf",
Text
"boo",
Text
"boogie",
Text
"bplus",
Text
"brainfuck",
Text
"bro",
Text
"bsdmake",
Text
"bugs",
Text
"c",
Text
"c#",
Text
"c++",
Text
"c++-objdumb",
Text
"c-objdump",
Text
"ca65",
Text
"cadl",
Text
"camkes",
Text
"cbmbas",
Text
"ceylon",
Text
"cf3",
Text
"cfc",
Text
"cfengine3",
Text
"cfg",
Text
"cfm",
Text
"cfs",
Text
"chai",
Text
"chaiscript",
Text
"chapel",
Text
"cheetah",
Text
"chpl",
Text
"cirru",
Text
"cl",
Text
"clay",
Text
"clipper",
Text
"clj",
Text
"cljs",
Text
"clojure",
Text
"clojurescript",
Text
"cmake",
Text
"cobol",
Text
"cobolfree",
Text
"coffee",
Text
"coffee-script",
Text
"coffeescript",
Text
"common-lisp",
Text
"componentpascal",
Text
"console",
Text
"control",
Text
"coq",
Text
"cp",
Text
"cpp",
Text
"cpp-objdump",
Text
"cpsa",
Text
"crmsh",
Text
"croc",
Text
"cry",
Text
"cryptol",
Text
"csh",
Text
"csharp",
Text
"csound",
Text
"csound-csd",
Text
"csound-document",
Text
"csound-orc",
Text
"csound-sco",
Text
"csound-score",
Text
"css",
Text
"css+django",
Text
"css+erb",
Text
"css+genshi",
Text
"css+genshitext",
Text
"css+jinja",
Text
"css+lasso",
Text
"css+mako",
Text
"css+mozpreproc",
Text
"css+myghty",
Text
"css+php",
Text
"css+ruby",
Text
"css+smarty",
Text
"cu",
Text
"cucumber",
Text
"cuda",
Text
"cxx-objdump",
Text
"cypher",
Text
"cython",
Text
"d",
Text
"d-objdump",
Text
"dart",
Text
"debcontrol",
Text
"debsources",
Text
"delphi",
Text
"dg",
Text
"diff",
Text
"django",
Text
"docker",
Text
"dockerfile",
Text
"dosbatch",
Text
"doscon",
Text
"dosini",
Text
"dpatch",
Text
"dtd",
Text
"duby",
Text
"duel",
Text
"dylan",
Text
"dylan-console",
Text
"dylan-lid",
Text
"dylan-repl",
Text
"earl-grey",
Text
"earlgrey",
Text
"easytrieve",
Text
"ebnf",
Text
"ec",
Text
"ecl",
Text
"eg",
Text
"eiffel",
Text
"elisp",
Text
"elixir",
Text
"elm",
Text
"emacs",
Text
"erb",
Text
"erl",
Text
"erlang",
Text
"evoque",
Text
"ex",
Text
"exs",
Text
"ezhil",
Text
"f#",
Text
"factor",
Text
"fan",
Text
"fancy",
Text
"felix",
Text
"fish",
Text
"fishshell",
Text
"flx",
Text
"fortran",
Text
"fortranfixed",
Text
"foxpro",
Text
"fsharp",
Text
"fy",
Text
"gap",
Text
"gas",
Text
"gawk",
Text
"genshi",
Text
"genshitext",
Text
"gherkin",
Text
"glsl",
Text
"gnuplot",
Text
"go",
Text
"golo",
Text
"gooddata-cl",
Text
"gosu",
Text
"groff",
Text
"groovy",
Text
"gst",
Text
"haml",
Text
"handlebars",
Text
"haskell",
Text
"haxe",
Text
"haxeml",
Text
"hexdump",
Text
"hs",
Text
"html",
Text
"html+cheetah",
Text
"html+django",
Text
"html+erb",
Text
"html+evoque",
Text
"html+genshi",
Text
"html+handlebars",
Text
"html+jinja",
Text
"html+kid",
Text
"html+lasso",
Text
"html+mako",
Text
"html+myghty",
Text
"html+php",
Text
"html+ruby",
Text
"html+smarty",
Text
"html+spitfire",
Text
"html+twig",
Text
"html+velocity",
Text
"htmlcheetah",
Text
"htmldjango",
Text
"http",
Text
"hx",
Text
"hxml",
Text
"hxsl",
Text
"hy",
Text
"hybris",
Text
"hylang",
Text
"i6",
Text
"i6t",
Text
"i7",
Text
"idl",
Text
"idl4",
Text
"idr",
Text
"idris",
Text
"iex",
Text
"igor",
Text
"igorpro",
Text
"ik",
Text
"inform6",
Text
"inform7",
Text
"ini",
Text
"io",
Text
"ioke",
Text
"irb",
Text
"irc",
Text
"isabelle",
Text
"j",
Text
"jade",
Text
"jags",
Text
"jasmin",
Text
"jasminxt",
Text
"java",
Text
"javascript",
Text
"javascript+cheetah",
Text
"javascript+django",
Text
"javascript+erb",
Text
"javascript+genshi",
Text
"javascript+genshitext",
Text
"javascript+jinja",
Text
"javascript+lasso",
Text
"javascript+mako",
Text
"javascript+mozpreproc",
Text
"javascript+myghty",
Text
"javascript+php",
Text
"javascript+ruby",
Text
"javascript+smarty",
Text
"javascript+spitfire",
Text
"jbst",
Text
"jcl",
Text
"jinja",
Text
"jl",
Text
"jlcon",
Text
"jproperties",
Text
"js",
Text
"js+cheetah",
Text
"js+django",
Text
"js+erb",
Text
"js+genshi",
Text
"js+genshitext",
Text
"js+jinja",
Text
"js+lasso",
Text
"js+mako",
Text
"js+myghty",
Text
"js+php",
Text
"js+ruby",
Text
"js+smarty",
Text
"js+spitfire",
Text
"json",
Text
"json-ld",
Text
"jsonld",
Text
"jsonml+bst",
Text
"jsp",
Text
"julia",
Text
"kal",
Text
"kconfig",
Text
"kernel-config",
Text
"kid",
Text
"koka",
Text
"kotlin",
Text
"ksh",
Text
"lagda",
Text
"lasso",
Text
"lassoscript",
Text
"latex",
Text
"lcry",
Text
"lcryptol",
Text
"lean",
Text
"less",
Text
"lhaskell",
Text
"lhs",
Text
"lid",
Text
"lidr",
Text
"lidris",
Text
"lighttpd",
Text
"lighty",
Text
"limbo",
Text
"linux-config",
Text
"liquid",
Text
"lisp",
Text
"literate-agda",
Text
"literate-cryptol",
Text
"literate-haskell",
Text
"literate-idris",
Text
"live-script",
Text
"livescript",
Text
"llvm",
Text
"logos",
Text
"logtalk",
Text
"lsl",
Text
"lua",
Text
"m2",
Text
"make",
Text
"makefile",
Text
"mako",
Text
"man",
Text
"maql",
Text
"mask",
Text
"mason",
Text
"mathematica",
Text
"matlab",
Text
"matlabsession",
Text
"mawk",
Text
"menuconfig",
Text
"mf",
Text
"minid",
Text
"mma",
Text
"modelica",
Text
"modula2",
Text
"moin",
Text
"monkey",
Text
"moo",
Text
"moocode",
Text
"moon",
Text
"moonscript",
Text
"mozhashpreproc",
Text
"mozpercentpreproc",
Text
"mq4",
Text
"mq5",
Text
"mql",
Text
"mql4",
Text
"mql5",
Text
"msc",
Text
"mscgen",
Text
"mupad",
Text
"mxml",
Text
"myghty",
Text
"mysql",
Text
"nasm",
Text
"nawk",
Text
"nb",
Text
"nemerle",
Text
"nesc",
Text
"newlisp",
Text
"newspeak",
Text
"nginx",
Text
"nim",
Text
"nimrod",
Text
"nit",
Text
"nix",
Text
"nixos",
Text
"nroff",
Text
"nsh",
Text
"nsi",
Text
"nsis",
Text
"numpy",
Text
"obj-c",
Text
"obj-c++",
Text
"obj-j",
Text
"objc",
Text
"objc++",
Text
"objdump",
Text
"objdump-nasm",
Text
"objective-c",
Text
"objective-c++",
Text
"objective-j",
Text
"objectivec",
Text
"objectivec++",
Text
"objectivej",
Text
"objectpascal",
Text
"objj",
Text
"ocaml",
Text
"octave",
Text
"odin",
Text
"ooc",
Text
"opa",
Text
"openbugs",
Text
"openedge",
Text
"pacmanconf",
Text
"pan",
Text
"parasail",
Text
"pas",
Text
"pascal",
Text
"pawn",
Text
"pcmk",
Text
"perl",
Text
"perl6",
Text
"php",
Text
"php3",
Text
"php4",
Text
"php5",
Text
"pig",
Text
"pike",
Text
"pkgconfig",
Text
"pl",
Text
"pl6",
Text
"plpgsql",
Text
"po",
Text
"posh",
Text
"postgres",
Text
"postgres-console",
Text
"postgresql",
Text
"postgresql-console",
Text
"postscr",
Text
"postscript",
Text
"pot",
Text
"pov",
Text
"powershell",
Text
"praat",
Text
"progress",
Text
"prolog",
Text
"properties",
Text
"proto",
Text
"protobuf",
Text
"ps1",
Text
"ps1con",
Text
"psm1",
Text
"psql",
Text
"puppet",
Text
"py",
Text
"py3",
Text
"py3tb",
Text
"pycon",
Text
"pypy",
Text
"pypylog",
Text
"pyrex",
Text
"pytb",
Text
"python",
Text
"python3",
Text
"pyx",
Text
"qbasic",
Text
"qbs",
Text
"qml",
Text
"qvt",
Text
"qvto",
Text
"r",
Text
"racket",
Text
"ragel",
Text
"ragel-c",
Text
"ragel-cpp",
Text
"ragel-d",
Text
"ragel-em",
Text
"ragel-java",
Text
"ragel-objc",
Text
"ragel-rb",
Text
"ragel-ruby",
Text
"raw",
Text
"rb",
Text
"rbcon",
Text
"rconsole",
Text
"rd",
Text
"rebol",
Text
"red",
Text
"red/system",
Text
"redcode",
Text
"registry",
Text
"resource",
Text
"resourcebundle",
Text
"rest",
Text
"restructuredtext",
Text
"rexx",
Text
"rhtml",
Text
"rkt",
Text
"roboconf-graph",
Text
"roboconf-instances",
Text
"robotframework",
Text
"rout",
Text
"rql",
Text
"rsl",
Text
"rst",
Text
"rts",
Text
"ruby",
Text
"rust",
Text
"s",
Text
"sage",
Text
"salt",
Text
"sass",
Text
"sc",
Text
"scala",
Text
"scaml",
Text
"scheme",
Text
"scilab",
Text
"scm",
Text
"scss",
Text
"sh",
Text
"shell",
Text
"shell-session",
Text
"shen",
Text
"slim",
Text
"sls",
Text
"smali",
Text
"smalltalk",
Text
"smarty",
Text
"sml",
Text
"snobol",
Text
"sources.list",
Text
"sourceslist",
Text
"sp",
Text
"sparql",
Text
"spec",
Text
"spitfire",
Text
"splus",
Text
"sql",
Text
"sqlite3",
Text
"squeak",
Text
"squid",
Text
"squid.conf",
Text
"squidconf",
Text
"ssp",
Text
"st",
Text
"stan",
Text
"supercollider",
Text
"sv",
Text
"swift",
Text
"swig",
Text
"systemverilog",
Text
"tads3",
Text
"tap",
Text
"tcl",
Text
"tcsh",
Text
"tcshcon",
Text
"tea",
Text
"termcap",
Text
"terminfo",
Text
"terraform",
Text
"tex",
Text
"text",
Text
"tf",
Text
"thrift",
Text
"todotxt",
Text
"trac-wiki",
Text
"trafficscript",
Text
"treetop",
Text
"ts",
Text
"turtle",
Text
"twig",
Text
"typescript",
Text
"udiff",
Text
"urbiscript",
Text
"v",
Text
"vala",
Text
"vapi",
Text
"vb.net",
Text
"vbnet",
Text
"vctreestatus",
Text
"velocity",
Text
"verilog",
Text
"vfp",
Text
"vgl",
Text
"vhdl",
Text
"vim",
Text
"winbatch",
Text
"winbugs",
Text
"x10",
Text
"xbase",
Text
"xml",
Text
"xml+cheetah",
Text
"xml+django",
Text
"xml+erb",
Text
"xml+evoque",
Text
"xml+genshi",
Text
"xml+jinja",
Text
"xml+kid",
Text
"xml+lasso",
Text
"xml+mako",
Text
"xml+myghty",
Text
"xml+php",
Text
"xml+ruby",
Text
"xml+smarty",
Text
"xml+spitfire",
Text
"xml+velocity",
Text
"xq",
Text
"xql",
Text
"xqm",
Text
"xquery",
Text
"xqy",
Text
"xslt",
Text
"xten",
Text
"xtend",
Text
"xul+mozpreproc",
Text
"yaml",
Text
"yaml+jinja",
Text
"zephir" ]
startsWithListMarker :: Text -> Bool
startsWithListMarker :: Text -> Bool
startsWithListMarker Text
t =
case Text -> Maybe (Char, Text)
T.uncons Text
t of
Maybe (Char, Text)
Nothing -> Bool
False
Just (Char
c,Text
_) -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*'