From d6b7b1dc772249e9a1b56bcdd4ae816cc54edb51 Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Sat, 18 Jul 2020 15:17:06 -0700
Subject: Remove use of cmark-gfm for commonmark/gfm rendering.
Instead rely on the markdown writer with appropriate extensions.
Export writeCommonMark variant from Markdown writer.
This changes a few small things in rendering markdown,
e.g. w/r/t requiring backslashes before spaces inside
super/subscripts.
---
src/Text/Pandoc/Extensions.hs | 1 +
src/Text/Pandoc/Writers/CommonMark.hs | 350 +---------------------------------
src/Text/Pandoc/Writers/Markdown.hs | 175 +++++++++--------
3 files changed, 97 insertions(+), 429 deletions(-)
(limited to 'src/Text')
diff --git a/src/Text/Pandoc/Extensions.hs b/src/Text/Pandoc/Extensions.hs
index 3db2db4e5..0a33cf39e 100644
--- a/src/Text/Pandoc/Extensions.hs
+++ b/src/Text/Pandoc/Extensions.hs
@@ -245,6 +245,7 @@ githubMarkdownExtensions :: Extensions
githubMarkdownExtensions = extensionsFromList
[ Ext_pipe_tables
, Ext_raw_html
+ , Ext_native_divs
, Ext_auto_identifiers
, Ext_gfm_auto_identifiers
, Ext_autolink_bare_uris
diff --git a/src/Text/Pandoc/Writers/CommonMark.hs b/src/Text/Pandoc/Writers/CommonMark.hs
index ca6a4e334..e991cd384 100644
--- a/src/Text/Pandoc/Writers/CommonMark.hs
+++ b/src/Text/Pandoc/Writers/CommonMark.hs
@@ -15,353 +15,5 @@ CommonMark: <http://commonmark.org>
-}
module Text.Pandoc.Writers.CommonMark (writeCommonMark) where
-import CMarkGFM
-import Control.Monad.State.Strict (State, get, modify, runState)
-import Data.Char (isAscii)
-import Data.Foldable (foldrM)
-import Data.List (transpose)
-import Data.Text (Text)
-import qualified Data.Text as T
-import Network.HTTP (urlEncode)
-import Text.Pandoc.Class.PandocMonad (PandocMonad)
-import Text.Pandoc.Definition
-import Text.Pandoc.Options
-import Text.Pandoc.Shared (capitalize, isTightList,
- linesToPara, onlySimpleTableCells, taskListItemToAscii, tshow)
-import Text.Pandoc.Templates (renderTemplate)
-import Text.Pandoc.Walk (walk, walkM)
-import Text.Pandoc.Writers.HTML (writeHtml5String, tagWithAttributes)
-import Text.Pandoc.Writers.Shared
-import Text.Pandoc.XML (toHtml5Entities)
-import Text.DocLayout (literal, render)
+import Text.Pandoc.Writers.Markdown (writeCommonMark)
--- | Convert Pandoc to CommonMark.
-writeCommonMark :: PandocMonad m => WriterOptions -> Pandoc -> m Text
-writeCommonMark opts (Pandoc meta blocks) = do
- toc <- if writerTableOfContents opts
- then blocksToCommonMark opts [ toTableOfContents opts blocks ]
- else return mempty
-
- let (blocks', notes) = runState (walkM processNotes blocks) []
- notes' = [OrderedList (1, Decimal, Period) $ reverse notes | not (null notes)]
- main <- blocksToCommonMark opts (blocks' ++ notes')
- metadata <- metaToContext opts
- (fmap (literal . T.stripEnd) . blocksToCommonMark opts)
- (fmap (literal . T.stripEnd) . inlinesToCommonMark opts)
- meta
- let context =
- -- for backwards compatibility we populate toc
- -- with the contents of the toc, rather than a boolean:
- defField "toc" toc
- $ defField "table-of-contents" toc
- $ defField "body" main metadata
- return $
- case writerTemplate opts of
- Nothing -> main
- Just tpl -> render Nothing $ renderTemplate tpl context
-
-softBreakToSpace :: Inline -> Inline
-softBreakToSpace SoftBreak = Space
-softBreakToSpace x = x
-
-processNotes :: Inline -> State [[Block]] Inline
-processNotes (Note bs) = do
- modify (bs :)
- notes <- get
- return $ Str $ "[" <> tshow (length notes) <> "]"
-processNotes x = return x
-
-node :: NodeType -> [Node] -> Node
-node = Node Nothing
-
-blocksToCommonMark :: PandocMonad m => WriterOptions -> [Block] -> m Text
-blocksToCommonMark opts bs = do
- let cmarkOpts = [optHardBreaks | isEnabled Ext_hard_line_breaks opts]
- colwidth = if writerWrapText opts == WrapAuto
- then Just $ writerColumns opts
- else Nothing
- nodes <- blocksToNodes opts bs
- return $ T.stripEnd $
- nodeToCommonmark cmarkOpts colwidth $
- node DOCUMENT nodes
-
-inlinesToCommonMark :: PandocMonad m => WriterOptions -> [Inline] -> m Text
-inlinesToCommonMark opts ils = return $
- nodeToCommonmark cmarkOpts colwidth $
- node PARAGRAPH (inlinesToNodes opts ils)
- where cmarkOpts = [optHardBreaks | isEnabled Ext_hard_line_breaks opts]
- colwidth = if writerWrapText opts == WrapAuto
- then Just $ writerColumns opts
- else Nothing
-
-blocksToNodes :: PandocMonad m => WriterOptions -> [Block] -> m [Node]
-blocksToNodes opts = foldrM (blockToNodes opts) []
-
-blockToNodes :: PandocMonad m => WriterOptions -> Block -> [Node] -> m [Node]
-blockToNodes opts (Plain xs) ns =
- return (node PARAGRAPH (inlinesToNodes opts xs) : ns)
-blockToNodes opts (Para xs) ns =
- return (node PARAGRAPH (inlinesToNodes opts xs) : ns)
-blockToNodes opts (LineBlock lns) ns = blockToNodes opts (linesToPara lns) ns
-blockToNodes _ (CodeBlock (_,classes,_) xs) ns = return
- (node (CODE_BLOCK (T.unwords classes) xs) [] : ns)
-blockToNodes opts (RawBlock (Format f) xs) ns
- | f == "html" && isEnabled Ext_raw_html opts
- = return (node (HTML_BLOCK xs) [] : ns)
- | (f == "latex" || f == "tex") && isEnabled Ext_raw_tex opts
- = return (node (CUSTOM_BLOCK xs T.empty) [] : ns)
- | f == "markdown"
- = return (node (CUSTOM_BLOCK xs T.empty) [] : ns)
- | otherwise = return ns
-blockToNodes opts (BlockQuote bs) ns = do
- nodes <- blocksToNodes opts bs
- return (node BLOCK_QUOTE nodes : ns)
-blockToNodes opts (BulletList items) ns = do
- let exts = writerExtensions opts
- nodes <- mapM (blocksToNodes opts . taskListItemToAscii exts) items
- return (node (LIST ListAttributes{
- listType = BULLET_LIST,
- listDelim = PERIOD_DELIM,
- listTight = isTightList items,
- listStart = 1 }) (map (node ITEM) nodes) : ns)
-blockToNodes opts (OrderedList (start, _sty, delim) items) ns = do
- let exts = writerExtensions opts
- nodes <- mapM (blocksToNodes opts . taskListItemToAscii exts) items
- return (node (LIST ListAttributes{
- listType = ORDERED_LIST,
- listDelim = case delim of
- OneParen -> PAREN_DELIM
- TwoParens -> PAREN_DELIM
- _ -> PERIOD_DELIM,
- listTight = isTightList items,
- listStart = start }) (map (node ITEM) nodes) : ns)
-blockToNodes _ HorizontalRule ns = return (node THEMATIC_BREAK [] : ns)
-blockToNodes opts (Header lev _ ils) ns =
- return (node (HEADING lev) (inlinesToNodes opts ils) : ns)
-blockToNodes opts (Div attr bs) ns = do
- nodes <- blocksToNodes opts bs
- let op = tagWithAttributes opts True False "div" attr
- if isEnabled Ext_raw_html opts
- then return (node (HTML_BLOCK op) [] : nodes ++
- [node (HTML_BLOCK (T.pack "</div>")) []] ++ ns)
- else return (nodes ++ ns)
-blockToNodes opts (DefinitionList items) ns =
- blockToNodes opts (BulletList items') ns
- where items' = map dlToBullet items
- dlToBullet (term, (Para xs : ys) : zs) =
- Para (term ++ [LineBreak] ++ xs) : ys ++ concat zs
- dlToBullet (term, (Plain xs : ys) : zs) =
- Plain (term ++ [LineBreak] ++ xs) : ys ++ concat zs
- dlToBullet (term, xs) =
- Para term : concat xs
-blockToNodes opts t@(Table _ blkCapt specs thead tbody tfoot) ns =
- let (capt, aligns, _widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
- in if isEnabled Ext_pipe_tables opts && onlySimpleTableCells (headers : rows)
- then do
- -- We construct a table manually as a CUSTOM_BLOCK, for
- -- two reasons: (1) cmark-gfm currently doesn't support
- -- rendering TABLE nodes; (2) we can align the column sides;
- -- (3) we can render the caption as a regular paragraph.
- let capt' = node PARAGRAPH (inlinesToNodes opts capt)
- -- backslash | in code and raw:
- let fixPipe (Code attr xs) =
- Code attr (T.replace "|" "\\|" xs)
- fixPipe (RawInline format xs) =
- RawInline format (T.replace "|" "\\|" xs)
- fixPipe x = x
- let toCell [Plain ils] = T.strip
- $ nodeToCommonmark [] Nothing
- $ node (CUSTOM_INLINE mempty mempty)
- $ inlinesToNodes opts
- $ walk (fixPipe . softBreakToSpace) ils
- toCell [Para ils] = T.strip
- $ nodeToCommonmark [] Nothing
- $ node (CUSTOM_INLINE mempty mempty)
- $ inlinesToNodes opts
- $ walk (fixPipe . softBreakToSpace) ils
- toCell [] = ""
- toCell xs = error $ "toCell encountered " ++ show xs
- let separator = " | "
- let starter = "| "
- let ender = " |"
- let rawheaders = map toCell headers
- let rawrows = map (map toCell) rows
- let maximum' [] = 0
- maximum' xs = maximum xs
- let colwidths = map (maximum' . map T.length) $
- transpose (rawheaders:rawrows)
- let toHeaderLine len AlignDefault = T.replicate len "-"
- toHeaderLine len AlignLeft = ":" <>
- T.replicate (max (len - 1) 1) "-"
- toHeaderLine len AlignRight =
- T.replicate (max (len - 1) 1) "-" <> ":"
- toHeaderLine len AlignCenter = ":" <>
- T.replicate (max (len - 2) 1) (T.pack "-") <> ":"
- let rawheaderlines = zipWith toHeaderLine colwidths aligns
- let headerlines = starter <> T.intercalate separator rawheaderlines <>
- ender
- let padContent (align, w) t' =
- let padding = w - T.length t'
- halfpadding = padding `div` 2
- in case align of
- AlignRight -> T.replicate padding " " <> t'
- AlignCenter -> T.replicate halfpadding " " <> t' <>
- T.replicate (padding - halfpadding) " "
- _ -> t' <> T.replicate padding " "
- let toRow xs = starter <> T.intercalate separator
- (zipWith padContent (zip aligns colwidths) xs) <>
- ender
- let table' = toRow rawheaders <> "\n" <> headerlines <> "\n" <>
- T.intercalate "\n" (map toRow rawrows)
- return (node (CUSTOM_BLOCK table' mempty) [] :
- if null capt
- then ns
- else capt' : ns)
- else do -- fall back to raw HTML
- s <- writeHtml5String def $! Pandoc nullMeta [t]
- return (node (HTML_BLOCK s) [] : ns)
-blockToNodes _ Null ns = return ns
-
-inlinesToNodes :: WriterOptions -> [Inline] -> [Node]
-inlinesToNodes opts = foldr (inlineToNodes opts) []
-
-inlineToNodes :: WriterOptions -> Inline -> [Node] -> [Node]
-inlineToNodes opts (Str s) = stringToNodes opts s'
- where s' = if isEnabled Ext_smart opts
- then unsmartify opts s
- else s
-inlineToNodes _ Space = (node (TEXT (T.pack " ")) [] :)
-inlineToNodes _ LineBreak = (node LINEBREAK [] :)
-inlineToNodes opts SoftBreak
- | isEnabled Ext_hard_line_breaks opts = (node (TEXT " ") [] :)
- | writerWrapText opts == WrapNone = (node (TEXT " ") [] :)
- | otherwise = (node SOFTBREAK [] :)
-inlineToNodes opts (Emph xs) = (node EMPH (inlinesToNodes opts xs) :)
-inlineToNodes opts (Underline xs)
- | isEnabled Ext_raw_html opts =
- ((node (HTML_INLINE (T.pack "<u>")) [] : inlinesToNodes opts xs ++
- [node (HTML_INLINE (T.pack "</u>")) []]) ++ )
- | otherwise = (node EMPH (inlinesToNodes opts xs) :)
-inlineToNodes opts (Strong xs) = (node STRONG (inlinesToNodes opts xs) :)
-inlineToNodes opts (Strikeout xs)
- | isEnabled Ext_strikeout opts = (node (CUSTOM_INLINE "~~" "~~") (inlinesToNodes opts xs) :)
- | isEnabled Ext_raw_html opts = ((node (HTML_INLINE (T.pack "<s>")) [] : inlinesToNodes opts xs ++
- [node (HTML_INLINE (T.pack "</s>")) []]) ++ )
- | otherwise = (inlinesToNodes opts xs ++)
-inlineToNodes opts (Superscript xs) =
- if isEnabled Ext_raw_html opts
- then ((node (HTML_INLINE (T.pack "<sup>")) [] : inlinesToNodes opts xs ++
- [node (HTML_INLINE (T.pack "</sup>")) []]) ++ )
- else case traverse toSuperscriptInline xs of
- Just xs' | not (writerPreferAscii opts)
- -> (inlinesToNodes opts xs' ++)
- _ ->
- ((node (TEXT (T.pack "^(")) [] : inlinesToNodes opts xs ++
- [node (TEXT (T.pack ")")) []]) ++ )
-inlineToNodes opts (Subscript xs) =
- if isEnabled Ext_raw_html opts
- then ((node (HTML_INLINE (T.pack "<sub>")) [] : inlinesToNodes opts xs ++
- [node (HTML_INLINE (T.pack "</sub>")) []]) ++ )
- else case traverse toSubscriptInline xs of
- Just xs' | not (writerPreferAscii opts)
- -> (inlinesToNodes opts xs' ++)
- _ ->
- ((node (TEXT (T.pack "_(")) [] : inlinesToNodes opts xs ++
- [node (TEXT (T.pack ")")) []]) ++ )
-inlineToNodes opts (SmallCaps xs) =
- if isEnabled Ext_raw_html opts
- then ((node (HTML_INLINE (T.pack "<span class=\"smallcaps\">")) []
- : inlinesToNodes opts xs ++
- [node (HTML_INLINE (T.pack "</span>")) []]) ++ )
- else (inlinesToNodes opts (capitalize xs) ++)
-inlineToNodes opts (Link _ ils (url,tit)) =
- (node (LINK url tit) (inlinesToNodes opts ils) :)
--- title beginning with fig: indicates implicit figure
-inlineToNodes opts (Image alt ils (url,T.stripPrefix "fig:" -> Just tit)) =
- inlineToNodes opts (Image alt ils (url,tit))
-inlineToNodes opts (Image _ ils (url,tit)) =
- (node (IMAGE url tit) (inlinesToNodes opts ils) :)
-inlineToNodes opts (RawInline (Format f) xs)
- | f == "html" && isEnabled Ext_raw_html opts
- = (node (HTML_INLINE xs) [] :)
- | (f == "latex" || f == "tex") && isEnabled Ext_raw_tex opts
- = (node (CUSTOM_INLINE xs T.empty) [] :)
- | f == "markdown"
- = (node (CUSTOM_INLINE xs T.empty) [] :)
- | otherwise = id
-inlineToNodes opts (Quoted qt ils) =
- ((node (HTML_INLINE start) [] :
- inlinesToNodes opts ils ++ [node (HTML_INLINE end) []]) ++)
- where (start, end) = case qt of
- SingleQuote
- | isEnabled Ext_smart opts -> ("'","'")
- | writerPreferAscii opts ->
- ("‘", "’")
- | otherwise -> ("‘", "’")
- DoubleQuote
- | isEnabled Ext_smart opts -> ("\"", "\"")
- | writerPreferAscii opts ->
- ("“", "”")
- | otherwise -> ("“", "”")
-inlineToNodes _ (Code _ str) = (node (CODE str) [] :)
-inlineToNodes opts (Math mt str) =
- case writerHTMLMathMethod opts of
- WebTeX url ->
- let core = inlineToNodes opts
- (Image nullAttr [Str str] (url <> T.pack (urlEncode $ T.unpack str), str))
- sep = if mt == DisplayMath
- then (node LINEBREAK [] :)
- else id
- in (sep . core . sep)
- _ ->
- case mt of
- InlineMath ->
- (node (HTML_INLINE ("\\(" <> str <> "\\)")) [] :)
- DisplayMath ->
- (node (HTML_INLINE ("\\[" <> str <> "\\]")) [] :)
-inlineToNodes opts (Span ("",["emoji"],kvs) [Str s]) =
- case lookup "data-emoji" kvs of
- Just emojiname | isEnabled Ext_emoji opts ->
- (node (TEXT (":" <> emojiname <> ":")) [] :)
- _ -> (node (TEXT s) [] :)
-inlineToNodes opts (Span attr ils) =
- let nodes = inlinesToNodes opts ils
- op = tagWithAttributes opts True False "span" attr
- in if isEnabled Ext_raw_html opts
- then ((node (HTML_INLINE op) [] : nodes ++
- [node (HTML_INLINE (T.pack "</span>")) []]) ++)
- else (nodes ++)
-inlineToNodes opts (Cite _ ils) = (inlinesToNodes opts ils ++)
-inlineToNodes _ (Note _) = id -- should not occur
--- we remove Note elements in preprocessing
-
-stringToNodes :: WriterOptions -> Text -> [Node] -> [Node]
-stringToNodes opts s
- | not (writerPreferAscii opts) = (node (TEXT s) [] :)
- | otherwise = step s
- where
- step input =
- let (ascii, rest) = T.span isAscii input
- this = node (TEXT ascii) []
- nodes = case T.uncons rest of
- Nothing -> id
- Just (nonAscii, rest') ->
- let escaped = toHtml5Entities (T.singleton nonAscii)
- in (node (HTML_INLINE escaped) [] :) . step rest'
- in (this :) . nodes
-
-toSubscriptInline :: Inline -> Maybe Inline
-toSubscriptInline Space = Just Space
-toSubscriptInline (Span attr ils) = Span attr <$> traverse toSubscriptInline ils
-toSubscriptInline (Str s) = Str . T.pack <$> traverse toSubscript (T.unpack s)
-toSubscriptInline LineBreak = Just LineBreak
-toSubscriptInline SoftBreak = Just SoftBreak
-toSubscriptInline _ = Nothing
-
-toSuperscriptInline :: Inline -> Maybe Inline
-toSuperscriptInline Space = Just Space
-toSuperscriptInline (Span attr ils) = Span attr <$> traverse toSuperscriptInline ils
-toSuperscriptInline (Str s) = Str . T.pack <$> traverse toSuperscript (T.unpack s)
-toSuperscriptInline LineBreak = Just LineBreak
-toSuperscriptInline SoftBreak = Just SoftBreak
-toSuperscriptInline _ = Nothing
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index daf3617d8..37cdca005 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -16,7 +16,10 @@ Conversion of 'Pandoc' documents to markdown-formatted plain text.
Markdown: <http://daringfireball.net/projects/markdown/>
-}
-module Text.Pandoc.Writers.Markdown (writeMarkdown, writePlain) where
+module Text.Pandoc.Writers.Markdown (
+ writeMarkdown,
+ writeCommonMark,
+ writePlain) where
import Control.Monad.Reader
import Control.Monad.State.Strict
import Data.Char (isAlphaNum)
@@ -55,15 +58,21 @@ evalMD :: PandocMonad m => MD m a -> WriterEnv -> WriterState -> m a
evalMD md env st = evalStateT (runReaderT md env) st
data WriterEnv = WriterEnv { envInList :: Bool
- , envPlain :: Bool
+ , envVariant :: MarkdownVariant
, envRefShortcutable :: Bool
, envBlockLevel :: Int
, envEscapeSpaces :: Bool
}
+data MarkdownVariant =
+ PlainText
+ | Commonmark
+ | Markdown
+ deriving (Show, Eq)
+
instance Default WriterEnv
- where def = WriterEnv { envInList = False
- , envPlain = False
+ where def = WriterEnv { envInList = False
+ , envVariant = Markdown
, envRefShortcutable = True
, envBlockLevel = 0
, envEscapeSpaces = False
@@ -102,7 +111,12 @@ writeMarkdown opts document =
-- pictures, or inline formatting).
writePlain :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writePlain opts document =
- evalMD (pandocToMarkdown opts document) def{ envPlain = True } def
+ evalMD (pandocToMarkdown opts document) def{ envVariant = PlainText } def
+
+-- | Convert Pandoc to Commonmark.
+writeCommonMark :: PandocMonad m => WriterOptions -> Pandoc -> m Text
+writeCommonMark opts document =
+ evalMD (pandocToMarkdown opts document) def{ envVariant = Commonmark } def
pandocTitleBlock :: Doc Text -> [Doc Text] -> Doc Text -> Doc Text
pandocTitleBlock tit auths dat =
@@ -187,7 +201,7 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
- isPlain <- asks envPlain
+ variant <- asks envVariant
metadata <- metaToContext'
(blockListToMarkdown opts)
(inlineListToMarkdown opts)
@@ -196,7 +210,7 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
let authors' = fromMaybe [] $ getField "author" metadata
let date' = fromMaybe empty $ getField "date" metadata
let titleblock = case writerTemplate opts of
- Just _ | isPlain ->
+ Just _ | variant == PlainText ->
plainTitleBlock title' authors' date'
| isEnabled Ext_yaml_metadata_block opts ->
yamlMetadataBlock metadata
@@ -422,7 +436,7 @@ blockToMarkdown' opts (Div attrs ils) = do
attrs' = (id',classes',("markdown","1"):kvs')
blockToMarkdown' opts (Plain inlines) = do
-- escape if para starts with ordered list marker
- isPlain <- asks envPlain
+ variant <- asks envVariant
let escapeMarker = T.concatMap $ \x -> if x `elemText` ".()"
then T.pack ['\\', x]
else T.singleton x
@@ -430,17 +444,15 @@ blockToMarkdown' opts (Plain inlines) = do
startsWithSpace (SoftBreak:_) = True
startsWithSpace _ = False
let inlines' =
- if isPlain
+ if variant == PlainText
then inlines
else case inlines of
(Str t:ys)
- | not isPlain
- , (null ys || startsWithSpace ys)
+ | (null ys || startsWithSpace ys)
, beginsWithOrderedListMarker t
-> RawInline (Format "markdown") (escapeMarker t):ys
(Str t:_)
- | not isPlain
- , t == "+" || t == "-" ||
+ | t == "+" || t == "-" ||
(t == "%" && isEnabled Ext_pandoc_title_block opts &&
isEnabled Ext_all_symbols_escapable opts)
-> RawInline (Format "markdown") "\\" : inlines
@@ -465,16 +477,16 @@ blockToMarkdown' opts (LineBlock lns) =
return $ (vcat $ map (hang 2 (literal "| ")) mdLines) <> blankline
else blockToMarkdown opts $ linesToPara lns
blockToMarkdown' opts b@(RawBlock f str) = do
- plain <- asks envPlain
+ variant <- asks envVariant
let Format fmt = f
let rawAttribBlock = return $
(literal "```{=" <> literal fmt <> "}") $$
literal str $$
(literal "```" <> literal "\n")
let renderEmpty = mempty <$ report (BlockNotRendered b)
- case () of
- _ | plain -> renderEmpty
- | isEnabled Ext_raw_attribute opts -> rawAttribBlock
+ case variant of
+ PlainText -> renderEmpty
+ _ | isEnabled Ext_raw_attribute opts -> rawAttribBlock
| f `elem` ["markdown", "markdown_github", "markdown_phpextra",
"markdown_mmd", "markdown_strict"] ->
return $ literal str <> literal "\n"
@@ -503,7 +515,7 @@ blockToMarkdown' opts (Header level attr inlines) = do
then notesAndRefs opts
else return empty
- plain <- asks envPlain
+ variant <- asks envVariant
-- we calculate the id that would be used by auto_identifiers
-- so we know whether to print an explicit identifier
ids <- gets stIds
@@ -521,19 +533,20 @@ blockToMarkdown' opts (Header level attr inlines) = do
contents <- inlineListToMarkdown opts $
-- ensure no newlines; see #3736
walk lineBreakToSpace $
- if level == 1 && plain && isEnabled Ext_gutenberg opts
- then capitalize inlines
- else inlines
+ if level == 1 && variant == PlainText &&
+ isEnabled Ext_gutenberg opts
+ then capitalize inlines
+ else inlines
let setext = writerSetextHeaders opts
hdr = nowrap $ case level of
- 1 | plain ->
+ 1 | variant == PlainText ->
if isEnabled Ext_gutenberg opts
then blanklines 3 <> contents <> blanklines 2
else contents <> blankline
| setext ->
contents <> attr' <> cr <> literal (T.replicate (offset contents) "=") <>
blankline
- 2 | plain ->
+ 2 | variant == PlainText ->
if isEnabled Ext_gutenberg opts
then blanklines 2 <> contents <> blankline
else contents <> blankline
@@ -541,7 +554,7 @@ blockToMarkdown' opts (Header level attr inlines) = do
contents <> attr' <> cr <> literal (T.replicate (offset contents) "-") <>
blankline
-- ghc interprets '#' characters in column 1 as linenum specifiers.
- _ | plain || isEnabled Ext_literate_haskell opts ->
+ _ | variant == PlainText || isEnabled Ext_literate_haskell opts ->
contents <> blankline
_ -> literal (T.replicate level "#") <> space <> contents <> attr' <> blankline
@@ -571,12 +584,12 @@ blockToMarkdown' opts (CodeBlock attribs str) = return $
(_,(cls:_),_) -> " " <> literal cls
_ -> empty
blockToMarkdown' opts (BlockQuote blocks) = do
- plain <- asks envPlain
+ variant <- asks envVariant
-- if we're writing literate haskell, put a space before the bird tracks
-- so they won't be interpreted as lhs...
let leader = if isEnabled Ext_literate_haskell opts
then " > "
- else if plain then " " else "> "
+ else if variant == PlainText then " " else "> "
contents <- blockListToMarkdown opts blocks
return $ (prefixed leader contents) <> blankline
blockToMarkdown' opts t@(Table _ blkCapt specs thead tbody tfoot) = do
@@ -809,8 +822,8 @@ definitionListItemToMarkdown opts (label, defs) = do
if isEnabled Ext_definition_lists opts
then do
let tabStop = writerTabStop opts
- isPlain <- asks envPlain
- let leader = if isPlain then " " else ": "
+ variant <- asks envVariant
+ let leader = if variant == PlainText then " " else ": "
let sps = case writerTabStop opts - 3 of
n | n > 0 -> literal $ T.replicate n " "
_ -> literal " "
@@ -839,7 +852,7 @@ blockListToMarkdown :: PandocMonad m
-> MD m (Doc Text)
blockListToMarkdown opts blocks = do
inlist <- asks envInList
- isPlain <- asks envPlain
+ variant <- asks envVariant
-- a) insert comment between list and indented code block, or the
-- code block will be treated as a list continuation paragraph
-- b) change Plain to Para unless it's followed by a RawBlock
@@ -873,7 +886,7 @@ blockListToMarkdown opts blocks = do
isListBlock (OrderedList _ _) = True
isListBlock (DefinitionList _) = True
isListBlock _ = False
- commentSep = if isPlain
+ commentSep = if variant == PlainText
then Null
else if isEnabled Ext_raw_html opts
then RawBlock "html" "<!-- -->\n"
@@ -1025,11 +1038,11 @@ inlineToMarkdown opts (Span ("",["emoji"],kvs) [Str s]) =
return $ ":" <> literal emojiname <> ":"
_ -> inlineToMarkdown opts (Str s)
inlineToMarkdown opts (Span attrs ils) = do
- plain <- asks envPlain
+ variant <- asks envVariant
contents <- inlineListToMarkdown opts ils
- return $ case plain of
- True -> contents
- False | attrs == nullAttr -> contents
+ return $ case variant of
+ PlainText -> contents
+ _ | attrs == nullAttr -> contents
| isEnabled Ext_bracketed_spans opts ->
let attrs' = if attrs /= nullAttr
then attrsToMarkdown attrs
@@ -1041,20 +1054,20 @@ inlineToMarkdown opts (Span attrs ils) = do
| otherwise -> contents
inlineToMarkdown _ (Emph []) = return empty
inlineToMarkdown opts (Emph lst) = do
- plain <- asks envPlain
+ variant <- asks envVariant
contents <- inlineListToMarkdown opts lst
- return $ if plain
- then if isEnabled Ext_gutenberg opts
- then "_" <> contents <> "_"
- else contents
- else "*" <> contents <> "*"
+ return $ case variant of
+ PlainText
+ | isEnabled Ext_gutenberg opts -> "_" <> contents <> "_"
+ | otherwise -> contents
+ _ -> "*" <> contents <> "*"
inlineToMarkdown _ (Underline []) = return empty
inlineToMarkdown opts (Underline lst) = do
- plain <- asks envPlain
+ variant <- asks envVariant
contents <- inlineListToMarkdown opts lst
- case plain of
- True -> return contents
- False | isEnabled Ext_bracketed_spans opts ->
+ case variant of
+ PlainText -> return contents
+ _ | isEnabled Ext_bracketed_spans opts ->
return $ "[" <> contents <> "]" <> "{.ul}"
| isEnabled Ext_native_spans opts ->
return $ tagWithAttrs "span" ("", ["underline"], [])
@@ -1065,13 +1078,14 @@ inlineToMarkdown opts (Underline lst) = do
| otherwise -> inlineToMarkdown opts (Emph lst)
inlineToMarkdown _ (Strong []) = return empty
inlineToMarkdown opts (Strong lst) = do
- plain <- asks envPlain
- if plain
- then inlineListToMarkdown opts $
- if isEnabled Ext_gutenberg opts
- then capitalize lst
- else lst
- else do
+ variant <- asks envVariant
+ case variant of
+ PlainText ->
+ inlineListToMarkdown opts $
+ if isEnabled Ext_gutenberg opts
+ then capitalize lst
+ else lst
+ _ -> do
contents <- inlineListToMarkdown opts lst
return $ "**" <> contents <> "**"
inlineToMarkdown _ (Strikeout []) = return empty
@@ -1084,7 +1098,7 @@ inlineToMarkdown opts (Strikeout lst) = do
else contents
inlineToMarkdown _ (Superscript []) = return empty
inlineToMarkdown opts (Superscript lst) =
- local (\env -> env {envEscapeSpaces = True}) $ do
+ local (\env -> env {envEscapeSpaces = (envVariant env == Markdown)}) $ do
contents <- inlineListToMarkdown opts lst
if isEnabled Ext_superscript opts
then return $ "^" <> contents <> "^"
@@ -1102,7 +1116,7 @@ inlineToMarkdown opts (Superscript lst) =
Nothing -> literal $ "^(" <> rendered <> ")"
inlineToMarkdown _ (Subscript []) = return empty
inlineToMarkdown opts (Subscript lst) =
- local (\env -> env {envEscapeSpaces = True}) $ do
+ local (\env -> env {envEscapeSpaces = (envVariant env == Markdown)}) $ do
contents <- inlineListToMarkdown opts lst
if isEnabled Ext_subscript opts
then return $ "~" <> contents <> "~"
@@ -1119,8 +1133,8 @@ inlineToMarkdown opts (Subscript lst) =
Just r -> literal $ T.pack r
Nothing -> literal $ "_(" <> rendered <> ")"
inlineToMarkdown opts (SmallCaps lst) = do
- plain <- asks envPlain
- if not plain &&
+ variant <- asks envVariant
+ if variant /= PlainText &&
(isEnabled Ext_raw_html opts || isEnabled Ext_native_spans opts)
then inlineToMarkdown opts (Span ("",["smallcaps"],[]) lst)
else inlineListToMarkdown opts $ capitalize lst
@@ -1150,16 +1164,17 @@ inlineToMarkdown opts (Code attr str) = do
let attrs = if isEnabled Ext_inline_code_attributes opts && attr /= nullAttr
then attrsToMarkdown attr
else empty
- plain <- asks envPlain
- if plain
- then return $ literal str
- else return $ literal (marker <> spacer <> str <> spacer <> marker) <> attrs
+ variant <- asks envVariant
+ case variant of
+ PlainText -> return $ literal str
+ _ -> return $ literal
+ (marker <> spacer <> str <> spacer <> marker) <> attrs
inlineToMarkdown opts (Str str) = do
- isPlain <- asks envPlain
+ variant <- asks envVariant
let str' = (if isEnabled Ext_smart opts
then unsmartify opts
else id) $
- if isPlain
+ if variant == PlainText
then str
else escapeText opts str
return $ literal str'
@@ -1174,10 +1189,10 @@ inlineToMarkdown opts (Math InlineMath str) =
| isEnabled Ext_tex_math_double_backslash opts ->
return $ "\\\\(" <> literal str <> "\\\\)"
| otherwise -> do
- plain <- asks envPlain
+ variant <- asks envVariant
texMathToInlines InlineMath str >>=
inlineListToMarkdown opts .
- (if plain then makeMathPlainer else id)
+ (if variant == PlainText then makeMathPlainer else id)
inlineToMarkdown opts (Math DisplayMath str) =
case writerHTMLMathMethod opts of
WebTeX url -> (\x -> blankline <> x <> blankline) `fmap`
@@ -1196,15 +1211,15 @@ inlineToMarkdown opts il@(RawInline f str) = do
let numticks = if null tickGroups
then 1
else 1 + maximum (map T.length tickGroups)
- plain <- asks envPlain
+ variant <- asks envVariant
let Format fmt = f
let rawAttribInline = return $
literal (T.replicate numticks "`") <> literal str <>
literal (T.replicate numticks "`") <> literal "{=" <> literal fmt <> literal "}"
let renderEmpty = mempty <$ report (InlineNotRendered il)
- case () of
- _ | plain -> renderEmpty
- | f `elem` ["markdown", "markdown_github", "markdown_phpextra",
+ case variant of
+ PlainText -> renderEmpty
+ _ | f `elem` ["markdown", "markdown_github", "markdown_phpextra",
"markdown_mmd", "markdown_strict"] ->
return $ literal str
| isEnabled Ext_raw_attribute opts -> rawAttribInline
@@ -1220,8 +1235,8 @@ inlineToMarkdown opts il@(RawInline f str) = do
| otherwise -> renderEmpty
| otherwise -> renderEmpty
inlineToMarkdown opts LineBreak = do
- plain <- asks envPlain
- if plain || isEnabled Ext_hard_line_breaks opts
+ variant <- asks envVariant
+ if variant == PlainText || isEnabled Ext_hard_line_breaks opts
then return cr
else return $
if isEnabled Ext_escaped_line_breaks opts
@@ -1274,7 +1289,7 @@ inlineToMarkdown opts lnk@(Link attr txt (src, tit))
(literal . T.strip) <$>
writeHtml5String opts{ writerTemplate = Nothing } (Pandoc nullMeta [Plain [lnk]])
| otherwise = do
- plain <- asks envPlain
+ variant <- asks envVariant
linktext <- inlineListToMarkdown opts txt
let linktitle = if T.null tit
then empty
@@ -1292,9 +1307,9 @@ inlineToMarkdown opts lnk@(Link attr txt (src, tit))
then literal <$> getReference attr linktext (src, tit)
else return mempty
return $ if useAuto
- then if plain
- then literal srcSuffix
- else "<" <> literal srcSuffix <> ">"
+ then case variant of
+ PlainText -> literal srcSuffix
+ _ -> "<" <> literal srcSuffix <> ">"
else if useRefLinks
then let first = "[" <> linktext <> "]"
second = if getKey linktext == getKey reftext
@@ -1303,9 +1318,9 @@ inlineToMarkdown opts lnk@(Link attr txt (src, tit))
else "[]"
else "[" <> reftext <> "]"
in first <> second
- else if plain
- then linktext
- else "[" <> linktext <> "](" <>
+ else case variant of
+ PlainText -> linktext
+ _ -> "[" <> linktext <> "](" <>
literal src <> linktitle <> ")" <>
linkAttributes opts attr
inlineToMarkdown opts img@(Image attr alternate (source, tit))
@@ -1315,15 +1330,15 @@ inlineToMarkdown opts img@(Image attr alternate (source, tit))
(literal . T.strip) <$>
writeHtml5String opts{ writerTemplate = Nothing } (Pandoc nullMeta [Plain [img]])
| otherwise = do
- plain <- asks envPlain
+ variant <- asks envVariant
let txt = if null alternate || alternate == [Str source]
-- to prevent autolinks
then [Str ""]
else alternate
linkPart <- inlineToMarkdown opts (Link attr txt (source, tit))
- return $ if plain
- then "[" <> linkPart <> "]"
- else "!" <> linkPart
+ return $ case variant of
+ PlainText -> "[" <> linkPart <> "]"
+ _ -> "!" <> linkPart
inlineToMarkdown opts (Note contents) = do
modify (\st -> st{ stNotes = contents : stNotes st })
st <- get
--
cgit v1.2.3