git.iko.soy/typeable/pandoc
on master help sign in
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`.

commit56a680c30583d56cfe847b8067f6bf6a7f764794 authorJohn MacFarlane <jgm@berkeley.edu> dateTue 8 Aug 2017, 09:14 (9 years ago) parentc95cc81
1 file changed+90−59
src/Text/Pandoc/Writers/CommonMark.hs+90−59
src/Text/Pandoc/Writers/CommonMark.hs+90−59
@@ -34,6 +34,7 @@ module Text.Pandoc.Writers.CommonMark (writeCommonMark) where
3434import CMarkGFM
3535import Control.Monad.State.Strict (State, get, modify, runState)
3636import Data.Foldable (foldrM)
37+import Data.Monoid (Any (..))
3738import Data.Text (Text)
3839import qualified Data.Text as T
3940import Text.Pandoc.Class (PandocMonad)
@@ -41,7 +42,7 @@ import Text.Pandoc.Definition
4142import Text.Pandoc.Options
4243import Text.Pandoc.Shared (isTightList, linesToPara)
4344import Text.Pandoc.Templates (renderTemplate')
44−import Text.Pandoc.Walk (walkM)
45+import Text.Pandoc.Walk (walkM, walk, query)
4546import Text.Pandoc.Writers.HTML (writeHtml5String)
4647import Text.Pandoc.Writers.Shared
4748
@@ -52,7 +53,12 @@ writeCommonMark opts (Pandoc meta blocks) = do
5253 notes' = if null notes
5354 then []
5455 else [OrderedList (1, Decimal, Period) $ reverse notes]
55− main <- blocksToCommonMark opts (blocks' ++ notes')
56+ let softBreakToSpace SoftBreak = Space
57+ softBreakToSpace x = x
58+ let blocks'' = if writerWrapText opts == WrapNone
59+ then walk softBreakToSpace blocks'
60+ else blocks'
61+ main <- blocksToCommonMark opts (blocks'' ++ notes')
5662 metadata <- metaToJSON opts
5763 (blocksToCommonMark opts)
5864 (inlinesToCommonMark opts)
@@ -78,43 +84,46 @@ blocksToCommonMark opts bs = do
7884 colwidth = if writerWrapText opts == WrapAuto
7985 then Just $ writerColumns opts
8086 else Nothing
81− nodes <- blocksToNodes bs
87+ nodes <- blocksToNodes opts bs
8288 return $
8389 nodeToCommonmark cmarkOpts colwidth $
8490 node DOCUMENT nodes
8591
8692inlinesToCommonMark :: PandocMonad m => WriterOptions -> [Inline] -> m Text
8793inlinesToCommonMark opts ils = return $
88− nodeToCommonmark cmarkOpts colwidth $ node PARAGRAPH (inlinesToNodes ils)
94+ nodeToCommonmark cmarkOpts colwidth $
95+ node PARAGRAPH (inlinesToNodes opts ils)
8996 where cmarkOpts = [optHardBreaks | isEnabled Ext_hard_line_breaks opts]
9097 colwidth = if writerWrapText opts == WrapAuto
9198 then Just $ writerColumns opts
9299 else Nothing
93100
94−blocksToNodes :: PandocMonad m => [Block] -> m [Node]
95−blocksToNodes = foldrM blockToNodes []
101+blocksToNodes :: PandocMonad m => WriterOptions -> [Block] -> m [Node]
102+blocksToNodes opts = foldrM (blockToNodes opts) []
96103
97−blockToNodes :: PandocMonad m => Block -> [Node] -> m [Node]
98−blockToNodes (Plain xs) ns = return (node PARAGRAPH (inlinesToNodes xs) : ns)
99−blockToNodes (Para xs) ns = return (node PARAGRAPH (inlinesToNodes xs) : ns)
100−blockToNodes (LineBlock lns) ns = blockToNodes (linesToPara lns) ns
101−blockToNodes (CodeBlock (_,classes,_) xs) ns = return $
104+blockToNodes :: PandocMonad m => WriterOptions -> Block -> [Node] -> m [Node]
105+blockToNodes opts (Plain xs) ns =
106+ return (node PARAGRAPH (inlinesToNodes opts xs) : ns)
107+blockToNodes opts (Para xs) ns =
108+ return (node PARAGRAPH (inlinesToNodes opts xs) : ns)
109+blockToNodes opts (LineBlock lns) ns = blockToNodes opts (linesToPara lns) ns
110+blockToNodes _ (CodeBlock (_,classes,_) xs) ns = return $
102111 (node (CODE_BLOCK (T.pack (unwords classes)) (T.pack xs)) [] : ns)
103−blockToNodes (RawBlock fmt xs) ns
112+blockToNodes _ (RawBlock fmt xs) ns
104113 | fmt == Format "html" = return (node (HTML_BLOCK (T.pack xs)) [] : ns)
105114 | otherwise = return (node (CUSTOM_BLOCK (T.pack xs) (T.empty)) [] : ns)
106−blockToNodes (BlockQuote bs) ns = do
107− nodes <- blocksToNodes bs
115+blockToNodes opts (BlockQuote bs) ns = do
116+ nodes <- blocksToNodes opts bs
108117 return (node BLOCK_QUOTE nodes : ns)
109−blockToNodes (BulletList items) ns = do
110− nodes <- mapM blocksToNodes items
118+blockToNodes opts (BulletList items) ns = do
119+ nodes <- mapM (blocksToNodes opts) items
111120 return (node (LIST ListAttributes{
112121 listType = BULLET_LIST,
113122 listDelim = PERIOD_DELIM,
114123 listTight = isTightList items,
115124 listStart = 1 }) (map (node ITEM) nodes) : ns)
116−blockToNodes (OrderedList (start, _sty, delim) items) ns = do
117− nodes <- mapM blocksToNodes items
125+blockToNodes opts (OrderedList (start, _sty, delim) items) ns = do
126+ nodes <- mapM (blocksToNodes opts) items
118127 return (node (LIST ListAttributes{
119128 listType = ORDERED_LIST,
120129 listDelim = case delim of
@@ -123,12 +132,14 @@ blockToNodes (OrderedList (start, _sty, delim) items) ns = do
123132 _ -> PERIOD_DELIM,
124133 listTight = isTightList items,
125134 listStart = start }) (map (node ITEM) nodes) : ns)
126−blockToNodes HorizontalRule ns = return (node THEMATIC_BREAK [] : ns)
127−blockToNodes (Header lev _ ils) ns = return (node (HEADING lev) (inlinesToNodes ils) : ns)
128−blockToNodes (Div _ bs) ns = do
129− nodes <- blocksToNodes bs
135+blockToNodes _ HorizontalRule ns = return (node THEMATIC_BREAK [] : ns)
136+blockToNodes opts (Header lev _ ils) ns =
137+ return (node (HEADING lev) (inlinesToNodes opts ils) : ns)
138+blockToNodes opts (Div _ bs) ns = do
139+ nodes <- blocksToNodes opts bs
130140 return (nodes ++ ns)
131−blockToNodes (DefinitionList items) ns = blockToNodes (BulletList items') ns
141+blockToNodes opts (DefinitionList items) ns =
142+ blockToNodes opts (BulletList items') ns
132143 where items' = map dlToBullet items
133144 dlToBullet (term, ((Para xs : ys) : zs)) =
134145 Para (term ++ [LineBreak] ++ xs) : ys ++ concat zs
@@ -136,54 +147,74 @@ blockToNodes (DefinitionList items) ns = blockToNodes (BulletList items') ns
136147 Plain (term ++ [LineBreak] ++ xs) : ys ++ concat zs
137148 dlToBullet (term, xs) =
138149 Para term : concat xs
139−blockToNodes t@(Table _ _ _ _ _) ns = do
140− s <- writeHtml5String def $! Pandoc nullMeta [t]
141− return (node (HTML_BLOCK s) [] : ns)
142−blockToNodes Null ns = return ns
143−
144−inlinesToNodes :: [Inline] -> [Node]
145−inlinesToNodes = foldr inlineToNodes []
146−
147−inlineToNodes :: Inline -> [Node] -> [Node]
148−inlineToNodes (Str s) = (node (TEXT (T.pack s)) [] :)
149−inlineToNodes Space = (node (TEXT (T.pack " ")) [] :)
150−inlineToNodes LineBreak = (node LINEBREAK [] :)
151−inlineToNodes SoftBreak = (node SOFTBREAK [] :)
152−inlineToNodes (Emph xs) = (node EMPH (inlinesToNodes xs) :)
153−inlineToNodes (Strong xs) = (node STRONG (inlinesToNodes xs) :)
154−inlineToNodes (Strikeout xs) =
155− ((node (HTML_INLINE (T.pack "<s>")) [] : inlinesToNodes xs ++
156− [node (HTML_INLINE (T.pack "</s>")) []]) ++ )
157−inlineToNodes (Superscript xs) =
158− ((node (HTML_INLINE (T.pack "<sup>")) [] : inlinesToNodes xs ++
150+blockToNodes opts t@(Table _capt aligns widths headers rows) ns = do
151+ let allrows = headers:rows
152+ let isLineBreak LineBreak = Any True
153+ isLineBreak _ = Any False
154+ let isSimple = all (==0) widths &&
155+ not ( getAny (query isLineBreak allrows) )
156+ if isEnabled Ext_pipe_tables opts && isSimple
157+ then do
158+ let toAlign AlignDefault = NoAlignment
159+ toAlign AlignLeft = LeftAligned
160+ toAlign AlignCenter = CenterAligned
161+ toAlign AlignRight = RightAligned
162+ let aligns' = map toAlign aligns
163+ let toCell bs = node TABLE_CELL <$> blocksToNodes opts bs
164+ let toRow cells = node TABLE_ROW <$> mapM toCell cells
165+ cmrows <- mapM toRow allrows
166+ return (node (TABLE aligns') cmrows : ns)
167+ else do -- fall back to raw HTML
168+ s <- writeHtml5String def $! Pandoc nullMeta [t]
169+ return (node (HTML_BLOCK s) [] : ns)
170+blockToNodes _ Null ns = return ns
171+
172+inlinesToNodes :: WriterOptions -> [Inline] -> [Node]
173+inlinesToNodes opts = foldr (inlineToNodes opts) []
174+
175+inlineToNodes :: WriterOptions -> Inline -> [Node] -> [Node]
176+inlineToNodes _ (Str s) = (node (TEXT (T.pack s)) [] :)
177+inlineToNodes _ Space = (node (TEXT (T.pack " ")) [] :)
178+inlineToNodes _ LineBreak = (node LINEBREAK [] :)
179+inlineToNodes _ SoftBreak = (node SOFTBREAK [] :)
180+inlineToNodes opts (Emph xs) = (node EMPH (inlinesToNodes opts xs) :)
181+inlineToNodes opts (Strong xs) = (node STRONG (inlinesToNodes opts xs) :)
182+inlineToNodes opts (Strikeout xs) =
183+ if isEnabled Ext_strikeout opts
184+ then (node STRIKETHROUGH (inlinesToNodes opts xs) :)
185+ else ((node (HTML_INLINE (T.pack "<s>")) [] : inlinesToNodes opts xs ++
186+ [node (HTML_INLINE (T.pack "</s>")) []]) ++ )
187+inlineToNodes opts (Superscript xs) =
188+ ((node (HTML_INLINE (T.pack "<sup>")) [] : inlinesToNodes opts xs ++
159189 [node (HTML_INLINE (T.pack "</sup>")) []]) ++ )
160−inlineToNodes (Subscript xs) =
161− ((node (HTML_INLINE (T.pack "<sub>")) [] : inlinesToNodes xs ++
190+inlineToNodes opts (Subscript xs) =
191+ ((node (HTML_INLINE (T.pack "<sub>")) [] : inlinesToNodes opts xs ++
162192 [node (HTML_INLINE (T.pack "</sub>")) []]) ++ )
163−inlineToNodes (SmallCaps xs) =
193+inlineToNodes opts (SmallCaps xs) =
164194 ((node (HTML_INLINE (T.pack "<span class=\"smallcaps\">")) []
165− : inlinesToNodes xs ++
195+ : inlinesToNodes opts xs ++
166196 [node (HTML_INLINE (T.pack "</span>")) []]) ++ )
167−inlineToNodes (Link _ ils (url,tit)) =
168− (node (LINK (T.pack url) (T.pack tit)) (inlinesToNodes ils) :)
169−inlineToNodes (Image _ ils (url,tit)) =
170− (node (IMAGE (T.pack url) (T.pack tit)) (inlinesToNodes ils) :)
171−inlineToNodes (RawInline fmt xs)
197+inlineToNodes opts (Link _ ils (url,tit)) =
198+ (node (LINK (T.pack url) (T.pack tit)) (inlinesToNodes opts ils) :)
199+inlineToNodes opts (Image _ ils (url,tit)) =
200+ (node (IMAGE (T.pack url) (T.pack tit)) (inlinesToNodes opts ils) :)
201+inlineToNodes _ (RawInline fmt xs)
172202 | fmt == Format "html" = (node (HTML_INLINE (T.pack xs)) [] :)
173203 | otherwise = (node (CUSTOM_INLINE (T.pack xs) (T.empty)) [] :)
174−inlineToNodes (Quoted qt ils) =
175− ((node (TEXT start) [] : inlinesToNodes ils ++ [node (TEXT end) []]) ++)
204+inlineToNodes opts (Quoted qt ils) =
205+ ((node (TEXT start) [] :
206+ inlinesToNodes opts ils ++ [node (TEXT end) []]) ++)
176207 where (start, end) = case qt of
177208 SingleQuote -> (T.pack "‘", T.pack "’")
178209 DoubleQuote -> (T.pack "“", T.pack "”")
179−inlineToNodes (Code _ str) = (node (CODE (T.pack str)) [] :)
180−inlineToNodes (Math mt str) =
210+inlineToNodes _ (Code _ str) = (node (CODE (T.pack str)) [] :)
211+inlineToNodes _ (Math mt str) =
181212 case mt of
182213 InlineMath ->
183214 (node (HTML_INLINE (T.pack ("\\(" ++ str ++ "\\)"))) [] :)
184215 DisplayMath ->
185216 (node (HTML_INLINE (T.pack ("\\[" ++ str ++ "\\]"))) [] :)
186−inlineToNodes (Span _ ils) = (inlinesToNodes ils ++)
187−inlineToNodes (Cite _ ils) = (inlinesToNodes ils ++)
188−inlineToNodes (Note _) = id -- should not occur
217+inlineToNodes opts (Span _ ils) = (inlinesToNodes opts ils ++)
218+inlineToNodes opts (Cite _ ils) = (inlinesToNodes opts ils ++)
219+inlineToNodes _ (Note _) = id -- should not occur
189220-- we remove Note elements in preprocessing