54fe3f7 · typeable/pandoc

git.iko.soy/typeable/pandoc

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.

commit54fe3f766f5f4351e792d069b9d4c6022bfb2e14 authorJohn MacFarlane <jgm@berkeley.edu> dateSat 18 Jul 2020, 15:17 (6 years ago) parent8264300

11 files changed+118−440

compare with master

unifiedsplit

MANUAL.txt+2−1 cabal.project+4 pandoc.cabal−1 src/Text/Pandoc/Extensions.hs+1 src/Text/Pandoc/Writers/CommonMark.hs+1−349 src/Text/Pandoc/Writers/Markdown.hs+95−80 stack.yaml+8−2 test/command/3734.md+1−1 test/command/4038.md+1−1 test/command/4528.md+1−1 test/command/gfm.md+4−4

MANUAL.txt+2−1

@@ -5164,7 +5164,8 @@ can, however, all be individually disabled. Also, `raw_tex`

51645164only affects `gfm` output, not input.

51655165

51665166`gfm` (GitHub-Flavored Markdown)

5167−: `pipe_tables`, `raw_html`, `fenced_code_blocks`, `auto_identifiers`,

5167+: `pipe_tables`, `raw_html`, `native_divs`,

5168+ `fenced_code_blocks`, `auto_identifiers`,

51685169 `gfm_auto_identifiers`, `backtick_code_blocks`,

51695170 `autolink_bare_uris`, `space_in_atx_header`,

51705171 `intraword_underscores`, `strikeout`, `task_lists`, `emoji`,

cabal.project+4

@@ -13,3 +13,7 @@ source-repository-package

1313 location: https://github.com/jgm/pandoc-citeproc

1414 tag: 0.17.0.1

1515

16+ source-repository-package

17+ type: git

18+ location: https://github.com/jgm/commonmark-hs

19+ tag: 8d4442abc443ce0100cc87af797e7df9a72b9b9a

pandoc.cabal−1

@@ -425,7 +425,6 @@ library

425425 commonmark-pandoc >= 0.1,

426426 commonmark >= 0.1,

427427 commonmark-extensions >= 0.1,

428− cmark-gfm >= 0.2.0,

429428 network-uri >= 2.6 && < 2.7,

430429 network >= 2.6,

431430 connection >= 0.3.1,

src/Text/Pandoc/Extensions.hs+1

@@ -245,6 +245,7 @@ githubMarkdownExtensions :: Extensions

245245githubMarkdownExtensions = extensionsFromList

246246 [ Ext_pipe_tables

247247 , Ext_raw_html

248+ , Ext_native_divs

248249 , Ext_auto_identifiers

249250 , Ext_gfm_auto_identifiers

250251 , Ext_autolink_bare_uris

src/Text/Pandoc/Writers/CommonMark.hs+1−349

@@ -15,353 +15,5 @@ CommonMark: <http://commonmark.org>

1515-}

1616module Text.Pandoc.Writers.CommonMark (writeCommonMark) where

1717

18−import CMarkGFM

19−import Control.Monad.State.Strict (State, get, modify, runState)

20−import Data.Char (isAscii)

21−import Data.Foldable (foldrM)

22−import Data.List (transpose)

23−import Data.Text (Text)

24−import qualified Data.Text as T

25−import Network.HTTP (urlEncode)

26−import Text.Pandoc.Class.PandocMonad (PandocMonad)

27−import Text.Pandoc.Definition

28−import Text.Pandoc.Options

29−import Text.Pandoc.Shared (capitalize, isTightList,

30− linesToPara, onlySimpleTableCells, taskListItemToAscii, tshow)

31−import Text.Pandoc.Templates (renderTemplate)

32−import Text.Pandoc.Walk (walk, walkM)

33−import Text.Pandoc.Writers.HTML (writeHtml5String, tagWithAttributes)

34−import Text.Pandoc.Writers.Shared

35−import Text.Pandoc.XML (toHtml5Entities)

36−import Text.DocLayout (literal, render)

18+import Text.Pandoc.Writers.Markdown (writeCommonMark)

3719

38−-- | Convert Pandoc to CommonMark.

39−writeCommonMark :: PandocMonad m => WriterOptions -> Pandoc -> m Text

40−writeCommonMark opts (Pandoc meta blocks) = do

41− toc <- if writerTableOfContents opts

42− then blocksToCommonMark opts [ toTableOfContents opts blocks ]

43− else return mempty

44−

45− let (blocks', notes) = runState (walkM processNotes blocks) []

46− notes' = [OrderedList (1, Decimal, Period) $ reverse notes | not (null notes)]

47− main <- blocksToCommonMark opts (blocks' ++ notes')

48− metadata <- metaToContext opts

49− (fmap (literal . T.stripEnd) . blocksToCommonMark opts)

50− (fmap (literal . T.stripEnd) . inlinesToCommonMark opts)

51− meta

52− let context =

53− -- for backwards compatibility we populate toc

54− -- with the contents of the toc, rather than a boolean:

55− defField "toc" toc

56− $ defField "table-of-contents" toc

57− $ defField "body" main metadata

58− return $

59− case writerTemplate opts of

60− Nothing -> main

61− Just tpl -> render Nothing $ renderTemplate tpl context

62−

63−softBreakToSpace :: Inline -> Inline

64−softBreakToSpace SoftBreak = Space

65−softBreakToSpace x = x

66−

67−processNotes :: Inline -> State [[Block]] Inline

68−processNotes (Note bs) = do

69− modify (bs :)

70− notes <- get

71− return $ Str $ "[" <> tshow (length notes) <> "]"

72−processNotes x = return x

73−

74−node :: NodeType -> [Node] -> Node

75−node = Node Nothing

76−

77−blocksToCommonMark :: PandocMonad m => WriterOptions -> [Block] -> m Text

78−blocksToCommonMark opts bs = do

79− let cmarkOpts = [optHardBreaks | isEnabled Ext_hard_line_breaks opts]

80− colwidth = if writerWrapText opts == WrapAuto

81− then Just $ writerColumns opts

82− else Nothing

83− nodes <- blocksToNodes opts bs

84− return $ T.stripEnd $

85− nodeToCommonmark cmarkOpts colwidth $

86− node DOCUMENT nodes

87−

88−inlinesToCommonMark :: PandocMonad m => WriterOptions -> [Inline] -> m Text

89−inlinesToCommonMark opts ils = return $

90− nodeToCommonmark cmarkOpts colwidth $

91− node PARAGRAPH (inlinesToNodes opts ils)

92− where cmarkOpts = [optHardBreaks | isEnabled Ext_hard_line_breaks opts]

93− colwidth = if writerWrapText opts == WrapAuto

94− then Just $ writerColumns opts

95− else Nothing

96−

97−blocksToNodes :: PandocMonad m => WriterOptions -> [Block] -> m [Node]

98−blocksToNodes opts = foldrM (blockToNodes opts) []

99−

100−blockToNodes :: PandocMonad m => WriterOptions -> Block -> [Node] -> m [Node]

101−blockToNodes opts (Plain xs) ns =

102− return (node PARAGRAPH (inlinesToNodes opts xs) : ns)

103−blockToNodes opts (Para xs) ns =

104− return (node PARAGRAPH (inlinesToNodes opts xs) : ns)

105−blockToNodes opts (LineBlock lns) ns = blockToNodes opts (linesToPara lns) ns

106−blockToNodes _ (CodeBlock (_,classes,_) xs) ns = return

107− (node (CODE_BLOCK (T.unwords classes) xs) [] : ns)

108−blockToNodes opts (RawBlock (Format f) xs) ns

109− | f == "html" && isEnabled Ext_raw_html opts

110− = return (node (HTML_BLOCK xs) [] : ns)

111− | (f == "latex" || f == "tex") && isEnabled Ext_raw_tex opts

112− = return (node (CUSTOM_BLOCK xs T.empty) [] : ns)

113− | f == "markdown"

114− = return (node (CUSTOM_BLOCK xs T.empty) [] : ns)

115− | otherwise = return ns

116−blockToNodes opts (BlockQuote bs) ns = do

117− nodes <- blocksToNodes opts bs

118− return (node BLOCK_QUOTE nodes : ns)

119−blockToNodes opts (BulletList items) ns = do

120− let exts = writerExtensions opts

121− nodes <- mapM (blocksToNodes opts . taskListItemToAscii exts) items

122− return (node (LIST ListAttributes{

123− listType = BULLET_LIST,

124− listDelim = PERIOD_DELIM,

125− listTight = isTightList items,

126− listStart = 1 }) (map (node ITEM) nodes) : ns)

127−blockToNodes opts (OrderedList (start, _sty, delim) items) ns = do

128− let exts = writerExtensions opts

129− nodes <- mapM (blocksToNodes opts . taskListItemToAscii exts) items

130− return (node (LIST ListAttributes{

131− listType = ORDERED_LIST,

132− listDelim = case delim of

133− OneParen -> PAREN_DELIM

134− TwoParens -> PAREN_DELIM

135− _ -> PERIOD_DELIM,

136− listTight = isTightList items,

137− listStart = start }) (map (node ITEM) nodes) : ns)

138−blockToNodes _ HorizontalRule ns = return (node THEMATIC_BREAK [] : ns)

139−blockToNodes opts (Header lev _ ils) ns =

140− return (node (HEADING lev) (inlinesToNodes opts ils) : ns)

141−blockToNodes opts (Div attr bs) ns = do

142− nodes <- blocksToNodes opts bs

143− let op = tagWithAttributes opts True False "div" attr

144− if isEnabled Ext_raw_html opts

145− then return (node (HTML_BLOCK op) [] : nodes ++

146− [node (HTML_BLOCK (T.pack "</div>")) []] ++ ns)

147− else return (nodes ++ ns)

148−blockToNodes opts (DefinitionList items) ns =

149− blockToNodes opts (BulletList items') ns

150− where items' = map dlToBullet items

151− dlToBullet (term, (Para xs : ys) : zs) =

152− Para (term ++ [LineBreak] ++ xs) : ys ++ concat zs

153− dlToBullet (term, (Plain xs : ys) : zs) =

154− Plain (term ++ [LineBreak] ++ xs) : ys ++ concat zs

155− dlToBullet (term, xs) =

156− Para term : concat xs

157−blockToNodes opts t@(Table _ blkCapt specs thead tbody tfoot) ns =

158− let (capt, aligns, _widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot

159− in if isEnabled Ext_pipe_tables opts && onlySimpleTableCells (headers : rows)

160− then do

161− -- We construct a table manually as a CUSTOM_BLOCK, for

162− -- two reasons: (1) cmark-gfm currently doesn't support

163− -- rendering TABLE nodes; (2) we can align the column sides;

164− -- (3) we can render the caption as a regular paragraph.

165− let capt' = node PARAGRAPH (inlinesToNodes opts capt)

166− -- backslash | in code and raw:

167− let fixPipe (Code attr xs) =

168− Code attr (T.replace "|" "\\|" xs)

169− fixPipe (RawInline format xs) =

170− RawInline format (T.replace "|" "\\|" xs)

171− fixPipe x = x

172− let toCell [Plain ils] = T.strip

173− $ nodeToCommonmark [] Nothing

174− $ node (CUSTOM_INLINE mempty mempty)

175− $ inlinesToNodes opts

176− $ walk (fixPipe . softBreakToSpace) ils

177− toCell [Para ils] = T.strip

178− $ nodeToCommonmark [] Nothing

179− $ node (CUSTOM_INLINE mempty mempty)

180− $ inlinesToNodes opts

181− $ walk (fixPipe . softBreakToSpace) ils

182− toCell [] = ""

183− toCell xs = error $ "toCell encountered " ++ show xs

184− let separator = " | "

185− let starter = "| "

186− let ender = " |"

187− let rawheaders = map toCell headers

188− let rawrows = map (map toCell) rows

189− let maximum' [] = 0

190− maximum' xs = maximum xs

191− let colwidths = map (maximum' . map T.length) $

192− transpose (rawheaders:rawrows)

193− let toHeaderLine len AlignDefault = T.replicate len "-"

194− toHeaderLine len AlignLeft = ":" <>

195− T.replicate (max (len - 1) 1) "-"

196− toHeaderLine len AlignRight =

197− T.replicate (max (len - 1) 1) "-" <> ":"

198− toHeaderLine len AlignCenter = ":" <>

199− T.replicate (max (len - 2) 1) (T.pack "-") <> ":"

200− let rawheaderlines = zipWith toHeaderLine colwidths aligns

201− let headerlines = starter <> T.intercalate separator rawheaderlines <>

202− ender

203− let padContent (align, w) t' =

204− let padding = w - T.length t'

205− halfpadding = padding `div` 2

206− in case align of

207− AlignRight -> T.replicate padding " " <> t'

208− AlignCenter -> T.replicate halfpadding " " <> t' <>

209− T.replicate (padding - halfpadding) " "

210− _ -> t' <> T.replicate padding " "

211− let toRow xs = starter <> T.intercalate separator

212− (zipWith padContent (zip aligns colwidths) xs) <>

213− ender

214− let table' = toRow rawheaders <> "\n" <> headerlines <> "\n" <>

215− T.intercalate "\n" (map toRow rawrows)

216− return (node (CUSTOM_BLOCK table' mempty) [] :

217− if null capt

218− then ns

219− else capt' : ns)

220− else do -- fall back to raw HTML

221− s <- writeHtml5String def $! Pandoc nullMeta [t]

222− return (node (HTML_BLOCK s) [] : ns)

223−blockToNodes _ Null ns = return ns

224−

225−inlinesToNodes :: WriterOptions -> [Inline] -> [Node]

226−inlinesToNodes opts = foldr (inlineToNodes opts) []

227−

228−inlineToNodes :: WriterOptions -> Inline -> [Node] -> [Node]

229−inlineToNodes opts (Str s) = stringToNodes opts s'

230− where s' = if isEnabled Ext_smart opts

231− then unsmartify opts s

232− else s

233−inlineToNodes _ Space = (node (TEXT (T.pack " ")) [] :)

234−inlineToNodes _ LineBreak = (node LINEBREAK [] :)

235−inlineToNodes opts SoftBreak

236− | isEnabled Ext_hard_line_breaks opts = (node (TEXT " ") [] :)

237− | writerWrapText opts == WrapNone = (node (TEXT " ") [] :)

238− | otherwise = (node SOFTBREAK [] :)

239−inlineToNodes opts (Emph xs) = (node EMPH (inlinesToNodes opts xs) :)

240−inlineToNodes opts (Underline xs)

241− | isEnabled Ext_raw_html opts =

242− ((node (HTML_INLINE (T.pack "")) [] : inlinesToNodes opts xs ++

243− [node (HTML_INLINE (T.pack "")) []]) ++ )

244− | otherwise = (node EMPH (inlinesToNodes opts xs) :)

245−inlineToNodes opts (Strong xs) = (node STRONG (inlinesToNodes opts xs) :)

246−inlineToNodes opts (Strikeout xs)

247− | isEnabled Ext_strikeout opts = (node (CUSTOM_INLINE "~~" "~~") (inlinesToNodes opts xs) :)

248− | isEnabled Ext_raw_html opts = ((node (HTML_INLINE (T.pack "<s>")) [] : inlinesToNodes opts xs ++

249− [node (HTML_INLINE (T.pack "</s>")) []]) ++ )

250− | otherwise = (inlinesToNodes opts xs ++)

251−inlineToNodes opts (Superscript xs) =

252− if isEnabled Ext_raw_html opts

253− then ((node (HTML_INLINE (T.pack "")) [] : inlinesToNodes opts xs ++

254− [node (HTML_INLINE (T.pack "")) []]) ++ )

255− else case traverse toSuperscriptInline xs of

256− Just xs' | not (writerPreferAscii opts)

257− -> (inlinesToNodes opts xs' ++)

258− _ ->

259− ((node (TEXT (T.pack "^(")) [] : inlinesToNodes opts xs ++

260− [node (TEXT (T.pack ")")) []]) ++ )

261−inlineToNodes opts (Subscript xs) =

262− if isEnabled Ext_raw_html opts

263− then ((node (HTML_INLINE (T.pack "")) [] : inlinesToNodes opts xs ++

264− [node (HTML_INLINE (T.pack "")) []]) ++ )

265− else case traverse toSubscriptInline xs of

266− Just xs' | not (writerPreferAscii opts)

267− -> (inlinesToNodes opts xs' ++)

268− _ ->

269− ((node (TEXT (T.pack "_(")) [] : inlinesToNodes opts xs ++

270− [node (TEXT (T.pack ")")) []]) ++ )

271−inlineToNodes opts (SmallCaps xs) =

272− if isEnabled Ext_raw_html opts

273− then ((node (HTML_INLINE (T.pack "")) []

274− : inlinesToNodes opts xs ++

275− [node (HTML_INLINE (T.pack "")) []]) ++ )

276− else (inlinesToNodes opts (capitalize xs) ++)

277−inlineToNodes opts (Link _ ils (url,tit)) =

278− (node (LINK url tit) (inlinesToNodes opts ils) :)

279−-- title beginning with fig: indicates implicit figure

280−inlineToNodes opts (Image alt ils (url,T.stripPrefix "fig:" -> Just tit)) =

281− inlineToNodes opts (Image alt ils (url,tit))

282−inlineToNodes opts (Image _ ils (url,tit)) =

283− (node (IMAGE url tit) (inlinesToNodes opts ils) :)

284−inlineToNodes opts (RawInline (Format f) xs)

285− | f == "html" && isEnabled Ext_raw_html opts

286− = (node (HTML_INLINE xs) [] :)

287− | (f == "latex" || f == "tex") && isEnabled Ext_raw_tex opts

288− = (node (CUSTOM_INLINE xs T.empty) [] :)

289− | f == "markdown"

290− = (node (CUSTOM_INLINE xs T.empty) [] :)

291− | otherwise = id

292−inlineToNodes opts (Quoted qt ils) =

293− ((node (HTML_INLINE start) [] :

294− inlinesToNodes opts ils ++ [node (HTML_INLINE end) []]) ++)

295− where (start, end) = case qt of

296− SingleQuote

297− | isEnabled Ext_smart opts -> ("'","'")

298− | writerPreferAscii opts ->

299− ("‘", "’")

300− | otherwise -> ("‘", "’")

301− DoubleQuote

302− | isEnabled Ext_smart opts -> ("\"", "\"")

303− | writerPreferAscii opts ->

304− ("“", "”")

305− | otherwise -> ("“", "”")

306−inlineToNodes _ (Code _ str) = (node (CODE str) [] :)

307−inlineToNodes opts (Math mt str) =

308− case writerHTMLMathMethod opts of

309− WebTeX url ->

310− let core = inlineToNodes opts

311− (Image nullAttr [Str str] (url <> T.pack (urlEncode $ T.unpack str), str))

312− sep = if mt == DisplayMath

313− then (node LINEBREAK [] :)

314− else id

315− in (sep . core . sep)

316− _ ->

317− case mt of

318− InlineMath ->

319− (node (HTML_INLINE ("\$" <> str <> "\$")) [] :)

320− DisplayMath ->

321− (node (HTML_INLINE ("\\[" <> str <> "\\]")) [] :)

322−inlineToNodes opts (Span ("",["emoji"],kvs) [Str s]) =

323− case lookup "data-emoji" kvs of

324− Just emojiname | isEnabled Ext_emoji opts ->

325− (node (TEXT (":" <> emojiname <> ":")) [] :)

326− _ -> (node (TEXT s) [] :)

327−inlineToNodes opts (Span attr ils) =

328− let nodes = inlinesToNodes opts ils

329− op = tagWithAttributes opts True False "span" attr

330− in if isEnabled Ext_raw_html opts

331− then ((node (HTML_INLINE op) [] : nodes ++

332− [node (HTML_INLINE (T.pack "")) []]) ++)

333− else (nodes ++)

334−inlineToNodes opts (Cite _ ils) = (inlinesToNodes opts ils ++)

335−inlineToNodes _ (Note _) = id -- should not occur

336−-- we remove Note elements in preprocessing

337−

338−stringToNodes :: WriterOptions -> Text -> [Node] -> [Node]

339−stringToNodes opts s

340− | not (writerPreferAscii opts) = (node (TEXT s) [] :)

341− | otherwise = step s

342− where

343− step input =

344− let (ascii, rest) = T.span isAscii input

345− this = node (TEXT ascii) []

346− nodes = case T.uncons rest of

347− Nothing -> id

348− Just (nonAscii, rest') ->

349− let escaped = toHtml5Entities (T.singleton nonAscii)

350− in (node (HTML_INLINE escaped) [] :) . step rest'

351− in (this :) . nodes

352−

353−toSubscriptInline :: Inline -> Maybe Inline

354−toSubscriptInline Space = Just Space

355−toSubscriptInline (Span attr ils) = Span attr <$> traverse toSubscriptInline ils

356−toSubscriptInline (Str s) = Str . T.pack <$> traverse toSubscript (T.unpack s)

357−toSubscriptInline LineBreak = Just LineBreak

358−toSubscriptInline SoftBreak = Just SoftBreak

359−toSubscriptInline _ = Nothing

360−

361−toSuperscriptInline :: Inline -> Maybe Inline

362−toSuperscriptInline Space = Just Space

363−toSuperscriptInline (Span attr ils) = Span attr <$> traverse toSuperscriptInline ils

364−toSuperscriptInline (Str s) = Str . T.pack <$> traverse toSuperscript (T.unpack s)

365−toSuperscriptInline LineBreak = Just LineBreak

366−toSuperscriptInline SoftBreak = Just SoftBreak

367−toSuperscriptInline _ = Nothing

src/Text/Pandoc/Writers/Markdown.hs+95−80

@@ -16,7 +16,10 @@ Conversion of 'Pandoc' documents to markdown-formatted plain text.

1616

1717Markdown: <http://daringfireball.net/projects/markdown/>

1818-}

19−module Text.Pandoc.Writers.Markdown (writeMarkdown, writePlain) where

19+module Text.Pandoc.Writers.Markdown (

20+ writeMarkdown,

21+ writeCommonMark,

22+ writePlain) where

2023import Control.Monad.Reader

2124import Control.Monad.State.Strict

2225import Data.Char (isAlphaNum)

@@ -55,15 +58,21 @@ evalMD :: PandocMonad m => MD m a -> WriterEnv -> WriterState -> m a

5558evalMD md env st = evalStateT (runReaderT md env) st

5659

5760data WriterEnv = WriterEnv { envInList :: Bool

58− , envPlain :: Bool

61+ , envVariant :: MarkdownVariant

5962 , envRefShortcutable :: Bool

6063 , envBlockLevel :: Int

6164 , envEscapeSpaces :: Bool

6265 }

6366

67+data MarkdownVariant =

68+ PlainText

69+ | Commonmark

70+ | Markdown

71+ deriving (Show, Eq)

72+

6473instance Default WriterEnv

65− where def = WriterEnv { envInList = False

66− , envPlain = False

74+ where def = WriterEnv { envInList = False

75+ , envVariant = Markdown

6776 , envRefShortcutable = True

6877 , envBlockLevel = 0

6978 , envEscapeSpaces = False

@@ -102,7 +111,12 @@ writeMarkdown opts document =

102111-- pictures, or inline formatting).

103112writePlain :: PandocMonad m => WriterOptions -> Pandoc -> m Text

104113writePlain opts document =

105− evalMD (pandocToMarkdown opts document) def{ envPlain = True } def

114+ evalMD (pandocToMarkdown opts document) def{ envVariant = PlainText } def

115+

116+-- | Convert Pandoc to Commonmark.

117+writeCommonMark :: PandocMonad m => WriterOptions -> Pandoc -> m Text

118+writeCommonMark opts document =

119+ evalMD (pandocToMarkdown opts document) def{ envVariant = Commonmark } def

106120

107121pandocTitleBlock :: Doc Text -> [Doc Text] -> Doc Text -> Doc Text

108122pandocTitleBlock tit auths dat =

@@ -187,7 +201,7 @@ pandocToMarkdown opts (Pandoc meta blocks) = do

187201 let colwidth = if writerWrapText opts == WrapAuto

188202 then Just $ writerColumns opts

189203 else Nothing

190− isPlain <- asks envPlain

204+ variant <- asks envVariant

191205 metadata <- metaToContext'

192206 (blockListToMarkdown opts)

193207 (inlineListToMarkdown opts)

@@ -196,7 +210,7 @@ pandocToMarkdown opts (Pandoc meta blocks) = do

196210 let authors' = fromMaybe [] $ getField "author" metadata

197211 let date' = fromMaybe empty $ getField "date" metadata

198212 let titleblock = case writerTemplate opts of

199− Just _ | isPlain ->

213+ Just _ | variant == PlainText ->

200214 plainTitleBlock title' authors' date'

201215 | isEnabled Ext_yaml_metadata_block opts ->

202216 yamlMetadataBlock metadata

@@ -422,7 +436,7 @@ blockToMarkdown' opts (Div attrs ils) = do

422436 attrs' = (id',classes',("markdown","1"):kvs')

423437blockToMarkdown' opts (Plain inlines) = do

424438 -- escape if para starts with ordered list marker

425− isPlain <- asks envPlain

439+ variant <- asks envVariant

426440 let escapeMarker = T.concatMap $ \x -> if x `elemText` ".()"

427441 then T.pack ['\\', x]

428442 else T.singleton x

@@ -430,17 +444,15 @@ blockToMarkdown' opts (Plain inlines) = do

430444 startsWithSpace (SoftBreak:_) = True

431445 startsWithSpace _ = False

432446 let inlines' =

433− if isPlain

447+ if variant == PlainText

434448 then inlines

435449 else case inlines of

436450 (Str t:ys)

437− | not isPlain

438− , (null ys || startsWithSpace ys)

451+ | (null ys || startsWithSpace ys)

439452 , beginsWithOrderedListMarker t

440453 -> RawInline (Format "markdown") (escapeMarker t):ys

441454 (Str t:_)

442− | not isPlain

443− , t == "+" || t == "-" ||

455+ | t == "+" || t == "-" ||

444456 (t == "%" && isEnabled Ext_pandoc_title_block opts &&

445457 isEnabled Ext_all_symbols_escapable opts)

446458 -> RawInline (Format "markdown") "\\" : inlines

@@ -465,16 +477,16 @@ blockToMarkdown' opts (LineBlock lns) =

465477 return $ (vcat $ map (hang 2 (literal "| ")) mdLines) <> blankline

466478 else blockToMarkdown opts $ linesToPara lns

467479blockToMarkdown' opts b@(RawBlock f str) = do

468− plain <- asks envPlain

480+ variant <- asks envVariant

469481 let Format fmt = f

470482 let rawAttribBlock = return $

471483 (literal "```{=" <> literal fmt <> "}") $$

472484 literal str $$

473485 (literal "```" <> literal "\n")

474486 let renderEmpty = mempty <$ report (BlockNotRendered b)

475− case () of

476− _ | plain -> renderEmpty

477− | isEnabled Ext_raw_attribute opts -> rawAttribBlock

487+ case variant of

488+ PlainText -> renderEmpty

489+ _ | isEnabled Ext_raw_attribute opts -> rawAttribBlock

478490 | f `elem` ["markdown", "markdown_github", "markdown_phpextra",

479491 "markdown_mmd", "markdown_strict"] ->

480492 return $ literal str <> literal "\n"

@@ -503,7 +515,7 @@ blockToMarkdown' opts (Header level attr inlines) = do

503515 then notesAndRefs opts

504516 else return empty

505517

506− plain <- asks envPlain

518+ variant <- asks envVariant

507519 -- we calculate the id that would be used by auto_identifiers

508520 -- so we know whether to print an explicit identifier

509521 ids <- gets stIds

@@ -521,19 +533,20 @@ blockToMarkdown' opts (Header level attr inlines) = do

521533 contents <- inlineListToMarkdown opts $

522534 -- ensure no newlines; see #3736

523535 walk lineBreakToSpace $

524− if level == 1 && plain && isEnabled Ext_gutenberg opts

525− then capitalize inlines

526− else inlines

536+ if level == 1 && variant == PlainText &&

537+ isEnabled Ext_gutenberg opts

538+ then capitalize inlines

539+ else inlines

527540 let setext = writerSetextHeaders opts

528541 hdr = nowrap $ case level of

529− 1 | plain ->

542+ 1 | variant == PlainText ->

530543 if isEnabled Ext_gutenberg opts

531544 then blanklines 3 <> contents <> blanklines 2

532545 else contents <> blankline

533546 | setext ->

534547 contents <> attr' <> cr <> literal (T.replicate (offset contents) "=") <>

535548 blankline

536− 2 | plain ->

549+ 2 | variant == PlainText ->

537550 if isEnabled Ext_gutenberg opts

538551 then blanklines 2 <> contents <> blankline

539552 else contents <> blankline

@@ -541,7 +554,7 @@ blockToMarkdown' opts (Header level attr inlines) = do

541554 contents <> attr' <> cr <> literal (T.replicate (offset contents) "-") <>

542555 blankline

543556 -- ghc interprets '#' characters in column 1 as linenum specifiers.

544− _ | plain || isEnabled Ext_literate_haskell opts ->

557+ _ | variant == PlainText || isEnabled Ext_literate_haskell opts ->

545558 contents <> blankline

546559 _ -> literal (T.replicate level "#") <> space <> contents <> attr' <> blankline

547560

@@ -571,12 +584,12 @@ blockToMarkdown' opts (CodeBlock attribs str) = return $

571584 (_,(cls:_),_) -> " " <> literal cls

572585 _ -> empty

573586blockToMarkdown' opts (BlockQuote blocks) = do

574− plain <- asks envPlain

587+ variant <- asks envVariant

575588 -- if we're writing literate haskell, put a space before the bird tracks

576589 -- so they won't be interpreted as lhs...

577590 let leader = if isEnabled Ext_literate_haskell opts

578591 then " > "

579− else if plain then " " else "> "

592+ else if variant == PlainText then " " else "> "

580593 contents <- blockListToMarkdown opts blocks

581594 return $ (prefixed leader contents) <> blankline

582595blockToMarkdown' opts t@(Table _ blkCapt specs thead tbody tfoot) = do

@@ -809,8 +822,8 @@ definitionListItemToMarkdown opts (label, defs) = do

809822 if isEnabled Ext_definition_lists opts

810823 then do

811824 let tabStop = writerTabStop opts

812− isPlain <- asks envPlain

813− let leader = if isPlain then " " else ": "

825+ variant <- asks envVariant

826+ let leader = if variant == PlainText then " " else ": "

814827 let sps = case writerTabStop opts - 3 of

815828 n | n > 0 -> literal $ T.replicate n " "

816829 _ -> literal " "

@@ -839,7 +852,7 @@ blockListToMarkdown :: PandocMonad m

839852 -> MD m (Doc Text)

840853blockListToMarkdown opts blocks = do

841854 inlist <- asks envInList

842− isPlain <- asks envPlain

855+ variant <- asks envVariant

843856 -- a) insert comment between list and indented code block, or the

844857 -- code block will be treated as a list continuation paragraph

845858 -- b) change Plain to Para unless it's followed by a RawBlock

@@ -873,7 +886,7 @@ blockListToMarkdown opts blocks = do

873886 isListBlock (OrderedList _ _) = True

874887 isListBlock (DefinitionList _) = True

875888 isListBlock _ = False

876− commentSep = if isPlain

889+ commentSep = if variant == PlainText

877890 then Null

878891 else if isEnabled Ext_raw_html opts

879892 then RawBlock "html" "\n"

@@ -1025,11 +1038,11 @@ inlineToMarkdown opts (Span ("",["emoji"],kvs) [Str s]) =

10251038 return $ ":" <> literal emojiname <> ":"

10261039 _ -> inlineToMarkdown opts (Str s)

10271040inlineToMarkdown opts (Span attrs ils) = do

1028− plain <- asks envPlain

1041+ variant <- asks envVariant

10291042 contents <- inlineListToMarkdown opts ils

1030− return $ case plain of

1031− True -> contents

1032− False | attrs == nullAttr -> contents

1043+ return $ case variant of

1044+ PlainText -> contents

1045+ _ | attrs == nullAttr -> contents

10331046 | isEnabled Ext_bracketed_spans opts ->

10341047 let attrs' = if attrs /= nullAttr

10351048 then attrsToMarkdown attrs

@@ -1041,20 +1054,20 @@ inlineToMarkdown opts (Span attrs ils) = do

10411054 | otherwise -> contents

10421055inlineToMarkdown _ (Emph []) = return empty

10431056inlineToMarkdown opts (Emph lst) = do

1044− plain <- asks envPlain

1057+ variant <- asks envVariant

10451058 contents <- inlineListToMarkdown opts lst

1046− return $ if plain

1047− then if isEnabled Ext_gutenberg opts

1048− then "_" <> contents <> "_"

1049− else contents

1050− else "*" <> contents <> "*"

1059+ return $ case variant of

1060+ PlainText

1061+ | isEnabled Ext_gutenberg opts -> "_" <> contents <> "_"

1062+ | otherwise -> contents

1063+ _ -> "*" <> contents <> "*"

10511064inlineToMarkdown _ (Underline []) = return empty

10521065inlineToMarkdown opts (Underline lst) = do

1053− plain <- asks envPlain

1066+ variant <- asks envVariant

10541067 contents <- inlineListToMarkdown opts lst

1055− case plain of

1056− True -> return contents

1057− False | isEnabled Ext_bracketed_spans opts ->

1068+ case variant of

1069+ PlainText -> return contents

1070+ _ | isEnabled Ext_bracketed_spans opts ->

10581071 return $ "[" <> contents <> "]" <> "{.ul}"

10591072 | isEnabled Ext_native_spans opts ->

10601073 return $ tagWithAttrs "span" ("", ["underline"], [])

@@ -1065,13 +1078,14 @@ inlineToMarkdown opts (Underline lst) = do

10651078 | otherwise -> inlineToMarkdown opts (Emph lst)

10661079inlineToMarkdown _ (Strong []) = return empty

10671080inlineToMarkdown opts (Strong lst) = do

1068− plain <- asks envPlain

1069− if plain

1070− then inlineListToMarkdown opts $

1071− if isEnabled Ext_gutenberg opts

1072− then capitalize lst

1073− else lst

1074− else do

1081+ variant <- asks envVariant

1082+ case variant of

1083+ PlainText ->

1084+ inlineListToMarkdown opts $

1085+ if isEnabled Ext_gutenberg opts

1086+ then capitalize lst

1087+ else lst

1088+ _ -> do

10751089 contents <- inlineListToMarkdown opts lst

10761090 return $ "**" <> contents <> "**"

10771091inlineToMarkdown _ (Strikeout []) = return empty

@@ -1084,7 +1098,7 @@ inlineToMarkdown opts (Strikeout lst) = do

10841098 else contents

10851099inlineToMarkdown _ (Superscript []) = return empty

10861100inlineToMarkdown opts (Superscript lst) =

1087− local (\env -> env {envEscapeSpaces = True}) $ do

1101+ local (\env -> env {envEscapeSpaces = (envVariant env == Markdown)}) $ do

10881102 contents <- inlineListToMarkdown opts lst

10891103 if isEnabled Ext_superscript opts

10901104 then return $ "^" <> contents <> "^"

@@ -1102,7 +1116,7 @@ inlineToMarkdown opts (Superscript lst) =

11021116 Nothing -> literal $ "^(" <> rendered <> ")"

11031117inlineToMarkdown _ (Subscript []) = return empty

11041118inlineToMarkdown opts (Subscript lst) =

1105− local (\env -> env {envEscapeSpaces = True}) $ do

1119+ local (\env -> env {envEscapeSpaces = (envVariant env == Markdown)}) $ do

11061120 contents <- inlineListToMarkdown opts lst

11071121 if isEnabled Ext_subscript opts

11081122 then return $ "~" <> contents <> "~"

@@ -1119,8 +1133,8 @@ inlineToMarkdown opts (Subscript lst) =

11191133 Just r -> literal $ T.pack r

11201134 Nothing -> literal $ "_(" <> rendered <> ")"

11211135inlineToMarkdown opts (SmallCaps lst) = do

1122− plain <- asks envPlain

1123− if not plain &&

1136+ variant <- asks envVariant

1137+ if variant /= PlainText &&

11241138 (isEnabled Ext_raw_html opts || isEnabled Ext_native_spans opts)

11251139 then inlineToMarkdown opts (Span ("",["smallcaps"],[]) lst)

11261140 else inlineListToMarkdown opts $ capitalize lst

@@ -1150,16 +1164,17 @@ inlineToMarkdown opts (Code attr str) = do

11501164 let attrs = if isEnabled Ext_inline_code_attributes opts && attr /= nullAttr

11511165 then attrsToMarkdown attr

11521166 else empty

1153− plain <- asks envPlain

1154− if plain

1155− then return $ literal str

1156− else return $ literal (marker <> spacer <> str <> spacer <> marker) <> attrs

1167+ variant <- asks envVariant

1168+ case variant of

1169+ PlainText -> return $ literal str

1170+ _ -> return $ literal

1171+ (marker <> spacer <> str <> spacer <> marker) <> attrs

11571172inlineToMarkdown opts (Str str) = do

1158− isPlain <- asks envPlain

1173+ variant <- asks envVariant

11591174 let str' = (if isEnabled Ext_smart opts

11601175 then unsmartify opts

11611176 else id) $

1162− if isPlain

1177+ if variant == PlainText

11631178 then str

11641179 else escapeText opts str

11651180 return $ literal str'

@@ -1174,10 +1189,10 @@ inlineToMarkdown opts (Math InlineMath str) =

11741189 | isEnabled Ext_tex_math_double_backslash opts ->

11751190 return $ "\\\$" <> literal str <> "\\\$"

11761191 | otherwise -> do

1177− plain <- asks envPlain

1192+ variant <- asks envVariant

11781193 texMathToInlines InlineMath str >>=

11791194 inlineListToMarkdown opts .

1180− (if plain then makeMathPlainer else id)

1195+ (if variant == PlainText then makeMathPlainer else id)

11811196inlineToMarkdown opts (Math DisplayMath str) =

11821197 case writerHTMLMathMethod opts of

11831198 WebTeX url -> (\x -> blankline <> x <> blankline) `fmap`

@@ -1196,15 +1211,15 @@ inlineToMarkdown opts il@(RawInline f str) = do

11961211 let numticks = if null tickGroups

11971212 then 1

11981213 else 1 + maximum (map T.length tickGroups)

1199− plain <- asks envPlain

1214+ variant <- asks envVariant

12001215 let Format fmt = f

12011216 let rawAttribInline = return $

12021217 literal (T.replicate numticks "`") <> literal str <>

12031218 literal (T.replicate numticks "`") <> literal "{=" <> literal fmt <> literal "}"

12041219 let renderEmpty = mempty <$ report (InlineNotRendered il)

1205− case () of

1206− _ | plain -> renderEmpty

1207− | f `elem` ["markdown", "markdown_github", "markdown_phpextra",

1220+ case variant of

1221+ PlainText -> renderEmpty

1222+ _ | f `elem` ["markdown", "markdown_github", "markdown_phpextra",

12081223 "markdown_mmd", "markdown_strict"] ->

12091224 return $ literal str

12101225 | isEnabled Ext_raw_attribute opts -> rawAttribInline

@@ -1220,8 +1235,8 @@ inlineToMarkdown opts il@(RawInline f str) = do

12201235 | otherwise -> renderEmpty

12211236 | otherwise -> renderEmpty

12221237inlineToMarkdown opts LineBreak = do

1223− plain <- asks envPlain

1224− if plain || isEnabled Ext_hard_line_breaks opts

1238+ variant <- asks envVariant

1239+ if variant == PlainText || isEnabled Ext_hard_line_breaks opts

12251240 then return cr

12261241 else return $

12271242 if isEnabled Ext_escaped_line_breaks opts

@@ -1274,7 +1289,7 @@ inlineToMarkdown opts lnk@(Link attr txt (src, tit))

12741289 (literal . T.strip) <$>

12751290 writeHtml5String opts{ writerTemplate = Nothing } (Pandoc nullMeta [Plain [lnk]])

12761291 | otherwise = do

1277− plain <- asks envPlain

1292+ variant <- asks envVariant

12781293 linktext <- inlineListToMarkdown opts txt

12791294 let linktitle = if T.null tit

12801295 then empty

@@ -1292,9 +1307,9 @@ inlineToMarkdown opts lnk@(Link attr txt (src, tit))

12921307 then literal <$> getReference attr linktext (src, tit)

12931308 else return mempty

12941309 return $ if useAuto

1295− then if plain

1296− then literal srcSuffix

1297− else "<" <> literal srcSuffix <> ">"

1310+ then case variant of

1311+ PlainText -> literal srcSuffix

1312+ _ -> "<" <> literal srcSuffix <> ">"

12981313 else if useRefLinks

12991314 then let first = "[" <> linktext <> "]"

13001315 second = if getKey linktext == getKey reftext

@@ -1303,9 +1318,9 @@ inlineToMarkdown opts lnk@(Link attr txt (src, tit))

13031318 else "[]"

13041319 else "[" <> reftext <> "]"

13051320 in first <> second

1306− else if plain

1307− then linktext

1308− else "[" <> linktext <> "](" <>

1321+ else case variant of

1322+ PlainText -> linktext

1323+ _ -> "[" <> linktext <> "](" <>

13091324 literal src <> linktitle <> ")" <>

13101325 linkAttributes opts attr

13111326inlineToMarkdown opts img@(Image attr alternate (source, tit))

@@ -1315,15 +1330,15 @@ inlineToMarkdown opts img@(Image attr alternate (source, tit))

13151330 (literal . T.strip) <$>

13161331 writeHtml5String opts{ writerTemplate = Nothing } (Pandoc nullMeta [Plain [img]])

13171332 | otherwise = do

1318− plain <- asks envPlain

1333+ variant <- asks envVariant

13191334 let txt = if null alternate || alternate == [Str source]

13201335 -- to prevent autolinks

13211336 then [Str ""]

13221337 else alternate

13231338 linkPart <- inlineToMarkdown opts (Link attr txt (source, tit))

1324− return $ if plain

1325− then "[" <> linkPart <> "]"

1326− else "!" <> linkPart

1339+ return $ case variant of

1340+ PlainText -> "[" <> linkPart <> "]"

1341+ _ -> "!" <> linkPart

13271342inlineToMarkdown opts (Note contents) = do

13281343 modify (\st -> st{ stNotes = contents : stNotes st })

13291344 st <- get

stack.yaml+8−2

@@ -28,8 +28,14 @@ extra-deps:

2828- HsYAML-aeson-0.2.0.0

2929- doctemplates-0.8.2

3030- commonmark-0.1.0.0

31−- commonmark-extensions-0.1.0.0

32−- commonmark-pandoc-0.1.0.0

31+#- commonmark-extensions-0.1.0.0

32+#- commonmark-pandoc-0.1.0.0

33+- git: https://github.com/jgm/commonmark-hs

34+ commit: 8d4442abc443ce0100cc87af797e7df9a72b9b9a

35+ subdirs:

36+ - commonmark-extensions

37+ - commonmark-pandoc

38+

3339ghc-options:

3440 "$locals": -fhide-source-paths -Wno-missing-home-modules

3541resolver: lts-14.6

test/command/3734.md+1−1

@@ -27,6 +27,6 @@

2727| aaaaaaaaaaaa | | cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc |

2828^D

2929| aaaaaaaaaaaa | bbbbb | ccccccccccc |

30−| ------------ | ----- | ------------------------------------------------------------------------ |

30+|--------------|-------|--------------------------------------------------------------------------|

3131| aaaaaaaaaaaa | | cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc |

3232```

test/command/4038.md+1−1

@@ -1,5 +1,5 @@

11```

2−% pandoc -f gfm -t gfm

2+% pandoc -f gfm -t gfm --atx-headers

33# ~~Header~~

44^D

55# ~~Header~~

test/command/4528.md+1−1

@@ -124,7 +124,7 @@ This has ^superscript^ in it and ^2^ again.

124124% pandoc --wrap=none -f html -t commonmark-raw_html

125125This has subscript in it and 2 3 again. With emphasis: 2 3. With letters: foo. With a span: 2.

126126^D

127−This has \_(subscript) in it and ₂ ₃ again. With emphasis: \_(*2* 3). With letters: \_(foo). With a span: ₂.

127+This has _(subscript) in it and ₂ ₃ again. With emphasis: _(*2* 3). With letters: _(foo). With a span: ₂.

128128```

129129

130130```

test/command/gfm.md+4−4

@@ -69,7 +69,7 @@ My:thumbsup:emoji:heart:

6969% pandoc -f gfm+smart -t native

7070"hi"

7171^D

72−[Para [Str "\8220hi\8221"]]

72+[Para [Quoted DoubleQuote [Str "hi"]]]

7373```

7474

7575```

@@ -100,7 +100,7 @@ My:thumbsup:emoji:heart:

100100 [])]

101101^D

102102| Fruit | Price |

103−| ------ | ----: |

103+|--------|------:|

104104| apple | 0.13 |

105105| orange | 1.12 |

106106

@@ -161,6 +161,6 @@ hi

161161- [ ] foo

162162- [x] bar

163163^D

164− - [ ] foo

165− - [x] bar

164+- [ ] foo

165+- [x] bar

166166```