CommonMark writer: support table, strikethrough extensions...
when enabled (as with gfm). Note: because of limitations in cmark-gfm, which will hopefully soon be corrected, this currently gives an error on Tables. Also properly support `--wrap=none`.
This commit is contained in:
John MacFarlane
parent
c95cc813cc
commit
56a680c305
1 changed files with 88 additions and 57 deletions
|
|
@ -34,6 +34,7 @@ module Text.Pandoc.Writers.CommonMark (writeCommonMark) where
|
|||
import CMarkGFM
|
||||
import Control.Monad.State.Strict (State, get, modify, runState)
|
||||
import Data.Foldable (foldrM)
|
||||
import Data.Monoid (Any (..))
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Text.Pandoc.Class (PandocMonad)
|
||||
|
|
@ -41,7 +42,7 @@ import Text.Pandoc.Definition
|
|||
import Text.Pandoc.Options
|
||||
import Text.Pandoc.Shared (isTightList, linesToPara)
|
||||
import Text.Pandoc.Templates (renderTemplate')
|
||||
import Text.Pandoc.Walk (walkM)
|
||||
import Text.Pandoc.Walk (walkM, walk, query)
|
||||
import Text.Pandoc.Writers.HTML (writeHtml5String)
|
||||
import Text.Pandoc.Writers.Shared
|
||||
|
||||
|
|
@ -52,7 +53,12 @@ writeCommonMark opts (Pandoc meta blocks) = do
|
|||
notes' = if null notes
|
||||
then []
|
||||
else [OrderedList (1, Decimal, Period) $ reverse notes]
|
||||
main <- blocksToCommonMark opts (blocks' ++ notes')
|
||||
let softBreakToSpace SoftBreak = Space
|
||||
softBreakToSpace x = x
|
||||
let blocks'' = if writerWrapText opts == WrapNone
|
||||
then walk softBreakToSpace blocks'
|
||||
else blocks'
|
||||
main <- blocksToCommonMark opts (blocks'' ++ notes')
|
||||
metadata <- metaToJSON opts
|
||||
(blocksToCommonMark opts)
|
||||
(inlinesToCommonMark opts)
|
||||
|
|
@ -78,43 +84,46 @@ blocksToCommonMark opts bs = do
|
|||
colwidth = if writerWrapText opts == WrapAuto
|
||||
then Just $ writerColumns opts
|
||||
else Nothing
|
||||
nodes <- blocksToNodes bs
|
||||
nodes <- blocksToNodes opts bs
|
||||
return $
|
||||
nodeToCommonmark cmarkOpts colwidth $
|
||||
node DOCUMENT nodes
|
||||
|
||||
inlinesToCommonMark :: PandocMonad m => WriterOptions -> [Inline] -> m Text
|
||||
inlinesToCommonMark opts ils = return $
|
||||
nodeToCommonmark cmarkOpts colwidth $ node PARAGRAPH (inlinesToNodes ils)
|
||||
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 => [Block] -> m [Node]
|
||||
blocksToNodes = foldrM blockToNodes []
|
||||
blocksToNodes :: PandocMonad m => WriterOptions -> [Block] -> m [Node]
|
||||
blocksToNodes opts = foldrM (blockToNodes opts) []
|
||||
|
||||
blockToNodes :: PandocMonad m => Block -> [Node] -> m [Node]
|
||||
blockToNodes (Plain xs) ns = return (node PARAGRAPH (inlinesToNodes xs) : ns)
|
||||
blockToNodes (Para xs) ns = return (node PARAGRAPH (inlinesToNodes xs) : ns)
|
||||
blockToNodes (LineBlock lns) ns = blockToNodes (linesToPara lns) ns
|
||||
blockToNodes (CodeBlock (_,classes,_) xs) ns = return $
|
||||
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.pack (unwords classes)) (T.pack xs)) [] : ns)
|
||||
blockToNodes (RawBlock fmt xs) ns
|
||||
blockToNodes _ (RawBlock fmt xs) ns
|
||||
| fmt == Format "html" = return (node (HTML_BLOCK (T.pack xs)) [] : ns)
|
||||
| otherwise = return (node (CUSTOM_BLOCK (T.pack xs) (T.empty)) [] : ns)
|
||||
blockToNodes (BlockQuote bs) ns = do
|
||||
nodes <- blocksToNodes bs
|
||||
blockToNodes opts (BlockQuote bs) ns = do
|
||||
nodes <- blocksToNodes opts bs
|
||||
return (node BLOCK_QUOTE nodes : ns)
|
||||
blockToNodes (BulletList items) ns = do
|
||||
nodes <- mapM blocksToNodes items
|
||||
blockToNodes opts (BulletList items) ns = do
|
||||
nodes <- mapM (blocksToNodes opts) items
|
||||
return (node (LIST ListAttributes{
|
||||
listType = BULLET_LIST,
|
||||
listDelim = PERIOD_DELIM,
|
||||
listTight = isTightList items,
|
||||
listStart = 1 }) (map (node ITEM) nodes) : ns)
|
||||
blockToNodes (OrderedList (start, _sty, delim) items) ns = do
|
||||
nodes <- mapM blocksToNodes items
|
||||
blockToNodes opts (OrderedList (start, _sty, delim) items) ns = do
|
||||
nodes <- mapM (blocksToNodes opts) items
|
||||
return (node (LIST ListAttributes{
|
||||
listType = ORDERED_LIST,
|
||||
listDelim = case delim of
|
||||
|
|
@ -123,12 +132,14 @@ blockToNodes (OrderedList (start, _sty, delim) items) ns = do
|
|||
_ -> PERIOD_DELIM,
|
||||
listTight = isTightList items,
|
||||
listStart = start }) (map (node ITEM) nodes) : ns)
|
||||
blockToNodes HorizontalRule ns = return (node THEMATIC_BREAK [] : ns)
|
||||
blockToNodes (Header lev _ ils) ns = return (node (HEADING lev) (inlinesToNodes ils) : ns)
|
||||
blockToNodes (Div _ bs) ns = do
|
||||
nodes <- blocksToNodes bs
|
||||
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 _ bs) ns = do
|
||||
nodes <- blocksToNodes opts bs
|
||||
return (nodes ++ ns)
|
||||
blockToNodes (DefinitionList items) ns = blockToNodes (BulletList items') 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
|
||||
|
|
@ -136,54 +147,74 @@ blockToNodes (DefinitionList items) ns = blockToNodes (BulletList items') ns
|
|||
Plain (term ++ [LineBreak] ++ xs) : ys ++ concat zs
|
||||
dlToBullet (term, xs) =
|
||||
Para term : concat xs
|
||||
blockToNodes t@(Table _ _ _ _ _) ns = do
|
||||
s <- writeHtml5String def $! Pandoc nullMeta [t]
|
||||
return (node (HTML_BLOCK s) [] : ns)
|
||||
blockToNodes Null ns = return ns
|
||||
blockToNodes opts t@(Table _capt aligns widths headers rows) ns = do
|
||||
let allrows = headers:rows
|
||||
let isLineBreak LineBreak = Any True
|
||||
isLineBreak _ = Any False
|
||||
let isSimple = all (==0) widths &&
|
||||
not ( getAny (query isLineBreak allrows) )
|
||||
if isEnabled Ext_pipe_tables opts && isSimple
|
||||
then do
|
||||
let toAlign AlignDefault = NoAlignment
|
||||
toAlign AlignLeft = LeftAligned
|
||||
toAlign AlignCenter = CenterAligned
|
||||
toAlign AlignRight = RightAligned
|
||||
let aligns' = map toAlign aligns
|
||||
let toCell bs = node TABLE_CELL <$> blocksToNodes opts bs
|
||||
let toRow cells = node TABLE_ROW <$> mapM toCell cells
|
||||
cmrows <- mapM toRow allrows
|
||||
return (node (TABLE aligns') cmrows : 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 :: [Inline] -> [Node]
|
||||
inlinesToNodes = foldr inlineToNodes []
|
||||
inlinesToNodes :: WriterOptions -> [Inline] -> [Node]
|
||||
inlinesToNodes opts = foldr (inlineToNodes opts) []
|
||||
|
||||
inlineToNodes :: Inline -> [Node] -> [Node]
|
||||
inlineToNodes (Str s) = (node (TEXT (T.pack s)) [] :)
|
||||
inlineToNodes Space = (node (TEXT (T.pack " ")) [] :)
|
||||
inlineToNodes LineBreak = (node LINEBREAK [] :)
|
||||
inlineToNodes SoftBreak = (node SOFTBREAK [] :)
|
||||
inlineToNodes (Emph xs) = (node EMPH (inlinesToNodes xs) :)
|
||||
inlineToNodes (Strong xs) = (node STRONG (inlinesToNodes xs) :)
|
||||
inlineToNodes (Strikeout xs) =
|
||||
((node (HTML_INLINE (T.pack "<s>")) [] : inlinesToNodes xs ++
|
||||
[node (HTML_INLINE (T.pack "</s>")) []]) ++ )
|
||||
inlineToNodes (Superscript xs) =
|
||||
((node (HTML_INLINE (T.pack "<sup>")) [] : inlinesToNodes xs ++
|
||||
inlineToNodes :: WriterOptions -> Inline -> [Node] -> [Node]
|
||||
inlineToNodes _ (Str s) = (node (TEXT (T.pack s)) [] :)
|
||||
inlineToNodes _ Space = (node (TEXT (T.pack " ")) [] :)
|
||||
inlineToNodes _ LineBreak = (node LINEBREAK [] :)
|
||||
inlineToNodes _ SoftBreak = (node SOFTBREAK [] :)
|
||||
inlineToNodes opts (Emph xs) = (node EMPH (inlinesToNodes opts xs) :)
|
||||
inlineToNodes opts (Strong xs) = (node STRONG (inlinesToNodes opts xs) :)
|
||||
inlineToNodes opts (Strikeout xs) =
|
||||
if isEnabled Ext_strikeout opts
|
||||
then (node STRIKETHROUGH (inlinesToNodes opts xs) :)
|
||||
else ((node (HTML_INLINE (T.pack "<s>")) [] : inlinesToNodes opts xs ++
|
||||
[node (HTML_INLINE (T.pack "</s>")) []]) ++ )
|
||||
inlineToNodes opts (Superscript xs) =
|
||||
((node (HTML_INLINE (T.pack "<sup>")) [] : inlinesToNodes opts xs ++
|
||||
[node (HTML_INLINE (T.pack "</sup>")) []]) ++ )
|
||||
inlineToNodes (Subscript xs) =
|
||||
((node (HTML_INLINE (T.pack "<sub>")) [] : inlinesToNodes xs ++
|
||||
inlineToNodes opts (Subscript xs) =
|
||||
((node (HTML_INLINE (T.pack "<sub>")) [] : inlinesToNodes opts xs ++
|
||||
[node (HTML_INLINE (T.pack "</sub>")) []]) ++ )
|
||||
inlineToNodes (SmallCaps xs) =
|
||||
inlineToNodes opts (SmallCaps xs) =
|
||||
((node (HTML_INLINE (T.pack "<span class=\"smallcaps\">")) []
|
||||
: inlinesToNodes xs ++
|
||||
: inlinesToNodes opts xs ++
|
||||
[node (HTML_INLINE (T.pack "</span>")) []]) ++ )
|
||||
inlineToNodes (Link _ ils (url,tit)) =
|
||||
(node (LINK (T.pack url) (T.pack tit)) (inlinesToNodes ils) :)
|
||||
inlineToNodes (Image _ ils (url,tit)) =
|
||||
(node (IMAGE (T.pack url) (T.pack tit)) (inlinesToNodes ils) :)
|
||||
inlineToNodes (RawInline fmt xs)
|
||||
inlineToNodes opts (Link _ ils (url,tit)) =
|
||||
(node (LINK (T.pack url) (T.pack tit)) (inlinesToNodes opts ils) :)
|
||||
inlineToNodes opts (Image _ ils (url,tit)) =
|
||||
(node (IMAGE (T.pack url) (T.pack tit)) (inlinesToNodes opts ils) :)
|
||||
inlineToNodes _ (RawInline fmt xs)
|
||||
| fmt == Format "html" = (node (HTML_INLINE (T.pack xs)) [] :)
|
||||
| otherwise = (node (CUSTOM_INLINE (T.pack xs) (T.empty)) [] :)
|
||||
inlineToNodes (Quoted qt ils) =
|
||||
((node (TEXT start) [] : inlinesToNodes ils ++ [node (TEXT end) []]) ++)
|
||||
inlineToNodes opts (Quoted qt ils) =
|
||||
((node (TEXT start) [] :
|
||||
inlinesToNodes opts ils ++ [node (TEXT end) []]) ++)
|
||||
where (start, end) = case qt of
|
||||
SingleQuote -> (T.pack "‘", T.pack "’")
|
||||
DoubleQuote -> (T.pack "“", T.pack "”")
|
||||
inlineToNodes (Code _ str) = (node (CODE (T.pack str)) [] :)
|
||||
inlineToNodes (Math mt str) =
|
||||
inlineToNodes _ (Code _ str) = (node (CODE (T.pack str)) [] :)
|
||||
inlineToNodes _ (Math mt str) =
|
||||
case mt of
|
||||
InlineMath ->
|
||||
(node (HTML_INLINE (T.pack ("\\(" ++ str ++ "\\)"))) [] :)
|
||||
DisplayMath ->
|
||||
(node (HTML_INLINE (T.pack ("\\[" ++ str ++ "\\]"))) [] :)
|
||||
inlineToNodes (Span _ ils) = (inlinesToNodes ils ++)
|
||||
inlineToNodes (Cite _ ils) = (inlinesToNodes ils ++)
|
||||
inlineToNodes (Note _) = id -- should not occur
|
||||
inlineToNodes opts (Span _ ils) = (inlinesToNodes opts ils ++)
|
||||
inlineToNodes opts (Cite _ ils) = (inlinesToNodes opts ils ++)
|
||||
inlineToNodes _ (Note _) = id -- should not occur
|
||||
-- we remove Note elements in preprocessing
|
||||
|
|
|
|||
Loading…
Reference in a new issue