@@ -43,44 +43,34 @@ import Text.Pandoc.Definition
4343import Text.Pandoc.Emoji (emojis)
4444import Text.Pandoc.Options
4545import Text.Pandoc.Shared (stringify)
46−import Text.Pandoc.Walk (walkM, walk)
46+import Text.Pandoc.Walk (walkM)
4747
4848-- | Parse a CommonMark formatted string into a 'Pandoc' structure.
4949readCommonMark :: PandocMonad m => ReaderOptions -> Text -> m Pandoc
5050readCommonMark opts s = return $
51− (if enabled Ext_gfm_auto_identifiers
51+ (if enabled Ext_gfm_auto_identifiers opts
5252 then addHeaderIdentifiers
5353 else id) $
54− (if enabled Ext_emoji
55− then addEmojis
56− else id) $
57− (if enabled Ext_hard_line_breaks
58− then walk softToHardBreaks
59− else id) $
60− nodeToPandoc $ commonmarkToNode opts' exts s
61− where opts' = [ optSmart | enabled Ext_smart ]
62− exts = [ extStrikethrough | enabled Ext_strikeout ] ++
63− [ extTable | enabled Ext_pipe_tables ] ++
64− [ extAutolink | enabled Ext_autolink_bare_uris ]
65− enabled x = extensionEnabled x (readerExtensions opts)
66−
67−softToHardBreaks :: Inline -> Inline
68−softToHardBreaks SoftBreak = LineBreak
69−softToHardBreaks x = x
70−
71−addEmojis :: Pandoc -> Pandoc
72−addEmojis = walk go
73− where go (Str xs) = Str (convertEmojis xs)
74− go x = x
75− convertEmojis (':':xs) =
76− case break (==':') xs of
77− (ys,':':zs) ->
78− case Map.lookup ys emojis of
79− Just s -> s ++ convertEmojis zs
80− Nothing -> ':' : ys ++ convertEmojis (':':zs)
81− _ -> ':':xs
82− convertEmojis (x:xs) = x : convertEmojis xs
83− convertEmojis [] = []
54+ nodeToPandoc opts $ commonmarkToNode opts' exts s
55+ where opts' = [ optSmart | enabled Ext_smart opts ]
56+ exts = [ extStrikethrough | enabled Ext_strikeout opts ] ++
57+ [ extTable | enabled Ext_pipe_tables opts ] ++
58+ [ extAutolink | enabled Ext_autolink_bare_uris opts ]
59+
60+-- | Returns True if the given extension is enabled.
61+enabled :: Extension -> ReaderOptions -> Bool
62+enabled ext opts = ext `extensionEnabled` (readerExtensions opts)
63+
64+convertEmojis :: String -> String
65+convertEmojis (':':xs) =
66+ case break (==':') xs of
67+ (ys,':':zs) ->
68+ case Map.lookup ys emojis of
69+ Just s -> s ++ convertEmojis zs
70+ Nothing -> ':' : ys ++ convertEmojis (':':zs)
71+ _ -> ':':xs
72+convertEmojis (x:xs) = x : convertEmojis xs
73+convertEmojis [] = []
8474
8575addHeaderIdentifiers :: Pandoc -> Pandoc
8676addHeaderIdentifiers doc = evalState (walkM addHeaderId doc) mempty
@@ -105,34 +95,35 @@ toIdent = map (\c -> if isSpace c then '-' else c)
10595 c == '_' || c == '-')
10696 . map toLower . stringify
10797
108−nodeToPandoc :: Node -> Pandoc
109−nodeToPandoc (Node _ DOCUMENT nodes) =
110− Pandoc nullMeta $ foldr addBlock [] nodes
111−nodeToPandoc n = -- shouldn't happen
112− Pandoc nullMeta $ foldr addBlock [] [n]
98+nodeToPandoc :: ReaderOptions -> Node -> Pandoc
99+nodeToPandoc opts (Node _ DOCUMENT nodes) =
100+ Pandoc nullMeta $ foldr (addBlock opts) [] nodes
101+nodeToPandoc opts n = -- shouldn't happen
102+ Pandoc nullMeta $ foldr (addBlock opts) [] [n]
113103
114−addBlocks :: [Node] -> [Block]
115−addBlocks = foldr addBlock []
104+addBlocks :: ReaderOptions -> [Node] -> [Block]
105+addBlocks opts = foldr (addBlock opts) []
116106
117−addBlock :: Node -> [Block] -> [Block]
118−addBlock (Node _ PARAGRAPH nodes) =
119− (Para (addInlines nodes) :)
120−addBlock (Node _ THEMATIC_BREAK _) =
107+addBlock :: ReaderOptions -> Node -> [Block] -> [Block]
108+addBlock opts (Node _ PARAGRAPH nodes) =
109+ (Para (addInlines opts nodes) :)
110+addBlock _ (Node _ THEMATIC_BREAK _) =
121111 (HorizontalRule :)
122−addBlock (Node _ BLOCK_QUOTE nodes) =
123− (BlockQuote (addBlocks nodes) :)
124−addBlock (Node _ (HTML_BLOCK t) _) =
125− (RawBlock (Format "html") (unpack t) :)
112+addBlock opts (Node _ BLOCK_QUOTE nodes) =
113+ (BlockQuote (addBlocks opts nodes) :)
114+addBlock opts (Node _ (HTML_BLOCK t) _)
115+ | enabled Ext_raw_html opts = (RawBlock (Format "html") (unpack t) :)
116+ | otherwise = id
126117-- Note: the cmark parser will never generate CUSTOM_BLOCK,
127118-- so we don't need to handle it:
128−addBlock (Node _ (CUSTOM_BLOCK _onEnter _onExit) _nodes) =
119+addBlock _ (Node _ (CUSTOM_BLOCK _onEnter _onExit) _nodes) =
129120 id
130−addBlock (Node _ (CODE_BLOCK info t) _) =
121+addBlock _ (Node _ (CODE_BLOCK info t) _) =
131122 (CodeBlock ("", take 1 (words (unpack info)), []) (unpack t) :)
132−addBlock (Node _ (HEADING lev) nodes) =
133− (Header lev ("",[],[]) (addInlines nodes) :)
134−addBlock (Node _ (LIST listAttrs) nodes) =
135− (constructor (map (setTightness . addBlocks . children) nodes) :)
123+addBlock opts (Node _ (HEADING lev) nodes) =
124+ (Header lev ("",[],[]) (addInlines opts nodes) :)
125+addBlock opts (Node _ (LIST listAttrs) nodes) =
126+ (constructor (map (setTightness . addBlocks opts . children) nodes) :)
136127 where constructor = case listType listAttrs of
137128 BULLET_LIST -> BulletList
138129 ORDERED_LIST -> OrderedList
@@ -146,7 +137,7 @@ addBlock (Node _ (LIST listAttrs) nodes) =
146137 delim = case listDelim listAttrs of
147138 PERIOD_DELIM -> Period
148139 PAREN_DELIM -> OneParen
149−addBlock (Node _ (TABLE alignments) nodes) = do
140+addBlock opts (Node _ (TABLE alignments) nodes) = do
150141 (Table [] aligns widths headers rows :)
151142 where aligns = map fromTableCellAlignment alignments
152143 fromTableCellAlignment NoAlignment = AlignDefault
@@ -169,12 +160,12 @@ addBlock (Node _ (TABLE alignments) nodes) = do
169160 toRow (Node _ t _) = error $ "toRow encountered non-row " ++ show t
170161 toCell (Node _ TABLE_CELL []) = []
171162 toCell (Node _ TABLE_CELL (n:ns))
172− | isBlockNode n = addBlocks (n:ns)
173− | otherwise = [Plain (addInlines (n:ns))]
163+ | isBlockNode n = addBlocks opts (n:ns)
164+ | otherwise = [Plain (addInlines opts (n:ns))]
174165 toCell (Node _ t _) = error $ "toCell encountered non-cell " ++ show t
175−addBlock (Node _ TABLE_ROW _) = id -- handled in TABLE
176−addBlock (Node _ TABLE_CELL _) = id -- handled in TABLE
177−addBlock _ = id
166+addBlock _ (Node _ TABLE_ROW _) = id -- handled in TABLE
167+addBlock _ (Node _ TABLE_CELL _) = id -- handled in TABLE
168+addBlock _ _ = id
178169
179170isBlockNode :: Node -> Bool
180171isBlockNode (Node _ nodetype _) =
@@ -207,11 +198,11 @@ isBlockNode (Node _ nodetype _) =
207198children :: Node -> [Node]
208199children (Node _ _ ns) = ns
209200
210−addInlines :: [Node] -> [Inline]
211−addInlines = foldr addInline []
201+addInlines :: ReaderOptions -> [Node] -> [Inline]
202+addInlines opts = foldr (addInline opts) []
212203
213−addInline :: Node -> [Inline] -> [Inline]
214−addInline (Node _ (TEXT t) _) = (map toinl clumps ++)
204+addInline :: ReaderOptions -> Node -> [Inline] -> [Inline]
205+addInline opts (Node _ (TEXT t) _) = (map toinl clumps ++)
215206 where raw = unpack t
216207 clumps = groupBy samekind raw
217208 samekind ' ' ' ' = True
@@ -219,25 +210,30 @@ addInline (Node _ (TEXT t) _) = (map toinl clumps ++)
219210 samekind _ ' ' = False
220211 samekind _ _ = True
221212 toinl (' ':_) = Space
222− toinl xs = Str xs
223−addInline (Node _ LINEBREAK _) = (LineBreak :)
224−addInline (Node _ SOFTBREAK _) = (SoftBreak :)
225−addInline (Node _ (HTML_INLINE t) _) =
226− (RawInline (Format "html") (unpack t) :)
213+ toinl xs = Str $ if enabled Ext_emoji opts
214+ then convertEmojis xs
215+ else xs
216+addInline _ (Node _ LINEBREAK _) = (LineBreak :)
217+addInline opts (Node _ SOFTBREAK _)
218+ | enabled Ext_hard_line_breaks opts = (LineBreak :)
219+ | otherwise = (SoftBreak :)
220+addInline opts (Node _ (HTML_INLINE t) _)
221+ | enabled Ext_raw_html opts = (RawInline (Format "html") (unpack t) :)
222+ | otherwise = id
227223-- Note: the cmark parser will never generate CUSTOM_BLOCK,
228224-- so we don't need to handle it:
229−addInline (Node _ (CUSTOM_INLINE _onEnter _onExit) _nodes) =
225+addInline _ (Node _ (CUSTOM_INLINE _onEnter _onExit) _nodes) =
230226 id
231−addInline (Node _ (CODE t) _) =
227+addInline _ (Node _ (CODE t) _) =
232228 (Code ("",[],[]) (unpack t) :)
233−addInline (Node _ EMPH nodes) =
234− (Emph (addInlines nodes) :)
235−addInline (Node _ STRONG nodes) =
236− (Strong (addInlines nodes) :)
237−addInline (Node _ STRIKETHROUGH nodes) =
238− (Strikeout (addInlines nodes) :)
239−addInline (Node _ (LINK url title) nodes) =
240− (Link nullAttr (addInlines nodes) (unpack url, unpack title) :)
241−addInline (Node _ (IMAGE url title) nodes) =
242− (Image nullAttr (addInlines nodes) (unpack url, unpack title) :)
243−addInline _ = id
229+addInline opts (Node _ EMPH nodes) =
230+ (Emph (addInlines opts nodes) :)
231+addInline opts (Node _ STRONG nodes) =
232+ (Strong (addInlines opts nodes) :)
233+addInline opts (Node _ STRIKETHROUGH nodes) =
234+ (Strikeout (addInlines opts nodes) :)
235+addInline opts (Node _ (LINK url title) nodes) =
236+ (Link nullAttr (addInlines opts nodes) (unpack url, unpack title) :)
237+addInline opts (Node _ (IMAGE url title) nodes) =
238+ (Image nullAttr (addInlines opts nodes) (unpack url, unpack title) :)
239+addInline _ _ = id