diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/CommonMark.hs')
| -rw-r--r-- | src/Text/Pandoc/Writers/CommonMark.hs | 190 |
1 files changed, 0 insertions, 190 deletions
diff --git a/src/Text/Pandoc/Writers/CommonMark.hs b/src/Text/Pandoc/Writers/CommonMark.hs deleted file mode 100644 index b83f6785d..000000000 --- a/src/Text/Pandoc/Writers/CommonMark.hs +++ /dev/null @@ -1,190 +0,0 @@ -{- -Copyright (C) 2015 John MacFarlane <jgm@berkeley.edu> - -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --} - -{- | - Module : Text.Pandoc.Writers.CommonMark - Copyright : Copyright (C) 2015 John MacFarlane - License : GNU GPL, version 2 or above - - Maintainer : John MacFarlane <jgm@berkeley.edu> - Stability : alpha - Portability : portable - -Conversion of 'Pandoc' documents to CommonMark. - -CommonMark: <http://commonmark.org> --} -module Text.Pandoc.Writers.CommonMark (writeCommonMark) where - -import Text.Pandoc.Writers.HTML (writeHtml5String) -import Text.Pandoc.Definition -import Text.Pandoc.Shared (isTightList, linesToPara) -import Text.Pandoc.Templates (renderTemplate') -import Text.Pandoc.Writers.Shared -import Text.Pandoc.Options -import CMark -import qualified Data.Text as T -import Control.Monad.State (runState, State, modify, get) -import Text.Pandoc.Walk (walkM) -import Text.Pandoc.Class (PandocMonad) -import Data.Foldable (foldrM) - --- | Convert Pandoc to CommonMark. -writeCommonMark :: PandocMonad m => WriterOptions -> Pandoc -> m String -writeCommonMark opts (Pandoc meta blocks) = do - let (blocks', notes) = runState (walkM processNotes blocks) [] - notes' = if null notes - then [] - else [OrderedList (1, Decimal, Period) $ reverse notes] - main <- blocksToCommonMark opts (blocks' ++ notes') - metadata <- metaToJSON opts - (blocksToCommonMark opts) - (inlinesToCommonMark opts) - meta - let context = defField "body" main $ metadata - return $ case writerTemplate opts of - Nothing -> main - Just tpl -> renderTemplate' tpl context - -processNotes :: Inline -> State [[Block]] Inline -processNotes (Note bs) = do - modify (bs :) - notes <- get - return $ Str $ "[" ++ show (length notes) ++ "]" -processNotes x = return x - -node :: NodeType -> [Node] -> Node -node = Node Nothing - -blocksToCommonMark :: PandocMonad m => WriterOptions -> [Block] -> m String -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 bs - return $ - T.unpack $ - nodeToCommonmark cmarkOpts colwidth $ - node DOCUMENT nodes - -inlinesToCommonMark :: PandocMonad m => WriterOptions -> [Inline] -> m String -inlinesToCommonMark opts ils = return $ - T.unpack $ nodeToCommonmark cmarkOpts colwidth - $ node PARAGRAPH (inlinesToNodes 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 [] - -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 $ - (node (CODE_BLOCK (T.pack (unwords classes)) (T.pack 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 - return (node BLOCK_QUOTE nodes : ns) -blockToNodes (BulletList items) ns = do - nodes <- mapM blocksToNodes 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 - 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 (Header lev _ ils) ns = return (node (HEADING lev) (inlinesToNodes ils) : ns) -blockToNodes (Div _ bs) ns = do - nodes <- blocksToNodes bs - return (nodes ++ ns) -blockToNodes (DefinitionList items) ns = blockToNodes (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 t@(Table _ _ _ _ _) ns = do - s <- writeHtml5String def $! Pandoc nullMeta [t] - return (node (HTML_BLOCK (T.pack $! 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 ++ - [node (HTML_INLINE (T.pack "</sup>")) []]) ++ ) -inlineToNodes (Subscript xs) = - ((node (HTML_INLINE (T.pack "<sub>")) [] : inlinesToNodes xs ++ - [node (HTML_INLINE (T.pack "</sub>")) []]) ++ ) -inlineToNodes (SmallCaps xs) = - ((node (HTML_INLINE (T.pack "<span style=\"font-variant:small-caps;\">")) [] - : inlinesToNodes 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) - | 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) []]) ++) - 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) = - 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 --- we remove Note elements in preprocessing |