{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TypeApplications #-}
module Text.Pandoc.Writers.BBCode (
writeBBCode,
writeBBCodeOfficial,
writeBBCodeSteam,
writeBBCodePhpBB,
writeBBCodeFluxBB,
writeBBCodeHubzilla,
writeBBCodeXenforo,
FlavorSpec (..),
WriterState (..),
RR,
writeBBCodeCustom,
inlineToBBCode,
inlineListToBBCode,
blockToBBCode,
blockListToBBCode,
attrToMap,
officialSpec,
steamSpec,
phpbbSpec,
fluxbbSpec,
hubzillaSpec,
xenforoSpec,
) where
import Control.Applicative (some)
import Control.Monad (forM)
import Control.Monad.Reader (MonadReader (..), ReaderT (..), asks)
import Control.Monad.State (MonadState (..), StateT, evalStateT, gets, modify)
import Data.Default (Default (..))
import Data.Either (isRight)
import Data.Foldable (toList)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe, isJust)
import Data.Sequence (Seq, (|>))
import qualified Data.Sequence as Seq
import Data.Text (Text)
import qualified Data.Text as T
import Text.DocLayout hiding (char, link, text)
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Logging (LogMessage (..))
import Text.Pandoc.Options (WriterOptions (..))
import Text.Pandoc.Parsing (char, digit, eof, readWith)
import Text.Pandoc.Shared (inquotes, onlySimpleTableCells, removeFormatting, trim, tshow)
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.URI (escapeURI)
import Text.Pandoc.Writers.Shared (defField, metaToContext, toLegacyTable, unsmartify)
import Text.Read (readMaybe)
type PandocTable =
(Attr, Caption, [ColSpec], TableHead, [TableBody], TableFoot)
data FlavorSpec = FlavorSpec
{ FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[Block] -> RR m (Doc Text)
renderBlockQuote ::
forall m.
(PandocMonad m) =>
[Block] ->
RR m (Doc Text)
, FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[[Block]] -> RR m (Doc Text)
renderBulletList ::
forall m.
(PandocMonad m) =>
[[Block]] ->
RR m (Doc Text)
, FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
Attr -> Text -> RR m (Doc Text)
renderCodeBlock ::
forall m.
(PandocMonad m) =>
Attr ->
Text ->
RR m (Doc Text)
, FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[([Inline], [[Block]])] -> RR m (Doc Text)
renderDefinitionList ::
forall m.
(PandocMonad m) =>
[([Inline], [[Block]])] ->
RR m (Doc Text)
, ::
forall m.
(PandocMonad m) =>
Int ->
Attr ->
[Inline] ->
RR m (Doc Text)
, FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
Attr -> Text -> RR m (Doc Text)
renderInlineCode ::
forall m.
(PandocMonad m) =>
Attr ->
Text ->
RR m (Doc Text)
, FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> Target -> RR m (Doc Text)
renderLink ::
forall m.
(PandocMonad m) =>
Attr ->
[Inline] ->
Target ->
RR m (Doc Text)
, FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
ListAttributes -> [[Block]] -> RR m (Doc Text)
renderOrderedList ::
forall m.
(PandocMonad m) =>
ListAttributes ->
[[Block]] ->
RR m (Doc Text)
, FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[Inline] -> RR m (Doc Text)
renderStrikeout ::
forall m.
(PandocMonad m) =>
[Inline] ->
RR m (Doc Text)
, FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
PandocTable -> RR m (Doc Text)
renderTable :: forall m. (PandocMonad m) => PandocTable -> RR m (Doc Text)
, FlavorSpec
-> forall (m :: * -> *). PandocMonad m => RR m (Doc Text)
renderHorizontalRule ::
forall m.
(PandocMonad m) =>
RR m (Doc Text)
, FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[[Inline]] -> RR m (Doc Text)
renderLineBlock ::
forall m.
(PandocMonad m) =>
[[Inline]] ->
RR m (Doc Text)
, FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[Inline] -> RR m (Doc Text)
renderPara ::
forall m.
(PandocMonad m) =>
[Inline] ->
RR m (Doc Text)
, FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[Inline] -> RR m (Doc Text)
renderSuperscript ::
forall m.
(PandocMonad m) =>
[Inline] ->
RR m (Doc Text)
, FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[Inline] -> RR m (Doc Text)
renderSubscript :: forall m. (PandocMonad m) => [Inline] -> RR m (Doc Text)
, FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[Inline] -> RR m (Doc Text)
renderSmallCaps :: forall m. (PandocMonad m) => [Inline] -> RR m (Doc Text)
, FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[Citation] -> [Inline] -> RR m (Doc Text)
renderCite ::
forall m.
(PandocMonad m) =>
[Citation] ->
[Inline] ->
RR m (Doc Text)
, FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[Block] -> RR m (Doc Text)
renderNote :: forall m. (PandocMonad m) => [Block] -> RR m (Doc Text)
, FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
Attr -> Caption -> [Block] -> RR m (Doc Text)
renderFigure ::
forall m.
(PandocMonad m) =>
Attr ->
Caption ->
[Block] ->
RR m (Doc Text)
, FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
QuoteType -> [Inline] -> RR m (Doc Text)
renderQuoted ::
forall m.
(PandocMonad m) =>
QuoteType ->
[Inline] ->
RR m (Doc Text)
, FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> RR m (Doc Text)
renderMath ::
forall m.
(PandocMonad m) =>
MathType ->
Text ->
RR m (Doc Text)
, FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> Target -> RR m (Doc Text)
renderImage ::
forall m.
(PandocMonad m) =>
Attr ->
[Inline] ->
Target ->
RR m (Doc Text)
, FlavorSpec -> Bool -> Map Text (Maybe Text) -> Doc Text -> Doc Text
wrapSpanDiv :: Bool -> Map Text (Maybe Text) -> Doc Text -> Doc Text
}
data WriterState = WriterState
{ WriterState -> WriterOptions
writerOptions :: WriterOptions
, WriterState -> FlavorSpec
flavorSpec :: FlavorSpec
, WriterState -> Bool
inList :: Bool
}
instance Default WriterState where
def :: WriterState
def =
WriterState
{ writerOptions :: WriterOptions
writerOptions = WriterOptions
forall a. Default a => a
def
, flavorSpec :: FlavorSpec
flavorSpec = FlavorSpec
officialSpec
, inList :: Bool
inList = Bool
False
}
type RR m a = StateT (Seq (Doc Text)) (ReaderT WriterState m) a
pandocToBBCode :: (PandocMonad m) => Pandoc -> RR m Text
pandocToBBCode :: forall (m :: * -> *). PandocMonad m => Pandoc -> RR m Text
pandocToBBCode (Pandoc Meta
meta [Block]
body) = do
WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) WriterOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterState -> WriterOptions
writerOptions
Doc Text
bodyContents <- [Block] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RR m (Doc Text)
blockListToBBCode [Block]
body
Seq (Doc Text)
footnotes <- StateT (Seq (Doc Text)) (ReaderT WriterState m) (Seq (Doc Text))
forall s (m :: * -> *). MonadState s m => m s
get
Doc Text
footnotesSep <-
if Seq (Doc Text) -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq (Doc Text)
footnotes
then Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Doc a
empty
else
(\Doc Text
hr -> Doc Text
forall a. Doc a
blankline Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
hr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
blankline)
(Doc Text -> Doc Text) -> RR m (Doc Text) -> RR m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Block -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> RR m (Doc Text)
blockToBBCode Block
HorizontalRule
let docText :: Doc Text
docText = Doc Text
bodyContents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
footnotesSep Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep (Seq (Doc Text) -> [Doc Text]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Doc Text)
footnotes)
Context Text
metadata <- WriterOptions
-> ([Block] -> RR m (Doc Text))
-> ([Inline] -> RR m (Doc Text))
-> Meta
-> StateT (Seq (Doc Text)) (ReaderT WriterState 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 [Block] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RR m (Doc Text)
blockListToBBCode [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode Meta
meta
let context :: Context Text
context = Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
docText Context Text
metadata
case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
Just Template Text
tpl -> Text -> RR m Text
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> RR m Text) -> Text -> RR m Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (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 -> RR m Text
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> RR m Text) -> Text -> RR m Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing Doc Text
docText
writeBBCode
, writeBBCodeOfficial
, writeBBCodeSteam
, writeBBCodePhpBB
, writeBBCodeFluxBB
, writeBBCodeHubzilla
, writeBBCodeXenforo ::
(PandocMonad m) => WriterOptions -> Pandoc -> m Text
writeBBCode :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeBBCode = WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeBBCodeOfficial
writeBBCodeOfficial :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeBBCodeOfficial = FlavorSpec -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
FlavorSpec -> WriterOptions -> Pandoc -> m Text
writeBBCodeCustom FlavorSpec
officialSpec
writeBBCodeSteam :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeBBCodeSteam = FlavorSpec -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
FlavorSpec -> WriterOptions -> Pandoc -> m Text
writeBBCodeCustom FlavorSpec
steamSpec
writeBBCodePhpBB :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeBBCodePhpBB = FlavorSpec -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
FlavorSpec -> WriterOptions -> Pandoc -> m Text
writeBBCodeCustom FlavorSpec
phpbbSpec
writeBBCodeFluxBB :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeBBCodeFluxBB = FlavorSpec -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
FlavorSpec -> WriterOptions -> Pandoc -> m Text
writeBBCodeCustom FlavorSpec
fluxbbSpec
writeBBCodeHubzilla :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeBBCodeHubzilla = FlavorSpec -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
FlavorSpec -> WriterOptions -> Pandoc -> m Text
writeBBCodeCustom FlavorSpec
hubzillaSpec
writeBBCodeXenforo :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeBBCodeXenforo = FlavorSpec -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
FlavorSpec -> WriterOptions -> Pandoc -> m Text
writeBBCodeCustom FlavorSpec
xenforoSpec
writeBBCodeCustom ::
(PandocMonad m) => FlavorSpec -> WriterOptions -> Pandoc -> m Text
writeBBCodeCustom :: forall (m :: * -> *).
PandocMonad m =>
FlavorSpec -> WriterOptions -> Pandoc -> m Text
writeBBCodeCustom FlavorSpec
spec WriterOptions
opts Pandoc
document =
Seq (Doc Text) -> WriterState -> RR m Text -> m Text
forall (m :: * -> *) a.
Monad m =>
Seq (Doc Text) -> WriterState -> RR m a -> m a
runRR Seq (Doc Text)
forall a. Monoid a => a
mempty WriterState
forall a. Default a => a
def{writerOptions = opts, flavorSpec = spec} (RR m Text -> m Text) -> RR m Text -> m Text
forall a b. (a -> b) -> a -> b
$
Pandoc -> RR m Text
forall (m :: * -> *). PandocMonad m => Pandoc -> RR m Text
pandocToBBCode Pandoc
document
where
runRR :: (Monad m) => Seq (Doc Text) -> WriterState -> RR m a -> m a
runRR :: forall (m :: * -> *) a.
Monad m =>
Seq (Doc Text) -> WriterState -> RR m a -> m a
runRR Seq (Doc Text)
footnotes WriterState
writerState RR m a
action =
ReaderT WriterState m a -> WriterState -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (RR m a -> Seq (Doc Text) -> ReaderT WriterState m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT RR m a
action Seq (Doc Text)
footnotes) WriterState
writerState
blockListToBBCode :: (PandocMonad m) => [Block] -> RR m (Doc Text)
blockListToBBCode :: forall (m :: * -> *). PandocMonad m => [Block] -> RR m (Doc Text)
blockListToBBCode [Block]
blocks =
Doc Text -> Doc Text
forall a. Doc a -> Doc a
chomp (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vsep ([Doc Text] -> Doc Text)
-> ([Doc Text] -> [Doc Text]) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc Text -> Bool) -> [Doc Text] -> [Doc Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Doc Text -> Bool) -> Doc Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Bool
forall a. Doc a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
([Doc Text] -> Doc Text)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> [Block]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc 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 -> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> RR m (Doc Text)
blockToBBCode [Block]
blocks
blockToBBCode :: (PandocMonad m) => Block -> RR m (Doc Text)
blockToBBCode :: forall (m :: * -> *). PandocMonad m => Block -> RR m (Doc Text)
blockToBBCode Block
block = do
FlavorSpec
spec <- (WriterState -> FlavorSpec)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) FlavorSpec
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterState -> FlavorSpec
flavorSpec
case Block
block of
Plain [Inline]
inlines -> [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [Inline]
inlines
Para [Inline]
inlines -> FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[Inline] -> RR m (Doc Text)
renderPara FlavorSpec
spec [Inline]
inlines
LineBlock [[Inline]]
inliness -> FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[[Inline]] -> RR m (Doc Text)
renderLineBlock FlavorSpec
spec [[Inline]]
inliness
CodeBlock Attr
attr Text
code -> FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
Attr -> Text -> RR m (Doc Text)
renderCodeBlock FlavorSpec
spec Attr
attr Text
code
RawBlock Format
format Text
raw -> case Format
format of
Format
"bbcode" -> Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
raw
Format
_ -> Doc Text
"" Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) ()
-> RR m (Doc Text)
forall a b.
a
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) b
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> StateT (Seq (Doc Text)) (ReaderT WriterState m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Block -> LogMessage
BlockNotRendered Block
block)
BlockQuote [Block]
blocks -> FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[Block] -> RR m (Doc Text)
renderBlockQuote FlavorSpec
spec [Block]
blocks
OrderedList ListAttributes
attr [[Block]]
items -> FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
ListAttributes -> [[Block]] -> RR m (Doc Text)
renderOrderedList FlavorSpec
spec ListAttributes
attr [[Block]]
items
BulletList [[Block]]
items -> FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[[Block]] -> RR m (Doc Text)
renderBulletList FlavorSpec
spec [[Block]]
items
DefinitionList [([Inline], [[Block]])]
items -> FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[([Inline], [[Block]])] -> RR m (Doc Text)
renderDefinitionList FlavorSpec
spec [([Inline], [[Block]])]
items
Header Int
level Attr
attr [Inline]
inlines -> FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
Int -> Attr -> [Inline] -> RR m (Doc Text)
renderHeader FlavorSpec
spec Int
level Attr
attr [Inline]
inlines
Block
HorizontalRule -> FlavorSpec
-> forall (m :: * -> *). PandocMonad m => RR m (Doc Text)
renderHorizontalRule FlavorSpec
spec
Table Attr
attr Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot ->
FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
PandocTable -> RR m (Doc Text)
renderTable FlavorSpec
spec (Attr
attr, Caption
blkCapt, [ColSpec]
specs, TableHead
thead, [TableBody]
tbody, TableFoot
tfoot)
Figure Attr
attr Caption
caption [Block]
blocks -> FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
Attr -> Caption -> [Block] -> RR m (Doc Text)
renderFigure FlavorSpec
spec Attr
attr Caption
caption [Block]
blocks
Div Attr
attr [Block]
blocks -> do
Doc Text
contents <- [Block] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RR m (Doc Text)
blockListToBBCode [Block]
blocks
let kvcMap :: Map Text (Maybe Text)
kvcMap = Attr -> Map Text (Maybe Text)
attrToMap Attr
attr
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ FlavorSpec -> Bool -> Map Text (Maybe Text) -> Doc Text -> Doc Text
wrapSpanDiv FlavorSpec
spec Bool
True Map Text (Maybe Text)
kvcMap Doc Text
contents
inlineToBBCode :: (PandocMonad m) => Inline -> RR m (Doc Text)
inlineToBBCode :: forall (m :: * -> *). PandocMonad m => Inline -> RR m (Doc Text)
inlineToBBCode Inline
inline = do
FlavorSpec
spec <- (WriterState -> FlavorSpec)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) FlavorSpec
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterState -> FlavorSpec
flavorSpec
case Inline
inline of
Str Text
str -> do
WriterOptions
opts <- (WriterState -> WriterOptions)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) WriterOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterState -> WriterOptions
writerOptions
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text))
-> (Text -> Doc Text) -> Text -> RR m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> RR m (Doc Text)) -> Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Text -> Text
unsmartify WriterOptions
opts Text
str
Emph [Inline]
inlines -> do
Doc Text
contents <- [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [Inline]
inlines
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat [Doc Text
"[i]", Doc Text
contents, Doc Text
"[/i]"]
Underline [Inline]
inlines -> do
Doc Text
contents <- [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [Inline]
inlines
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat [Doc Text
"[u]", Doc Text
contents, Doc Text
"[/u]"]
Strong [Inline]
inlines -> do
Doc Text
contents <- [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [Inline]
inlines
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat [Doc Text
"[b]", Doc Text
contents, Doc Text
"[/b]"]
Strikeout [Inline]
inlines -> FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[Inline] -> RR m (Doc Text)
renderStrikeout FlavorSpec
spec [Inline]
inlines
Superscript [Inline]
inlines -> FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[Inline] -> RR m (Doc Text)
renderSuperscript FlavorSpec
spec [Inline]
inlines
Subscript [Inline]
inlines -> FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[Inline] -> RR m (Doc Text)
renderSubscript FlavorSpec
spec [Inline]
inlines
SmallCaps [Inline]
inlines -> FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[Inline] -> RR m (Doc Text)
renderSmallCaps FlavorSpec
spec [Inline]
inlines
Quoted QuoteType
typ [Inline]
inlines -> FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
QuoteType -> [Inline] -> RR m (Doc Text)
renderQuoted FlavorSpec
spec QuoteType
typ [Inline]
inlines
Cite [Citation]
cits [Inline]
inlines -> FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[Citation] -> [Inline] -> RR m (Doc Text)
renderCite FlavorSpec
spec [Citation]
cits [Inline]
inlines
Code Attr
attr Text
code -> FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
Attr -> Text -> RR m (Doc Text)
renderInlineCode FlavorSpec
spec Attr
attr Text
code
Inline
Space -> Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Doc a
space
Inline
SoftBreak -> Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Doc a
space
Inline
LineBreak -> Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Doc a
cr
Math MathType
typ Text
math -> FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> RR m (Doc Text)
renderMath FlavorSpec
spec MathType
typ Text
math
RawInline (Format Text
format) Text
text -> case Text
format of
Text
"bbcode" -> Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
text
Text
_ -> Doc Text
"" Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) ()
-> RR m (Doc Text)
forall a b.
a
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) b
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> StateT (Seq (Doc Text)) (ReaderT WriterState m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Inline -> LogMessage
InlineNotRendered Inline
inline)
Link Attr
attr [Inline]
txt Target
target -> FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> Target -> RR m (Doc Text)
renderLink FlavorSpec
spec Attr
attr [Inline]
txt Target
target
Image Attr
attr [Inline]
alt Target
target -> FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> Target -> RR m (Doc Text)
renderImage FlavorSpec
spec Attr
attr [Inline]
alt Target
target
Note [Block]
blocks -> FlavorSpec
-> forall (m :: * -> *).
PandocMonad m =>
[Block] -> RR m (Doc Text)
renderNote FlavorSpec
spec [Block]
blocks
Span Attr
attr [Inline]
inlines -> do
Doc Text
contents <- [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [Inline]
inlines
let kvcMap :: Map Text (Maybe Text)
kvcMap = Attr -> Map Text (Maybe Text)
attrToMap Attr
attr
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ FlavorSpec -> Bool -> Map Text (Maybe Text) -> Doc Text -> Doc Text
wrapSpanDiv FlavorSpec
spec Bool
False Map Text (Maybe Text)
kvcMap Doc Text
contents
renderImageDefault ::
(PandocMonad m) => Attr -> [Inline] -> Target -> RR m (Doc Text)
renderImageDefault :: forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> Target -> RR m (Doc Text)
renderImageDefault (Text
_, [Text]
_, [Target]
kvList) [Inline]
alt (Text
source, Text
title) = do
Text
altText <-
Text -> Text
trim (Text -> Text) -> (Doc Text -> Text) -> Doc Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
-> RR m (Doc Text)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode ([Inline] -> [Inline]
forall a. Walkable Inline a => a -> [Inline]
removeFormatting [Inline]
alt)
let kvMap :: Map Text Text
kvMap = [Target] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [Target]
kvList
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text))
-> (Text -> Doc Text) -> Text -> RR m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> RR m (Doc Text)) -> Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$
[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ Text
"[img"
, if Text -> Bool
T.null Text
altText
then Text
""
else Text
" alt=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inquotes Text
altText
, if Text -> Bool
T.null Text
title
then Text
""
else Text
" title=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inquotes Text
title
, case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"width" Map Text Text
kvMap of
Just Text
w
| Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (forall a. Read a => String -> Maybe a
readMaybe @Int (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
w) ->
Text
" width=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inquotes Text
w
Maybe Text
_ -> Text
""
, case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"height" Map Text Text
kvMap of
Just Text
h
| Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (forall a. Read a => String -> Maybe a
readMaybe @Int (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
h) ->
Text
" height=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inquotes Text
h
Maybe Text
_ -> Text
""
, Text
"]"
, Text
source
, Text
"[/img]"
]
renderImageOmit ::
(PandocMonad m) => Attr -> [Inline] -> Target -> RR m (Doc Text)
renderImageOmit :: forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> Target -> RR m (Doc Text)
renderImageOmit Attr
_ [Inline]
_ Target
_ = Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
""
renderImagePhpBB ::
(PandocMonad m) => Attr -> [Inline] -> Target -> RR m (Doc Text)
renderImagePhpBB :: forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> Target -> RR m (Doc Text)
renderImagePhpBB Attr
_ [Inline]
_ (Text
source, Text
_) =
Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> (Text -> Doc Text)
-> Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
"[img]", Text
source, Text
"[/img]"]
renderImageXenforo ::
(PandocMonad m) => Attr -> [Inline] -> Target -> RR m (Doc Text)
renderImageXenforo :: forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> Target -> RR m (Doc Text)
renderImageXenforo (Text
_, [Text]
_, [Target]
kvList) [Inline]
alt (Text
source, Text
title) = do
Text
altText <-
Text -> Text
trim (Text -> Text) -> (Doc Text -> Text) -> Doc Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
-> RR m (Doc Text)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode ([Inline] -> [Inline]
forall a. Walkable Inline a => a -> [Inline]
removeFormatting [Inline]
alt)
let kvMap :: Map Text Text
kvMap = [Target] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [Target]
kvList
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text))
-> (Text -> Doc Text) -> Text -> RR m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> RR m (Doc Text)) -> Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$
[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ Text
"[img"
, if Text -> Bool
T.null Text
altText
then Text
""
else Text
" alt=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inquotes Text
altText
, if Text -> Bool
T.null Text
title
then Text
""
else Text
" title=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inquotes Text
title
, case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"width" Map Text Text
kvMap of
Just Text
w
| Either PandocError () -> Bool
forall a b. Either a b -> Bool
isRight (Parsec Sources (Maybe Any) ()
-> Maybe Any -> Text -> Either PandocError ()
forall t st a.
ToSources t =>
Parsec Sources st a -> st -> t -> Either PandocError a
readWith Parsec Sources (Maybe Any) ()
forall {u}. ParsecT Sources u Identity ()
sizeP Maybe Any
forall a. Maybe a
Nothing Text
w) ->
Text
" width=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
w
Maybe Text
_ -> Text
""
, Text
"]"
, Text
source
, Text
"[/img]"
]
where
sizeP :: ParsecT Sources u Identity ()
sizeP = ParsecT Sources u Identity Char
-> ParsecT Sources u Identity String
forall a.
ParsecT Sources u Identity a -> ParsecT Sources u Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Sources u Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
digit ParsecT Sources u Identity String
-> ParsecT Sources u Identity Char
-> ParsecT Sources u Identity Char
forall a b.
ParsecT Sources u Identity a
-> ParsecT Sources u Identity b -> ParsecT Sources u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT Sources u Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'%' ParsecT Sources u Identity Char
-> ParsecT Sources u Identity () -> ParsecT Sources u Identity ()
forall a b.
ParsecT Sources u Identity a
-> ParsecT Sources u Identity b -> ParsecT Sources u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources u Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
notBracket :: Char -> Bool
notBracket :: Char -> Bool
notBracket = \case
Char
'[' -> Bool
False
Char
']' -> Bool
False
Char
_ -> Bool
True
renderImageFluxBB ::
(PandocMonad m) => Attr -> [Inline] -> Target -> RR m (Doc Text)
renderImageFluxBB :: forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> Target -> RR m (Doc Text)
renderImageFluxBB Attr
_ [Inline]
alt (Text
source, Text
_) = do
Text
alt' <- (Char -> Bool) -> Text -> Text
T.filter Char -> Bool
notBracket (Text -> Text) -> (Doc Text -> Text) -> Doc Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
-> RR m (Doc Text)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [Inline]
alt
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text))
-> (Text -> Doc Text) -> Text -> RR m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> RR m (Doc Text)) -> Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$
[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ Text
"[img"
, if Text -> Bool
T.null Text
alt'
then Text
""
else Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
alt'
, Text
"]"
, Text
source
, Text
"[/img]"
]
inlineListToBBCode :: (PandocMonad m) => [Inline] -> RR m (Doc Text)
inlineListToBBCode :: forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [Inline]
inlines = [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> [Inline]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc 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
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> RR m (Doc Text)
inlineToBBCode [Inline]
inlines
clamp :: (Ord a) => (a, a) -> a -> a
clamp :: forall a. Ord a => (a, a) -> a -> a
clamp (a
low, a
high) a
a = a -> a -> a
forall a. Ord a => a -> a -> a
min a
high (a -> a -> a
forall a. Ord a => a -> a -> a
max a
a a
low)
renderHeaderDefault ::
(PandocMonad m) => Int -> Attr -> [Inline] -> RR m (Doc Text)
Int
level Attr
_attr [Inline]
inlines =
case (Int, Int) -> Int -> Int
forall a. Ord a => (a, a) -> a -> a
clamp (Int
1, Int
4) Int
level of
Int
1 -> Inline -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> RR m (Doc Text)
inlineToBBCode (Inline -> RR m (Doc Text)) -> Inline -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Underline [[Inline] -> Inline
Strong [Inline]
inlines]
Int
2 -> Inline -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> RR m (Doc Text)
inlineToBBCode (Inline -> RR m (Doc Text)) -> Inline -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Strong [Inline]
inlines
Int
3 -> Inline -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> RR m (Doc Text)
inlineToBBCode (Inline -> RR m (Doc Text)) -> Inline -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> Inline
Underline [Inline]
inlines
Int
_ -> [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [Inline]
inlines
renderLinkDefault ::
(PandocMonad m) => Attr -> [Inline] -> Target -> RR m (Doc Text)
renderLinkDefault :: forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> Target -> RR m (Doc Text)
renderLinkDefault Attr
_ [Inline]
txt (Text
src, Text
_) =
case [Inline]
txt of
[Str Text
x]
| Text -> Text
escapeURI Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
src ->
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"[url]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
x Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/url]"
[Inline]
_ -> do
Doc Text
contents <- [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [Inline]
txt
let suffix :: Text
suffix = if Text -> Bool
T.null Text
src then Text
"" else Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
src
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
"[url" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
suffix Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/url]"
renderCodeBlockDefault :: (PandocMonad m) => Attr -> Text -> RR m (Doc Text)
renderCodeBlockDefault :: forall (m :: * -> *).
PandocMonad m =>
Attr -> Text -> RR m (Doc Text)
renderCodeBlockDefault (Text
_, [Text]
cls, [Target]
_) Text
code = do
let opening :: Text
opening = case [Text]
cls of
(Text
lang : [Text]
_) -> Text
"[code=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lang Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
[Text]
_ -> Text
"[code]"
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat [Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
opening, Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
code, Doc Text
forall a. Doc a
cr, Doc Text
"[/code]"]
renderCodeBlockSimple :: (PandocMonad m) => Attr -> Text -> RR m (Doc Text)
renderCodeBlockSimple :: forall (m :: * -> *).
PandocMonad m =>
Attr -> Text -> RR m (Doc Text)
renderCodeBlockSimple Attr
_ Text
code = do
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat [Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"[code]", Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
code, Doc Text
forall a. Doc a
cr, Doc Text
"[/code]"]
renderInlineCodeLiteral :: (PandocMonad m) => Attr -> Text -> RR m (Doc Text)
renderInlineCodeLiteral :: forall (m :: * -> *).
PandocMonad m =>
Attr -> Text -> RR m (Doc Text)
renderInlineCodeLiteral Attr
_ Text
code = Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
code
renderInlineCodeNoParse :: (PandocMonad m) => Attr -> Text -> RR m (Doc Text)
renderInlineCodeNoParse :: forall (m :: * -> *).
PandocMonad m =>
Attr -> Text -> RR m (Doc Text)
renderInlineCodeNoParse Attr
_ Text
code =
Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat [Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"[noparse]", Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
code, Doc Text
"[/noparse]"]
renderInlineCodeHubzilla :: (PandocMonad m) => Attr -> Text -> RR m (Doc Text)
renderInlineCodeHubzilla :: forall (m :: * -> *).
PandocMonad m =>
Attr -> Text -> RR m (Doc Text)
renderInlineCodeHubzilla Attr
_ Text
code =
Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat [Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"[code]", Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
code, Doc Text
"[/code]"]
renderInlineCodeXenforo :: (PandocMonad m) => Attr -> Text -> RR m (Doc Text)
renderInlineCodeXenforo :: forall (m :: * -> *).
PandocMonad m =>
Attr -> Text -> RR m (Doc Text)
renderInlineCodeXenforo Attr
_ Text
code =
Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat [Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"[icode]", Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
code, Doc Text
"[/icode]"]
renderStrikeoutDefault :: (PandocMonad m) => [Inline] -> RR m (Doc Text)
renderStrikeoutDefault :: forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
renderStrikeoutDefault [Inline]
inlines = do
Doc Text
contents <- [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [Inline]
inlines
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat [Doc Text
"[s]", Doc Text
contents, Doc Text
"[/s]"]
renderStrikeoutSteam :: (PandocMonad m) => [Inline] -> RR m (Doc Text)
renderStrikeoutSteam :: forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
renderStrikeoutSteam [Inline]
inlines = do
Doc Text
contents <- [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [Inline]
inlines
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat [Doc Text
"[strike]", Doc Text
contents, Doc Text
"[/strike]"]
renderDefinitionListDefault ::
(PandocMonad m) => [([Inline], [[Block]])] -> RR m (Doc Text)
renderDefinitionListDefault :: forall (m :: * -> *).
PandocMonad m =>
[([Inline], [[Block]])] -> RR m (Doc Text)
renderDefinitionListDefault [([Inline], [[Block]])]
items = do
[Doc Text]
items' <- [([Inline], [[Block]])]
-> (([Inline], [[Block]]) -> RR m (Doc Text))
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [([Inline], [[Block]])]
items ((([Inline], [[Block]]) -> RR m (Doc Text))
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text])
-> (([Inline], [[Block]]) -> RR m (Doc Text))
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall a b. (a -> b) -> a -> b
$ \([Inline]
term, [[Block]]
definitions) -> do
Doc Text
term' <- [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [Inline]
term
Doc Text
definitions' <- Block -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> RR m (Doc Text)
blockToBBCode ([[Block]] -> Block
BulletList [[Block]]
definitions)
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
term' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
definitions'
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
items'
renderDefinitionListHubzilla ::
(PandocMonad m) => [([Inline], [[Block]])] -> RR m (Doc Text)
renderDefinitionListHubzilla :: forall (m :: * -> *).
PandocMonad m =>
[([Inline], [[Block]])] -> RR m (Doc Text)
renderDefinitionListHubzilla [([Inline], [[Block]])]
items = do
[Doc Text]
items' <- [([Inline], [[Block]])]
-> (([Inline], [[Block]]) -> RR m (Doc Text))
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [([Inline], [[Block]])]
items ((([Inline], [[Block]]) -> RR m (Doc Text))
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text])
-> (([Inline], [[Block]]) -> RR m (Doc Text))
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall a b. (a -> b) -> a -> b
$ \([Inline]
term, [[Block]]
definitions) -> do
Doc Text
term' <- [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [Inline]
term
let term'' :: Doc Text
term'' = Doc Text
"[*= " Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
term' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"]"
[Doc Text]
definitions' <- [[Block]]
-> ([Block] -> RR m (Doc Text))
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[Block]]
definitions [Block] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RR m (Doc Text)
blockListToBBCode
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat (Doc Text
term'' Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
: [Doc Text]
definitions')
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"[dl terms=\"b\"]" Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
: [Doc Text]
items' [Doc Text] -> [Doc Text] -> [Doc Text]
forall a. [a] -> [a] -> [a]
++ [Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"[/dl]"])
listWithTags ::
(PandocMonad m) =>
Text ->
Text ->
([[Block]] -> RR m [Doc Text]) ->
[[Block]] ->
RR m (Doc Text)
listWithTags :: forall (m :: * -> *).
PandocMonad m =>
Text
-> Text
-> ([[Block]] -> RR m [Doc Text])
-> [[Block]]
-> RR m (Doc Text)
listWithTags Text
open Text
close [[Block]] -> RR m [Doc Text]
renderItems [[Block]]
items = do
[Doc Text]
contents <- (WriterState -> WriterState) -> RR m [Doc Text] -> RR m [Doc Text]
forall a.
(WriterState -> WriterState)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\WriterState
s -> WriterState
s{inList = True}) ([[Block]] -> RR m [Doc Text]
renderItems [[Block]]
items)
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
open Doc Text -> [Doc Text] -> [Doc Text]
forall a. a -> [a] -> [a]
: [Doc Text]
contents [Doc Text] -> [Doc Text] -> [Doc Text]
forall a. [a] -> [a] -> [a]
++ [Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
close]
starListItems :: (PandocMonad m) => [[Block]] -> RR m [Doc Text]
starListItems :: forall (m :: * -> *). PandocMonad m => [[Block]] -> RR m [Doc Text]
starListItems [[Block]]
items = [[Block]]
-> ([Block]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[Block]]
items (([Block]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text])
-> ([Block]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall a b. (a -> b) -> a -> b
$ \[Block]
item -> do
Doc Text
item' <- [Block]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RR m (Doc Text)
blockListToBBCode [Block]
item
Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"[*]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
item'
listStyleCode :: ListNumberStyle -> Maybe Text
listStyleCode :: ListNumberStyle -> Maybe Text
listStyleCode = \case
ListNumberStyle
Decimal -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"1"
ListNumberStyle
DefaultStyle -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"1"
ListNumberStyle
LowerAlpha -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"a"
ListNumberStyle
UpperAlpha -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"A"
ListNumberStyle
LowerRoman -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"i"
ListNumberStyle
UpperRoman -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"I"
ListNumberStyle
Example -> Maybe Text
forall a. Maybe a
Nothing
renderBulletListOfficial :: (PandocMonad m) => [[Block]] -> RR m (Doc Text)
renderBulletListOfficial :: forall (m :: * -> *). PandocMonad m => [[Block]] -> RR m (Doc Text)
renderBulletListOfficial = Text
-> Text
-> ([[Block]] -> RR m [Doc Text])
-> [[Block]]
-> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text
-> Text
-> ([[Block]] -> RR m [Doc Text])
-> [[Block]]
-> RR m (Doc Text)
listWithTags Text
"[list]" Text
"[/list]" [[Block]] -> RR m [Doc Text]
forall (m :: * -> *). PandocMonad m => [[Block]] -> RR m [Doc Text]
starListItems
renderBulletListHubzilla :: (PandocMonad m) => [[Block]] -> RR m (Doc Text)
renderBulletListHubzilla :: forall (m :: * -> *). PandocMonad m => [[Block]] -> RR m (Doc Text)
renderBulletListHubzilla = Text
-> Text
-> ([[Block]] -> RR m [Doc Text])
-> [[Block]]
-> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text
-> Text
-> ([[Block]] -> RR m [Doc Text])
-> [[Block]]
-> RR m (Doc Text)
listWithTags Text
"[ul]" Text
"[/ul]" [[Block]] -> RR m [Doc Text]
forall (m :: * -> *). PandocMonad m => [[Block]] -> RR m [Doc Text]
starListItems
renderOrderedListHubzilla ::
(PandocMonad m) => ListAttributes -> [[Block]] -> RR m (Doc Text)
renderOrderedListHubzilla :: forall (m :: * -> *).
PandocMonad m =>
ListAttributes -> [[Block]] -> RR m (Doc Text)
renderOrderedListHubzilla (Int
_, ListNumberStyle
style, ListNumberDelim
_) = case ListNumberStyle
style of
ListNumberStyle
DefaultStyle -> Text
-> Text
-> ([[Block]] -> RR m [Doc Text])
-> [[Block]]
-> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text
-> Text
-> ([[Block]] -> RR m [Doc Text])
-> [[Block]]
-> RR m (Doc Text)
listWithTags Text
"[ol]" Text
"[/ol]" [[Block]] -> RR m [Doc Text]
forall (m :: * -> *). PandocMonad m => [[Block]] -> RR m [Doc Text]
starListItems
ListNumberStyle
Example -> Text
-> Text
-> ([[Block]] -> RR m [Doc Text])
-> [[Block]]
-> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text
-> Text
-> ([[Block]] -> RR m [Doc Text])
-> [[Block]]
-> RR m (Doc Text)
listWithTags Text
"[ol]" Text
"[/ol]" [[Block]] -> RR m [Doc Text]
forall (m :: * -> *). PandocMonad m => [[Block]] -> RR m [Doc Text]
starListItems
ListNumberStyle
_ -> Text
-> Text
-> ([[Block]] -> RR m [Doc Text])
-> [[Block]]
-> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text
-> Text
-> ([[Block]] -> RR m [Doc Text])
-> [[Block]]
-> RR m (Doc Text)
listWithTags (Text
"[list=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") Text
"[/list]" [[Block]] -> RR m [Doc Text]
forall (m :: * -> *). PandocMonad m => [[Block]] -> RR m [Doc Text]
starListItems
where
suffix :: Text
suffix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"1" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ ListNumberStyle -> Maybe Text
listStyleCode ListNumberStyle
style
renderOrderedListOfficial ::
(PandocMonad m) => ListAttributes -> [[Block]] -> RR m (Doc Text)
renderOrderedListOfficial :: forall (m :: * -> *).
PandocMonad m =>
ListAttributes -> [[Block]] -> RR m (Doc Text)
renderOrderedListOfficial (Int
_, ListNumberStyle
style, ListNumberDelim
_) = do
let suffix :: Text
suffix = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (ListNumberStyle -> Maybe Text
listStyleCode ListNumberStyle
style)
Text
-> Text
-> ([[Block]] -> RR m [Doc Text])
-> [[Block]]
-> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text
-> Text
-> ([[Block]] -> RR m [Doc Text])
-> [[Block]]
-> RR m (Doc Text)
listWithTags (Text
"[list" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") Text
"[/list]" [[Block]] -> RR m [Doc Text]
forall (m :: * -> *). PandocMonad m => [[Block]] -> RR m [Doc Text]
starListItems
renderOrderedListSteam ::
(PandocMonad m) => ListAttributes -> [[Block]] -> RR m (Doc Text)
renderOrderedListSteam :: forall (m :: * -> *).
PandocMonad m =>
ListAttributes -> [[Block]] -> RR m (Doc Text)
renderOrderedListSteam ListAttributes
_ =
Text
-> Text
-> ([[Block]] -> RR m [Doc Text])
-> [[Block]]
-> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text
-> Text
-> ([[Block]] -> RR m [Doc Text])
-> [[Block]]
-> RR m (Doc Text)
listWithTags Text
"[olist]" Text
"[/olist]" [[Block]] -> RR m [Doc Text]
forall (m :: * -> *). PandocMonad m => [[Block]] -> RR m [Doc Text]
starListItems
renderHeaderSteam ::
(PandocMonad m) => Int -> Attr -> [Inline] -> RR m (Doc Text)
Int
level Attr
_ [Inline]
inlines = do
Doc Text
body <- [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [Inline]
inlines
let capped :: Int
capped = (Int, Int) -> Int -> Int
forall a. Ord a => (a, a) -> a -> a
clamp (Int
1, Int
3) Int
level
open :: Text
open = Text
"[h" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
capped Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
close :: Text
close = Text
"[/h" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
capped Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
open Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
body Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
close
renderHeaderHubzilla ::
(PandocMonad m) => Int -> Attr -> [Inline] -> RR m (Doc Text)
Int
level Attr
_ [Inline]
inlines = do
Doc Text
body <- [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [Inline]
inlines
let capped :: Int
capped = (Int, Int) -> Int -> Int
forall a. Ord a => (a, a) -> a -> a
clamp (Int
1, Int
6) Int
level
open :: Text
open = Text
"[h" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
capped Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
close :: Text
close = Text
"[/h" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
capped Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
open Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
body Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
close
renderHeaderXenforo ::
(PandocMonad m) => Int -> Attr -> [Inline] -> RR m (Doc Text)
Int
level Attr
_ [Inline]
inlines = do
Doc Text
body <- [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [Inline]
inlines
let capped :: Int
capped = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
level
open :: Text
open = Text
"[heading=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
capped Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
close :: Text
close = Text
"[/heading]"
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
open Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
body Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
close
renderTableGeneric ::
(PandocMonad m) =>
Text ->
Text ->
Text ->
(Attr, Caption, [ColSpec], TableHead, [TableBody], TableFoot) ->
RR m (Doc Text)
renderTableGeneric :: forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> Text -> PandocTable -> RR m (Doc Text)
renderTableGeneric Text
tableTag Text
headerCellTag Text
bodyCellTag PandocTable
table = do
Doc Text
caption' <- [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [Inline]
caption
Doc Text
table' <-
if Bool -> Bool
not Bool
simpleCells
then Doc Text
"" Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) ()
-> RR m (Doc Text)
forall a b.
a
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) b
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> StateT (Seq (Doc Text)) (ReaderT WriterState m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Block -> LogMessage
BlockNotRendered Block
tableBlock)
else do
[Doc Text]
headerDocs <-
if [[Block]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
then [Doc Text]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
else Doc Text -> [Doc Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> [Doc Text])
-> RR m (Doc Text)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [[Block]] -> RR m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
Text
-> [[Block]]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
renderTableRow Text
headerCellTag [[Block]]
headers
[Doc Text]
rowDocs <- ([[Block]] -> RR m (Doc Text))
-> [[[Block]]]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc 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 -> [[Block]] -> RR m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
Text
-> [[Block]]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
renderTableRow Text
bodyCellTag) [[[Block]]]
rows
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> [Doc Text] -> Doc Text
renderTable' [Doc Text]
headerDocs [Doc Text]
rowDocs
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
caption' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
table'
where
(Attr
attr, Caption
blkCapt, [ColSpec]
specs, TableHead
thead, [TableBody]
tbody, TableFoot
tfoot) = PandocTable
table
([Inline]
caption, [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
tableBlock :: Block
tableBlock = Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
Table Attr
attr Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
simpleCells :: Bool
simpleCells = [[[Block]]] -> Bool
onlySimpleTableCells ([[Block]]
headers [[Block]] -> [[[Block]]] -> [[[Block]]]
forall a. a -> [a] -> [a]
: [[[Block]]]
rows)
renderTable' :: [Doc Text] -> [Doc Text] -> Doc Text
renderTable' [Doc Text]
headerDocs [Doc Text]
rowDocs =
[Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat
[ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableTag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]")
, [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
headerDocs
, [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
rowDocs
, Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"[/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableTag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]")
]
renderCell :: a -> Doc a -> Doc a
renderCell a
cellTag Doc a
cellDoc =
[Doc a] -> Doc a
forall a. Monoid a => [a] -> a
mconcat
[ a -> Doc a
forall a. HasChars a => a -> Doc a
literal (a
"[" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
cellTag a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"]")
, Doc a
cellDoc
, a -> Doc a
forall a. HasChars a => a -> Doc a
literal (a
"[/" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
cellTag a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"]")
]
renderTableRow :: Text
-> [[Block]]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
renderTableRow Text
cellTag [[Block]]
cells = do
[Doc Text]
renderedCells <- ([Block]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> [[Block]]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc 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]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RR m (Doc Text)
blockListToBBCode [[Block]]
cells
let cellsDoc :: Doc Text
cellsDoc = [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Doc Text -> Doc Text) -> [Doc Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc Text -> Doc Text
forall {a}. HasChars a => a -> Doc a -> Doc a
renderCell Text
cellTag) [Doc Text]
renderedCells
Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"[tr]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
cellsDoc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"[/tr]"
renderTableDefault ::
(PandocMonad m) =>
( Attr
, Caption
, [ColSpec]
, TableHead
, [TableBody]
, TableFoot
) ->
RR m (Doc Text)
renderTableDefault :: forall (m :: * -> *).
PandocMonad m =>
PandocTable -> RR m (Doc Text)
renderTableDefault = Text -> Text -> Text -> PandocTable -> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> Text -> PandocTable -> RR m (Doc Text)
renderTableGeneric Text
"table" Text
"th" Text
"td"
renderTableOmit ::
(PandocMonad m) =>
( Attr
, Caption
, [ColSpec]
, TableHead
, [TableBody]
, TableFoot
) ->
RR m (Doc Text)
renderTableOmit :: forall (m :: * -> *).
PandocMonad m =>
PandocTable -> RR m (Doc Text)
renderTableOmit (Attr
_, Caption
blkCapt, [ColSpec]
specs, TableHead
thead, [TableBody]
tbody, TableFoot
tfoot) = do
let ([Inline]
caption, [Alignment]
_, [Double]
_, [[Block]]
_, [[[Block]]]
_) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
Doc Text
caption' <- [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [Inline]
caption
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
caption' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
"(TABLE)"
attrToMap :: Attr -> Map Text (Maybe Text)
attrToMap :: Attr -> Map Text (Maybe Text)
attrToMap (Text
_, [Text]
classes, [Target]
kvList) =
[(Text, Maybe Text)] -> Map Text (Maybe Text)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Maybe Text)]
kvList' Map Text (Maybe Text)
-> Map Text (Maybe Text) -> Map Text (Maybe Text)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` [(Text, Maybe Text)] -> Map Text (Maybe Text)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Maybe Text)]
forall {a}. [(Text, Maybe a)]
classes'
where
kvList' :: [(Text, Maybe Text)]
kvList' = (Target -> (Text, Maybe Text)) -> [Target] -> [(Text, Maybe Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, Text
v) -> (Text
k, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v)) [Target]
kvList
classes' :: [(Text, Maybe a)]
classes' = (Text -> (Text, Maybe a)) -> [Text] -> [(Text, Maybe a)]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
k -> (Text
k, Maybe a
forall a. Maybe a
Nothing)) [Text]
classes
wrapSpanDivOfficial :: Bool -> Map Text (Maybe Text) -> Doc Text -> Doc Text
wrapSpanDivOfficial :: Bool -> Map Text (Maybe Text) -> Doc Text -> Doc Text
wrapSpanDivOfficial Bool
isDiv Map Text (Maybe Text)
kvc Doc Text
doc = (Text -> Maybe Text -> Doc Text -> Doc Text)
-> Doc Text -> Map Text (Maybe Text) -> Doc Text
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey Text -> Maybe Text -> Doc Text -> Doc Text
forall {a}.
(Eq a, IsString a) =>
a -> Maybe Text -> Doc Text -> Doc Text
wrap Doc Text
doc Map Text (Maybe Text)
kvc
where
wrap :: a -> Maybe Text -> Doc Text -> Doc Text
wrap a
"left" Maybe Text
Nothing Doc Text
acc | Bool
isDiv = Doc Text
"[left]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/left]"
wrap a
"center" Maybe Text
Nothing Doc Text
acc | Bool
isDiv = Doc Text
"[center]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/center]"
wrap a
"right" Maybe Text
Nothing Doc Text
acc | Bool
isDiv = Doc Text
"[right]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/right]"
wrap a
"spoiler" Maybe Text
Nothing Doc Text
acc | Bool
isDiv = Doc Text
"[spoiler]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/spoiler]"
wrap a
"spoiler" (Just Text
v) Doc Text
acc
| Bool
isDiv =
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"[spoiler=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Text -> Text
T.filter Char -> Bool
notBracket Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]")
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/spoiler]"
wrap a
"size" (Just Text
v) Doc Text
acc
| Just Int
v' <- forall a. Read a => String -> Maybe a
readMaybe @Int (Text -> String
T.unpack Text
v)
, Int
v' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"[size=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/size]"
wrap a
"color" (Just Text
v) Doc Text
acc =
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"[color=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/color]"
wrap a
_ Maybe Text
_ Doc Text
acc = Doc Text
acc
wrapSpanDivSteam :: Bool -> Map Text (Maybe Text) -> Doc Text -> Doc Text
wrapSpanDivSteam :: Bool -> Map Text (Maybe Text) -> Doc Text -> Doc Text
wrapSpanDivSteam Bool
isDiv Map Text (Maybe Text)
kvc Doc Text
doc = (Text -> Maybe Text -> Doc Text -> Doc Text)
-> Doc Text -> Map Text (Maybe Text) -> Doc Text
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey Text -> Maybe Text -> Doc Text -> Doc Text
forall {a} {a} {a}.
(Eq a, Semigroup a, IsString a, IsString a) =>
a -> Maybe a -> a -> a
wrap Doc Text
doc Map Text (Maybe Text)
kvc
where
wrap :: a -> Maybe a -> a -> a
wrap a
"spoiler" (Just a
_) a
acc | Bool
isDiv = a
"[spoiler]" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
acc a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"[/spoiler]"
wrap a
"spoiler" Maybe a
Nothing a
acc | Bool
isDiv = a
"[spoiler]" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
acc a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"[/spoiler]"
wrap a
_ Maybe a
_ a
acc = a
acc
wrapSpanDivPhpBB :: Bool -> Map Text (Maybe Text) -> Doc Text -> Doc Text
wrapSpanDivPhpBB :: Bool -> Map Text (Maybe Text) -> Doc Text -> Doc Text
wrapSpanDivPhpBB Bool
_ Map Text (Maybe Text)
kvc Doc Text
doc = (Text -> Maybe Text -> Doc Text -> Doc Text)
-> Doc Text -> Map Text (Maybe Text) -> Doc Text
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey Text -> Maybe Text -> Doc Text -> Doc Text
forall {a} {a}.
(Eq a, HasChars a, IsString a) =>
a -> Maybe a -> Doc a -> Doc a
wrap Doc Text
doc Map Text (Maybe Text)
kvc
where
wrap :: a -> Maybe a -> Doc a -> Doc a
wrap a
"color" (Just a
v) Doc a
acc =
a -> Doc a
forall a. HasChars a => a -> Doc a
literal (a
"[color=" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
v a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"]") Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
acc Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
"[/color]"
wrap a
_ Maybe a
_ Doc a
acc = Doc a
acc
wrapSpanDivFluxBB :: Bool -> Map Text (Maybe Text) -> Doc Text -> Doc Text
wrapSpanDivFluxBB :: Bool -> Map Text (Maybe Text) -> Doc Text -> Doc Text
wrapSpanDivFluxBB Bool
_ Map Text (Maybe Text)
kvc Doc Text
doc = (Text -> Maybe Text -> Doc Text -> Doc Text)
-> Doc Text -> Map Text (Maybe Text) -> Doc Text
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey Text -> Maybe Text -> Doc Text -> Doc Text
forall {a} {a}.
(Eq a, HasChars a, IsString a) =>
a -> Maybe a -> Doc a -> Doc a
wrap Doc Text
doc Map Text (Maybe Text)
kvc
where
wrap :: a -> Maybe a -> Doc a -> Doc a
wrap a
"color" (Just a
v) Doc a
acc =
a -> Doc a
forall a. HasChars a => a -> Doc a
literal (a
"[color=" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
v a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"]") Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
acc Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
"[/color]"
wrap a
_ Maybe a
_ Doc a
acc = Doc a
acc
wrapSpanDivHubzilla :: Bool -> Map Text (Maybe Text) -> Doc Text -> Doc Text
wrapSpanDivHubzilla :: Bool -> Map Text (Maybe Text) -> Doc Text -> Doc Text
wrapSpanDivHubzilla Bool
isDiv Map Text (Maybe Text)
kvc Doc Text
doc = (Text -> Maybe Text -> Doc Text -> Doc Text)
-> Doc Text -> Map Text (Maybe Text) -> Doc Text
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey Text -> Maybe Text -> Doc Text -> Doc Text
forall {a}.
(Eq a, IsString a) =>
a -> Maybe Text -> Doc Text -> Doc Text
wrap Doc Text
doc Map Text (Maybe Text)
kvc
where
wrap :: a -> Maybe Text -> Doc Text -> Doc Text
wrap a
"center" Maybe Text
Nothing Doc Text
acc | Bool
isDiv = Doc Text
"[center]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/center]"
wrap a
"spoiler" Maybe Text
Nothing Doc Text
acc | Bool
isDiv = Doc Text
"[spoiler]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/spoiler]"
wrap a
"spoiler" (Just Text
v) Doc Text
acc
| Bool
isDiv =
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"[spoiler=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Text -> Text
T.filter Char -> Bool
notBracket Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]")
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/spoiler]"
wrap a
"size" (Just Text
v) Doc Text
acc
| Just Int
v' <- forall a. Read a => String -> Maybe a
readMaybe @Int (Text -> String
T.unpack Text
v)
, Int
v' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"[size=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/size]"
wrap a
"color" (Just Text
v) Doc Text
acc =
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"[color=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/color]"
wrap a
"font" (Just Text
v) Doc Text
acc = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"[font=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/font]"
wrap a
_ Maybe Text
_ Doc Text
acc = Doc Text
acc
wrapSpanDivXenforo :: Bool -> Map Text (Maybe Text) -> Doc Text -> Doc Text
wrapSpanDivXenforo :: Bool -> Map Text (Maybe Text) -> Doc Text -> Doc Text
wrapSpanDivXenforo Bool
isDiv Map Text (Maybe Text)
kvc Doc Text
doc = (Text -> Maybe Text -> Doc Text -> Doc Text)
-> Doc Text -> Map Text (Maybe Text) -> Doc Text
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey Text -> Maybe Text -> Doc Text -> Doc Text
forall {a}.
(Eq a, IsString a) =>
a -> Maybe Text -> Doc Text -> Doc Text
wrap Doc Text
doc Map Text (Maybe Text)
kvc
where
wrap :: a -> Maybe Text -> Doc Text -> Doc Text
wrap a
"left" Maybe Text
Nothing Doc Text
acc | Bool
isDiv = Doc Text
"[left]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/left]"
wrap a
"center" Maybe Text
Nothing Doc Text
acc | Bool
isDiv = Doc Text
"[center]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/center]"
wrap a
"right" Maybe Text
Nothing Doc Text
acc | Bool
isDiv = Doc Text
"[right]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/right]"
wrap a
"spoiler" Maybe Text
_ Doc Text
acc | Bool -> Bool
not Bool
isDiv = Doc Text
"[ispoiler]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/ispoiler]"
wrap a
"spoiler" Maybe Text
Nothing Doc Text
acc | Bool
isDiv = Doc Text
"[spoiler]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/spoiler]"
wrap a
"spoiler" (Just Text
v) Doc Text
acc
| Bool
isDiv =
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"[spoiler=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Text -> Text
T.filter Char -> Bool
notBracket Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]")
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc
Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/spoiler]"
wrap a
"size" (Just Text
v) Doc Text
acc
| Just Int
v' <- forall a. Read a => String -> Maybe a
readMaybe @Int (Text -> String
T.unpack Text
v)
, Int
v' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 =
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"[size=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/size]"
wrap a
"color" (Just Text
v) Doc Text
acc =
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"[color=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/color]"
wrap a
"font" (Just Text
v) Doc Text
acc = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"[font=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
acc Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/font]"
wrap a
_ Maybe Text
_ Doc Text
acc = Doc Text
acc
renderOrderedListFluxbb ::
(PandocMonad m) =>
ListAttributes ->
[[Block]] ->
RR m (Doc Text)
renderOrderedListFluxbb :: forall (m :: * -> *).
PandocMonad m =>
ListAttributes -> [[Block]] -> RR m (Doc Text)
renderOrderedListFluxbb (Int
_, ListNumberStyle
style, ListNumberDelim
_) =
let suffix :: Text
suffix = case ListNumberStyle
style of
ListNumberStyle
LowerAlpha -> Text
"=a"
ListNumberStyle
UpperAlpha -> Text
"=a"
ListNumberStyle
_ -> Text
"=1"
in Text
-> Text
-> ([[Block]] -> RR m [Doc Text])
-> [[Block]]
-> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text
-> Text
-> ([[Block]] -> RR m [Doc Text])
-> [[Block]]
-> RR m (Doc Text)
listWithTags (Text
"[list" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") Text
"[/list]" [[Block]] -> RR m [Doc Text]
forall (m :: * -> *). PandocMonad m => [[Block]] -> RR m [Doc Text]
starListItems
renderOrderedListXenforo ::
(PandocMonad m) =>
ListAttributes ->
[[Block]] ->
RR m (Doc Text)
renderOrderedListXenforo :: forall (m :: * -> *).
PandocMonad m =>
ListAttributes -> [[Block]] -> RR m (Doc Text)
renderOrderedListXenforo ListAttributes
_ =
Text
-> Text
-> ([[Block]] -> RR m [Doc Text])
-> [[Block]]
-> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Text
-> Text
-> ([[Block]] -> RR m [Doc Text])
-> [[Block]]
-> RR m (Doc Text)
listWithTags Text
"[list=1]" Text
"[/list]" [[Block]] -> RR m [Doc Text]
forall (m :: * -> *). PandocMonad m => [[Block]] -> RR m [Doc Text]
starListItems
renderLinkEmailAware ::
(PandocMonad m) =>
Attr ->
[Inline] ->
Target ->
RR m (Doc Text)
renderLinkEmailAware :: forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> Target -> RR m (Doc Text)
renderLinkEmailAware Attr
attr [Inline]
txt target :: Target
target@(Text
src, Text
_) = do
case Text -> Text -> Maybe Text
T.stripPrefix Text
"mailto:" Text
src of
Just Text
address -> do
Doc Text
linkText <- [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [Inline]
txt
let isAutoEmail :: Bool
isAutoEmail = case [Inline]
txt of
[Str Text
x] -> Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
address
[Inline]
_ -> Bool
False
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$
if Bool
isAutoEmail
then Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"[email]" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
address Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/email]"
else Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"[email=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
address Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
linkText Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
"[/email]"
Maybe Text
Nothing -> Attr -> [Inline] -> Target -> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> Target -> RR m (Doc Text)
renderLinkDefault Attr
attr [Inline]
txt Target
target
renderBlockQuoteDefault :: (PandocMonad m) => [Block] -> RR m (Doc Text)
renderBlockQuoteDefault :: forall (m :: * -> *). PandocMonad m => [Block] -> RR m (Doc Text)
renderBlockQuoteDefault [Block]
blocks = do
Doc Text
contents <- [Block] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RR m (Doc Text)
blockListToBBCode [Block]
blocks
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text
"[quote]", Doc Text
contents, Doc Text
"[/quote]"]
renderBlockQuoteFluxBB :: (PandocMonad m) => [Block] -> RR m (Doc Text)
renderBlockQuoteFluxBB :: forall (m :: * -> *). PandocMonad m => [Block] -> RR m (Doc Text)
renderBlockQuoteFluxBB [Block]
blocks = do
Doc Text
contents <- [Block] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RR m (Doc Text)
blockListToBBCode [Block]
blocks
Bool
isInList <- (WriterState -> Bool)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterState -> Bool
inList
if Bool
isInList
then Doc Text
"" Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) ()
-> RR m (Doc Text)
forall a b.
a
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) b
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LogMessage -> StateT (Seq (Doc Text)) (ReaderT WriterState m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Block -> LogMessage
BlockNotRendered (Block -> LogMessage) -> Block -> LogMessage
forall a b. (a -> b) -> a -> b
$ [Block] -> Block
BlockQuote [Block]
blocks)
else Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text
"[quote]", Doc Text
contents, Doc Text
"[/quote]"]
renderHorizontalRuleDefault :: (PandocMonad m) => RR m (Doc Text)
renderHorizontalRuleDefault :: forall (m :: * -> *). PandocMonad m => RR m (Doc Text)
renderHorizontalRuleDefault = Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
"* * *"
renderHorizontalRuleHR :: (PandocMonad m) => RR m (Doc Text)
renderHorizontalRuleHR :: forall (m :: * -> *). PandocMonad m => RR m (Doc Text)
renderHorizontalRuleHR = Doc Text
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
"[hr]"
renderLineBlockDefault :: (PandocMonad m) => [[Inline]] -> RR m (Doc Text)
renderLineBlockDefault :: forall (m :: * -> *).
PandocMonad m =>
[[Inline]] -> RR m (Doc Text)
renderLineBlockDefault [[Inline]]
inliness = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc Text]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Inline]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text))
-> [[Inline]]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) [Doc 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]
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [[Inline]]
inliness
renderParaDefault :: (PandocMonad m) => [Inline] -> RR m (Doc Text)
renderParaDefault :: forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
renderParaDefault [Inline]
inlines = [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [Inline]
inlines
renderSuperscriptDefault :: (PandocMonad m) => [Inline] -> RR m (Doc Text)
renderSuperscriptDefault :: forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
renderSuperscriptDefault = [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode
renderSubscriptDefault :: (PandocMonad m) => [Inline] -> RR m (Doc Text)
renderSubscriptDefault :: forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
renderSubscriptDefault = [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode
renderSmallCapsDefault :: (PandocMonad m) => [Inline] -> RR m (Doc Text)
renderSmallCapsDefault :: forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
renderSmallCapsDefault = [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode
renderCiteDefault ::
(PandocMonad m) => [Citation] -> [Inline] -> RR m (Doc Text)
renderCiteDefault :: forall (m :: * -> *).
PandocMonad m =>
[Citation] -> [Inline] -> RR m (Doc Text)
renderCiteDefault [Citation]
_ = [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode
renderNoteDefault :: (PandocMonad m) => [Block] -> RR m (Doc Text)
renderNoteDefault :: forall (m :: * -> *). PandocMonad m => [Block] -> RR m (Doc Text)
renderNoteDefault [Block]
blocks = do
Int
newN <- (Seq (Doc Text) -> Int)
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> (Seq (Doc Text) -> Int) -> Seq (Doc Text) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Doc Text) -> Int
forall a. Seq a -> Int
Seq.length)
Doc Text
contents <- [Block] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RR m (Doc Text)
blockListToBBCode [Block]
blocks
let pointer :: Text
pointer = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
newN Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
let contents' :: Doc Text
contents' = Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
pointer Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
space Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
contents
(Seq (Doc Text) -> Seq (Doc Text))
-> StateT (Seq (Doc Text)) (ReaderT WriterState m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Seq (Doc Text) -> Doc Text -> Seq (Doc Text)
forall a. Seq a -> a -> Seq a
|> Doc Text
contents')
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
pointer
renderFigureDefault ::
(PandocMonad m) => Attr -> Caption -> [Block] -> RR m (Doc Text)
renderFigureDefault :: forall (m :: * -> *).
PandocMonad m =>
Attr -> Caption -> [Block] -> RR m (Doc Text)
renderFigureDefault Attr
_ (Caption Maybe [Inline]
_ [Block]
caption) [Block]
blocks = do
Doc Text
caption' <- [Block] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RR m (Doc Text)
blockListToBBCode [Block]
caption
Doc Text
contents <- [Block] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RR m (Doc Text)
blockListToBBCode [Block]
blocks
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
caption'
renderQuotedDefault ::
(PandocMonad m) => QuoteType -> [Inline] -> RR m (Doc Text)
renderQuotedDefault :: forall (m :: * -> *).
PandocMonad m =>
QuoteType -> [Inline] -> RR m (Doc Text)
renderQuotedDefault QuoteType
typ [Inline]
inlines = do
let quote :: Doc Text
quote = case QuoteType
typ of QuoteType
SingleQuote -> Doc Text
"'"; QuoteType
DoubleQuote -> Doc Text
"\""
Doc Text
contents <- [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
inlineListToBBCode [Inline]
inlines
Doc Text -> RR m (Doc Text)
forall a. a -> StateT (Seq (Doc Text)) (ReaderT WriterState m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc Text -> RR m (Doc Text)) -> Doc Text -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. Monoid a => [a] -> a
mconcat [Doc Text
quote, Doc Text
contents, Doc Text
quote]
renderMathDefault :: (PandocMonad m) => MathType -> Text -> RR m (Doc Text)
renderMathDefault :: forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> RR m (Doc Text)
renderMathDefault MathType
typ Text
math = case MathType
typ of
MathType
InlineMath ->
Inline -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => Inline -> RR m (Doc Text)
inlineToBBCode (Inline -> RR m (Doc Text)) -> Inline -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$
Attr -> Text -> Inline
Code (Text
"", [Text
"latex"], []) (Text
"$" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
math Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"$")
MathType
DisplayMath ->
Block -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => Block -> RR m (Doc Text)
blockToBBCode (Block -> RR m (Doc Text)) -> Block -> RR m (Doc Text)
forall a b. (a -> b) -> a -> b
$
Attr -> Text -> Block
CodeBlock (Text
"", [Text
"latex"], []) (Text
"$$" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
math Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"$$")
officialSpec :: FlavorSpec
officialSpec :: FlavorSpec
officialSpec =
FlavorSpec
{ renderOrderedList :: forall (m :: * -> *).
PandocMonad m =>
ListAttributes -> [[Block]] -> RR m (Doc Text)
renderOrderedList = ListAttributes -> [[Block]] -> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
ListAttributes -> [[Block]] -> RR m (Doc Text)
renderOrderedListOfficial
, renderBulletList :: forall (m :: * -> *). PandocMonad m => [[Block]] -> RR m (Doc Text)
renderBulletList = [[Block]] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [[Block]] -> RR m (Doc Text)
renderBulletListOfficial
, renderDefinitionList :: forall (m :: * -> *).
PandocMonad m =>
[([Inline], [[Block]])] -> RR m (Doc Text)
renderDefinitionList = [([Inline], [[Block]])] -> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[([Inline], [[Block]])] -> RR m (Doc Text)
renderDefinitionListDefault
, renderHeader :: forall (m :: * -> *).
PandocMonad m =>
Int -> Attr -> [Inline] -> RR m (Doc Text)
renderHeader = Int -> Attr -> [Inline] -> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Int -> Attr -> [Inline] -> RR m (Doc Text)
renderHeaderDefault
, renderTable :: forall (m :: * -> *).
PandocMonad m =>
PandocTable -> RR m (Doc Text)
renderTable = PandocTable -> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
PandocTable -> RR m (Doc Text)
renderTableDefault
, renderLink :: forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> Target -> RR m (Doc Text)
renderLink = Attr -> [Inline] -> Target -> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> Target -> RR m (Doc Text)
renderLinkEmailAware
, renderCodeBlock :: forall (m :: * -> *).
PandocMonad m =>
Attr -> Text -> RR m (Doc Text)
renderCodeBlock = Attr -> Text -> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Attr -> Text -> RR m (Doc Text)
renderCodeBlockDefault
, renderInlineCode :: forall (m :: * -> *).
PandocMonad m =>
Attr -> Text -> RR m (Doc Text)
renderInlineCode = Attr -> Text -> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Attr -> Text -> RR m (Doc Text)
renderInlineCodeLiteral
, renderStrikeout :: forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
renderStrikeout = [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
renderStrikeoutDefault
, renderBlockQuote :: forall (m :: * -> *). PandocMonad m => [Block] -> RR m (Doc Text)
renderBlockQuote = [Block] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RR m (Doc Text)
renderBlockQuoteDefault
, renderHorizontalRule :: forall (m :: * -> *). PandocMonad m => RR m (Doc Text)
renderHorizontalRule = RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => RR m (Doc Text)
renderHorizontalRuleDefault
, renderLineBlock :: forall (m :: * -> *).
PandocMonad m =>
[[Inline]] -> RR m (Doc Text)
renderLineBlock = [[Inline]] -> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[[Inline]] -> RR m (Doc Text)
renderLineBlockDefault
, renderPara :: forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
renderPara = [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
renderParaDefault
, renderSuperscript :: forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
renderSuperscript = [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
renderSuperscriptDefault
, renderSubscript :: forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
renderSubscript = [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
renderSubscriptDefault
, renderSmallCaps :: forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
renderSmallCaps = [Inline] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Inline] -> RR m (Doc Text)
renderSmallCapsDefault
, renderCite :: forall (m :: * -> *).
PandocMonad m =>
[Citation] -> [Inline] -> RR m (Doc Text)
renderCite = [Citation] -> [Inline] -> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[Citation] -> [Inline] -> RR m (Doc Text)
renderCiteDefault
, renderNote :: forall (m :: * -> *). PandocMonad m => [Block] -> RR m (Doc Text)
renderNote = [Block] -> RR m (Doc Text)
forall (m :: * -> *). PandocMonad m => [Block] -> RR m (Doc Text)
renderNoteDefault
, renderFigure :: forall (m :: * -> *).
PandocMonad m =>
Attr -> Caption -> [Block] -> RR m (Doc Text)
renderFigure = Attr -> Caption -> [Block] -> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Attr -> Caption -> [Block] -> RR m (Doc Text)
renderFigureDefault
, renderMath :: forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> RR m (Doc Text)
renderMath = MathType -> Text -> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> RR m (Doc Text)
renderMathDefault
, renderQuoted :: forall (m :: * -> *).
PandocMonad m =>
QuoteType -> [Inline] -> RR m (Doc Text)
renderQuoted = QuoteType -> [Inline] -> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
QuoteType -> [Inline] -> RR m (Doc Text)
renderQuotedDefault
, renderImage :: forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> Target -> RR m (Doc Text)
renderImage = Attr -> [Inline] -> Target -> RR m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
Attr -> [Inline] -> Target -> RR m (Doc Text)
renderImageDefault
, wrapSpanDiv :: Bool -> Map Text (Maybe Text) -> Doc Text -> Doc Text
wrapSpanDiv = Bool -> Map Text (Maybe Text) -> Doc Text -> Doc Text
wrapSpanDivOfficial
}
steamSpec :: FlavorSpec
steamSpec :: FlavorSpec
steamSpec =
FlavorSpec
officialSpec
{ renderOrderedList = renderOrderedListSteam
, renderHeader = renderHeaderSteam
, renderLink = renderLinkDefault
, renderInlineCode = renderInlineCodeNoParse
, renderStrikeout = renderStrikeoutSteam
, renderImage = renderImageOmit
, wrapSpanDiv = wrapSpanDivSteam
, renderHorizontalRule = renderHorizontalRuleHR
}
phpbbSpec :: FlavorSpec
phpbbSpec :: FlavorSpec
phpbbSpec =
FlavorSpec
officialSpec
{ renderTable = renderTableOmit
, renderImage = renderImagePhpBB
, wrapSpanDiv = wrapSpanDivPhpBB
}
fluxbbSpec :: FlavorSpec
fluxbbSpec :: FlavorSpec
fluxbbSpec =
FlavorSpec
officialSpec
{ renderOrderedList = renderOrderedListFluxbb
, renderCodeBlock = renderCodeBlockSimple
, renderTable = renderTableOmit
, renderBlockQuote = renderBlockQuoteFluxBB
, renderImage = renderImageFluxBB
, wrapSpanDiv = wrapSpanDivFluxBB
}
hubzillaSpec :: FlavorSpec
hubzillaSpec :: FlavorSpec
hubzillaSpec =
FlavorSpec
officialSpec
{ renderOrderedList = renderOrderedListHubzilla
, renderBulletList = renderBulletListHubzilla
, renderDefinitionList = renderDefinitionListHubzilla
, renderHeader = renderHeaderHubzilla
, renderInlineCode = renderInlineCodeHubzilla
, renderLink = renderLinkDefault
, wrapSpanDiv = wrapSpanDivHubzilla
, renderHorizontalRule = renderHorizontalRuleHR
}
xenforoSpec :: FlavorSpec
xenforoSpec :: FlavorSpec
xenforoSpec =
FlavorSpec
officialSpec
{ wrapSpanDiv = wrapSpanDivXenforo
, renderHeader = renderHeaderXenforo
, renderInlineCode = renderInlineCodeXenforo
, renderHorizontalRule = renderHorizontalRuleHR
, renderOrderedList = renderOrderedListXenforo
, renderImage = renderImageXenforo
}