@@ -0,0 +1,189 @@
1+{-
2+Copyright (C) 2015 John MacFarlane <jgm@berkeley.edu>
3+
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.
8+
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.
13+
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
17+-}
18+
19+{- |
20+ Module : Text.Pandoc.Writers.GFM
21+ Copyright : Copyright (C) 2017 John MacFarlane
22+ License : GNU GPL, version 2 or above
23+
24+ Maintainer : John MacFarlane <jgm@berkeley.edu>
25+ Stability : alpha
26+ Portability : portable
27+
28+Conversion of 'Pandoc' documents to CommonMark.
29+
30+CommonMark: <http://commonmark.org>
31+-}
32+module Text.Pandoc.Writers.GFM (writeGFM) where
33+
34+import CMarkGFM
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
47+
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
53+ then []
54+ else [OrderedList (1, Decimal, Period) $ reverse notes]
55+ main <- blocksToCommonMark opts (blocks' ++ notes')
56+ metadata <- metaToJSON opts
57+ (blocksToCommonMark opts)
58+ (inlinesToCommonMark opts)
59+ meta
60+ let context = defField "body" main $ metadata
61+ case writerTemplate opts of
62+ Nothing -> return main
63+ Just tpl -> renderTemplate' tpl context
64+
65+processNotes :: Inline -> State [[Block]] Inline
66+processNotes (Note bs) = do
67+ modify (bs :)
68+ notes <- get
69+ return $ Str $ "[" ++ show (length notes) ++ "]"
70+processNotes x = return x
71+
72+node :: NodeType -> [Node] -> Node
73+node = Node Nothing
74+
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
80+ else Nothing
81+ nodes <- blocksToNodes bs
82+ return $
83+ nodeToCommonmark cmarkOpts colwidth $
84+ node DOCUMENT nodes
85+
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
92+ else Nothing
93+
94+blocksToNodes :: PandocMonad m => [Block] -> m [Node]
95+blocksToNodes = foldrM blockToNodes []
96+
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
123+ _ -> PERIOD_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
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 ++
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) =
181+ case mt of
182+ InlineMath ->
183+ (node (HTML_INLINE (T.pack ("\\(" ++ str ++ "\\)"))) [] :)
184+ DisplayMath ->
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