@@ -1,189 +0,0 @@
2−Copyright (C) 2015 John MacFarlane <jgm@berkeley.edu>
4−This program is free software; you can redistribute it and/or modify
5−it under the terms of the GNU General Public License as published by
6−the Free Software Foundation; either version 2 of the License, or
7−(at your option) any later version.
9−This program is distributed in the hope that it will be useful,
10−but WITHOUT ANY WARRANTY; without even the implied warranty of
11−MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12−GNU General Public License for more details.
14−You should have received a copy of the GNU General Public License
15−along with this program; if not, write to the Free Software
16−Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20− Module : Text.Pandoc.Writers.GFM
21− Copyright : Copyright (C) 2017 John MacFarlane
22− License : GNU GPL, version 2 or above
24− Maintainer : John MacFarlane <jgm@berkeley.edu>
26− Portability : portable
28−Conversion of 'Pandoc' documents to CommonMark.
30−CommonMark: <http://commonmark.org>
32−module Text.Pandoc.Writers.GFM (writeGFM) where
35−import Control.Monad.State.Strict (State, get, modify, runState)
36−import Data.Foldable (foldrM)
37−import Data.Text (Text)
38−import qualified Data.Text as T
39−import Text.Pandoc.Class (PandocMonad)
40−import Text.Pandoc.Definition
41−import Text.Pandoc.Options
42−import Text.Pandoc.Shared (isTightList, linesToPara)
43−import Text.Pandoc.Templates (renderTemplate')
44−import Text.Pandoc.Walk (walkM)
45−import Text.Pandoc.Writers.HTML (writeHtml5String)
46−import Text.Pandoc.Writers.Shared
48−-- | Convert Pandoc to GitHub flavored CommonMark.
49−writeGFM :: PandocMonad m => WriterOptions -> Pandoc -> m Text
50−writeGFM opts (Pandoc meta blocks) = do
51− let (blocks', notes) = runState (walkM processNotes blocks) []
52− notes' = if null notes
54− else [OrderedList (1, Decimal, Period) $ reverse notes]
55− main <- blocksToCommonMark opts (blocks' ++ notes')
56− metadata <- metaToJSON opts
57− (blocksToCommonMark opts)
58− (inlinesToCommonMark opts)
60− let context = defField "body" main $ metadata
61− case writerTemplate opts of
62− Nothing -> return main
63− Just tpl -> renderTemplate' tpl context
65−processNotes :: Inline -> State [[Block]] Inline
66−processNotes (Note bs) = do
69− return $ Str $ "[" ++ show (length notes) ++ "]"
70−processNotes x = return x
72−node :: NodeType -> [Node] -> Node
75−blocksToCommonMark :: PandocMonad m => WriterOptions -> [Block] -> m Text
76−blocksToCommonMark opts bs = do
77− let cmarkOpts = [optHardBreaks | isEnabled Ext_hard_line_breaks opts]
78− colwidth = if writerWrapText opts == WrapAuto
79− then Just $ writerColumns opts
81− nodes <- blocksToNodes bs
83− nodeToCommonmark cmarkOpts colwidth $
86−inlinesToCommonMark :: PandocMonad m => WriterOptions -> [Inline] -> m Text
87−inlinesToCommonMark opts ils = return $
88− nodeToCommonmark cmarkOpts colwidth $ node PARAGRAPH (inlinesToNodes ils)
89− where cmarkOpts = [optHardBreaks | isEnabled Ext_hard_line_breaks opts]
90− colwidth = if writerWrapText opts == WrapAuto
91− then Just $ writerColumns opts
94−blocksToNodes :: PandocMonad m => [Block] -> m [Node]
95−blocksToNodes = foldrM blockToNodes []
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 $
102− (node (CODE_BLOCK (T.pack (unwords classes)) (T.pack xs)) [] : ns)
103−blockToNodes (RawBlock fmt xs) ns
104− | fmt == Format "html" = return (node (HTML_BLOCK (T.pack xs)) [] : ns)
105− | otherwise = return (node (CUSTOM_BLOCK (T.pack xs) (T.empty)) [] : ns)
106−blockToNodes (BlockQuote bs) ns = do
107− nodes <- blocksToNodes bs
108− return (node BLOCK_QUOTE nodes : ns)
109−blockToNodes (BulletList items) ns = do
110− nodes <- mapM blocksToNodes items
111− return (node (LIST ListAttributes{
112− listType = BULLET_LIST,
113− listDelim = PERIOD_DELIM,
114− listTight = isTightList items,
115− listStart = 1 }) (map (node ITEM) nodes) : ns)
116−blockToNodes (OrderedList (start, _sty, delim) items) ns = do
117− nodes <- mapM blocksToNodes items
118− return (node (LIST ListAttributes{
119− listType = ORDERED_LIST,
120− listDelim = case delim of
121− OneParen -> PAREN_DELIM
122− TwoParens -> PAREN_DELIM
124− listTight = isTightList items,
125− 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
130− return (nodes ++ ns)
131−blockToNodes (DefinitionList items) ns = blockToNodes (BulletList items') ns
132− where items' = map dlToBullet items
133− dlToBullet (term, ((Para xs : ys) : zs)) =
134− Para (term ++ [LineBreak] ++ xs) : ys ++ concat zs
135− dlToBullet (term, ((Plain xs : ys) : zs)) =
136− Plain (term ++ [LineBreak] ++ xs) : ys ++ concat zs
137− dlToBullet (term, xs) =
138− 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
144−inlinesToNodes :: [Inline] -> [Node]
145−inlinesToNodes = foldr inlineToNodes []
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 ++
159− [node (HTML_INLINE (T.pack "</sup>")) []]) ++ )
160−inlineToNodes (Subscript xs) =
161− ((node (HTML_INLINE (T.pack "<sub>")) [] : inlinesToNodes xs ++
162− [node (HTML_INLINE (T.pack "</sub>")) []]) ++ )
163−inlineToNodes (SmallCaps xs) =
164− ((node (HTML_INLINE (T.pack "<span class=\"smallcaps\">")) []
165− : inlinesToNodes xs ++
166− [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)
172− | fmt == Format "html" = (node (HTML_INLINE (T.pack xs)) [] :)
173− | otherwise = (node (CUSTOM_INLINE (T.pack xs) (T.empty)) [] :)
174−inlineToNodes (Quoted qt ils) =
175− ((node (TEXT start) [] : inlinesToNodes ils ++ [node (TEXT end) []]) ++)
176− where (start, end) = case qt of
177− SingleQuote -> (T.pack "‘", T.pack "’")
178− DoubleQuote -> (T.pack "“", T.pack "”")
179−inlineToNodes (Code _ str) = (node (CODE (T.pack str)) [] :)
180−inlineToNodes (Math mt str) =
183− (node (HTML_INLINE (T.pack ("\\(" ++ str ++ "\\)"))) [] :)
185− (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
189−-- we remove Note elements in preprocessing