diff options
| -rw-r--r-- | MANUAL.txt | 3 | ||||
| -rw-r--r-- | cabal.project | 4 | ||||
| -rw-r--r-- | pandoc.cabal | 1 | ||||
| -rw-r--r-- | src/Text/Pandoc/Extensions.hs | 1 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/CommonMark.hs | 350 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Markdown.hs | 175 | ||||
| -rw-r--r-- | stack.yaml | 10 | ||||
| -rw-r--r-- | test/command/3734.md | 2 | ||||
| -rw-r--r-- | test/command/4038.md | 2 | ||||
| -rw-r--r-- | test/command/4528.md | 2 | ||||
| -rw-r--r-- | test/command/gfm.md | 8 |
11 files changed, 118 insertions, 440 deletions
diff --git a/MANUAL.txt b/MANUAL.txt index 973590945..7ed69b09d 100644 --- a/MANUAL.txt +++ b/MANUAL.txt @@ -5164,7 +5164,8 @@ can, however, all be individually disabled. Also, `raw_tex` only affects `gfm` output, not input. `gfm` (GitHub-Flavored Markdown) -: `pipe_tables`, `raw_html`, `fenced_code_blocks`, `auto_identifiers`, +: `pipe_tables`, `raw_html`, `native_divs`, + `fenced_code_blocks`, `auto_identifiers`, `gfm_auto_identifiers`, `backtick_code_blocks`, `autolink_bare_uris`, `space_in_atx_header`, `intraword_underscores`, `strikeout`, `task_lists`, `emoji`, diff --git a/cabal.project b/cabal.project index 8010bc697..bcb43b0d4 100644 --- a/cabal.project +++ b/cabal.project @@ -13,3 +13,7 @@ source-repository-package location: https://github.com/jgm/pandoc-citeproc tag: 0.17.0.1 + source-repository-package + type: git + location: https://github.com/jgm/commonmark-hs + tag: 8d4442abc443ce0100cc87af797e7df9a72b9b9a diff --git a/pandoc.cabal b/pandoc.cabal index 6be465c45..90b41c593 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -425,7 +425,6 @@ library commonmark-pandoc >= 0.1, commonmark >= 0.1, commonmark-extensions >= 0.1, - cmark-gfm >= 0.2.0, network-uri >= 2.6 && < 2.7, network >= 2.6, connection >= 0.3.1, 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 diff --git a/stack.yaml b/stack.yaml index 28f96b773..101dd80be 100644 --- a/stack.yaml +++ b/stack.yaml @@ -28,8 +28,14 @@ extra-deps: - HsYAML-aeson-0.2.0.0 - doctemplates-0.8.2 - commonmark-0.1.0.0 -- commonmark-extensions-0.1.0.0 -- commonmark-pandoc-0.1.0.0 +#- commonmark-extensions-0.1.0.0 +#- commonmark-pandoc-0.1.0.0 +- git: https://github.com/jgm/commonmark-hs + commit: 8d4442abc443ce0100cc87af797e7df9a72b9b9a + subdirs: + - commonmark-extensions + - commonmark-pandoc + ghc-options: "$locals": -fhide-source-paths -Wno-missing-home-modules resolver: lts-14.6 diff --git a/test/command/3734.md b/test/command/3734.md index 7549fb053..f65b1cfd3 100644 --- a/test/command/3734.md +++ b/test/command/3734.md @@ -27,6 +27,6 @@ | aaaaaaaaaaaa | | cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc | ^D | aaaaaaaaaaaa | bbbbb | ccccccccccc | -| ------------ | ----- | ------------------------------------------------------------------------ | +|--------------|-------|--------------------------------------------------------------------------| | aaaaaaaaaaaa | | cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc | ``` diff --git a/test/command/4038.md b/test/command/4038.md index 121760540..b5e6323df 100644 --- a/test/command/4038.md +++ b/test/command/4038.md @@ -1,5 +1,5 @@ ``` -% pandoc -f gfm -t gfm +% pandoc -f gfm -t gfm --atx-headers # ~~Header~~ ^D # ~~Header~~ diff --git a/test/command/4528.md b/test/command/4528.md index a60f6decf..a34af33c5 100644 --- a/test/command/4528.md +++ b/test/command/4528.md @@ -124,7 +124,7 @@ This has ^superscript^ in it and ^2^ again. % pandoc --wrap=none -f html -t commonmark-raw_html This has <sub>subscript</sub> in it and <sub>2 3</sub> again. With emphasis: <sub><em>2</em> 3</sub>. With letters: <sub>foo</sub>. With a span: <sub><span class=foo>2</span></sub>. ^D -This has \_(subscript) in it and ₂ ₃ again. With emphasis: \_(*2* 3). With letters: \_(foo). With a span: ₂. +This has _(subscript) in it and ₂ ₃ again. With emphasis: _(*2* 3). With letters: _(foo). With a span: ₂. ``` ``` diff --git a/test/command/gfm.md b/test/command/gfm.md index ef200fc48..f1bce1b89 100644 --- a/test/command/gfm.md +++ b/test/command/gfm.md @@ -69,7 +69,7 @@ My:thumbsup:emoji:heart: % pandoc -f gfm+smart -t native "hi" ^D -[Para [Str "\8220hi\8221"]] +[Para [Quoted DoubleQuote [Str "hi"]]] ``` ``` @@ -100,7 +100,7 @@ My:thumbsup:emoji:heart: [])] ^D | Fruit | Price | -| ------ | ----: | +|--------|------:| | apple | 0.13 | | orange | 1.12 | @@ -161,6 +161,6 @@ hi - [ ] foo - [x] bar ^D - - [ ] foo - - [x] bar +- [ ] foo +- [x] bar ``` |