diff options
Diffstat (limited to 'src/Text/Pandoc/Writers')
| -rw-r--r-- | src/Text/Pandoc/Writers/CommonMark.hs | 149 |
1 files changed, 90 insertions, 59 deletions
diff --git a/src/Text/Pandoc/Writers/CommonMark.hs b/src/Text/Pandoc/Writers/CommonMark.hs index 75a18dcf4..fa838a503 100644 --- a/src/Text/Pandoc/Writers/CommonMark.hs +++ b/src/Text/Pandoc/Writers/CommonMark.hs @@ -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 - -inlinesToNodes :: [Inline] -> [Node] -inlinesToNodes = foldr inlineToNodes [] - -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 ++ +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 :: WriterOptions -> [Inline] -> [Node] +inlinesToNodes opts = foldr (inlineToNodes opts) [] + +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 |