@@ -43,44 +43,34 @@ import Text.Pandoc.Definition
43import Text.Pandoc.Emoji (emojis)
43import Text.Pandoc.Emoji (emojis)
44import Text.Pandoc.Options
44import Text.Pandoc.Options
45import Text.Pandoc.Shared (stringify)
45import Text.Pandoc.Shared (stringify)
46−import Text.Pandoc.Walk (walkM, walk)
46+import Text.Pandoc.Walk (walkM)
48-- | Parse a CommonMark formatted string into a 'Pandoc' structure.
48-- | Parse a CommonMark formatted string into a 'Pandoc' structure.
49readCommonMark :: PandocMonad m => ReaderOptions -> Text -> m Pandoc
49readCommonMark :: PandocMonad m => ReaderOptions -> Text -> m Pandoc
50readCommonMark opts s = return $
50readCommonMark opts s = return $
51− (if enabled Ext_gfm_auto_identifiers
51+ (if enabled Ext_gfm_auto_identifiers opts
52 then addHeaderIdentifiers
52 then addHeaderIdentifiers
53 else id) $
53 else id) $
54− (if enabled Ext_emoji
57− (if enabled Ext_hard_line_breaks
58− then walk softToHardBreaks
60− nodeToPandoc $ commonmarkToNode opts' exts s
54+ nodeToPandoc opts $ commonmarkToNode opts' exts s
61− where opts' = [ optSmart | enabled Ext_smart ]
55+ where opts' = [ optSmart | enabled Ext_smart opts ]
62− exts = [ extStrikethrough | enabled Ext_strikeout ] ++
56+ exts = [ extStrikethrough | enabled Ext_strikeout opts ] ++
63− [ extTable | enabled Ext_pipe_tables ] ++
57+ [ extTable | enabled Ext_pipe_tables opts ] ++
64− [ extAutolink | enabled Ext_autolink_bare_uris ]
58+ [ extAutolink | enabled Ext_autolink_bare_uris opts ]
60+-- | Returns True if the given extension is enabled.
61+enabled :: Extension -> ReaderOptions -> Bool
65− enabled x = extensionEnabled x (readerExtensions opts)
62+enabled ext opts = ext `extensionEnabled` (readerExtensions opts)
67−softToHardBreaks :: Inline -> Inline
64+convertEmojis :: String -> String
68−softToHardBreaks SoftBreak = LineBreak
69−softToHardBreaks x = x
71−addEmojis :: Pandoc -> Pandoc
73− where go (Str xs) = Str (convertEmojis xs)
75− convertEmojis (':':xs) =
65+convertEmojis (':':xs) =
76− case break (==':') xs of
66+ case break (==':') xs of
77− (ys,':':zs) ->
67+ (ys,':':zs) ->
78− case Map.lookup ys emojis of
68+ case Map.lookup ys emojis of
79− Just s -> s ++ convertEmojis zs
69+ Just s -> s ++ convertEmojis zs
80− Nothing -> ':' : ys ++ convertEmojis (':':zs)
70+ Nothing -> ':' : ys ++ convertEmojis (':':zs)
81− _ -> ':':xs
71+ _ -> ':':xs
82− convertEmojis (x:xs) = x : convertEmojis xs
72+convertEmojis (x:xs) = x : convertEmojis xs
83− convertEmojis [] = []
73+convertEmojis [] = []
85addHeaderIdentifiers :: Pandoc -> Pandoc
75addHeaderIdentifiers :: Pandoc -> Pandoc
86addHeaderIdentifiers doc = evalState (walkM addHeaderId doc) mempty
76addHeaderIdentifiers doc = evalState (walkM addHeaderId doc) mempty
@@ -105,34 +95,35 @@ toIdent = map (\c -> if isSpace c then '-' else c)
105 c == '_' || c == '-')
95 c == '_' || c == '-')
106 . map toLower . stringify
96 . map toLower . stringify
108−nodeToPandoc :: Node -> Pandoc
98+nodeToPandoc :: ReaderOptions -> Node -> Pandoc
109−nodeToPandoc (Node _ DOCUMENT nodes) =
99+nodeToPandoc opts (Node _ DOCUMENT nodes) =
110− Pandoc nullMeta $ foldr addBlock [] nodes
100+ Pandoc nullMeta $ foldr (addBlock opts) [] nodes
111−nodeToPandoc n = -- shouldn't happen
101+nodeToPandoc opts n = -- shouldn't happen
112− Pandoc nullMeta $ foldr addBlock [] [n]
102+ Pandoc nullMeta $ foldr (addBlock opts) [] [n]
114−addBlocks :: [Node] -> [Block]
104+addBlocks :: ReaderOptions -> [Node] -> [Block]
115−addBlocks = foldr addBlock []
105+addBlocks opts = foldr (addBlock opts) []
117−addBlock :: Node -> [Block] -> [Block]
107+addBlock :: ReaderOptions -> Node -> [Block] -> [Block]
118−addBlock (Node _ PARAGRAPH nodes) =
108+addBlock opts (Node _ PARAGRAPH nodes) =
119− (Para (addInlines nodes) :)
109+ (Para (addInlines opts nodes) :)
120−addBlock (Node _ THEMATIC_BREAK _) =
110+addBlock _ (Node _ THEMATIC_BREAK _) =
121 (HorizontalRule :)
111 (HorizontalRule :)
122−addBlock (Node _ BLOCK_QUOTE nodes) =
112+addBlock opts (Node _ BLOCK_QUOTE nodes) =
123− (BlockQuote (addBlocks nodes) :)
113+ (BlockQuote (addBlocks opts nodes) :)
124−addBlock (Node _ (HTML_BLOCK t) _) =
114+addBlock opts (Node _ (HTML_BLOCK t) _)
125− (RawBlock (Format "html") (unpack t) :)
115+ | enabled Ext_raw_html opts = (RawBlock (Format "html") (unpack t) :)
126-- Note: the cmark parser will never generate CUSTOM_BLOCK,
117-- Note: the cmark parser will never generate CUSTOM_BLOCK,
127-- so we don't need to handle it:
118-- so we don't need to handle it:
128−addBlock (Node _ (CUSTOM_BLOCK _onEnter _onExit) _nodes) =
119+addBlock _ (Node _ (CUSTOM_BLOCK _onEnter _onExit) _nodes) =
130−addBlock (Node _ (CODE_BLOCK info t) _) =
121+addBlock _ (Node _ (CODE_BLOCK info t) _) =
131 (CodeBlock ("", take 1 (words (unpack info)), []) (unpack t) :)
122 (CodeBlock ("", take 1 (words (unpack info)), []) (unpack t) :)
132−addBlock (Node _ (HEADING lev) nodes) =
123+addBlock opts (Node _ (HEADING lev) nodes) =
133− (Header lev ("",[],[]) (addInlines nodes) :)
124+ (Header lev ("",[],[]) (addInlines opts nodes) :)
134−addBlock (Node _ (LIST listAttrs) nodes) =
125+addBlock opts (Node _ (LIST listAttrs) nodes) =
135− (constructor (map (setTightness . addBlocks . children) nodes) :)
126+ (constructor (map (setTightness . addBlocks opts . children) nodes) :)
136 where constructor = case listType listAttrs of
127 where constructor = case listType listAttrs of
137 BULLET_LIST -> BulletList
128 BULLET_LIST -> BulletList
138 ORDERED_LIST -> OrderedList
129 ORDERED_LIST -> OrderedList
@@ -146,7 +137,7 @@ addBlock (Node _ (LIST listAttrs) nodes) =
146 delim = case listDelim listAttrs of
137 delim = case listDelim listAttrs of
147 PERIOD_DELIM -> Period
138 PERIOD_DELIM -> Period
148 PAREN_DELIM -> OneParen
139 PAREN_DELIM -> OneParen
149−addBlock (Node _ (TABLE alignments) nodes) = do
140+addBlock opts (Node _ (TABLE alignments) nodes) = do
150 (Table [] aligns widths headers rows :)
141 (Table [] aligns widths headers rows :)
151 where aligns = map fromTableCellAlignment alignments
142 where aligns = map fromTableCellAlignment alignments
152 fromTableCellAlignment NoAlignment = AlignDefault
143 fromTableCellAlignment NoAlignment = AlignDefault
@@ -169,12 +160,12 @@ addBlock (Node _ (TABLE alignments) nodes) = do
169 toRow (Node _ t _) = error $ "toRow encountered non-row " ++ show t
160 toRow (Node _ t _) = error $ "toRow encountered non-row " ++ show t
170 toCell (Node _ TABLE_CELL []) = []
161 toCell (Node _ TABLE_CELL []) = []
171 toCell (Node _ TABLE_CELL (n:ns))
162 toCell (Node _ TABLE_CELL (n:ns))
172− | isBlockNode n = addBlocks (n:ns)
163+ | isBlockNode n = addBlocks opts (n:ns)
173− | otherwise = [Plain (addInlines (n:ns))]
164+ | otherwise = [Plain (addInlines opts (n:ns))]
174 toCell (Node _ t _) = error $ "toCell encountered non-cell " ++ show t
165 toCell (Node _ t _) = error $ "toCell encountered non-cell " ++ show t
175−addBlock (Node _ TABLE_ROW _) = id -- handled in TABLE
166+addBlock _ (Node _ TABLE_ROW _) = id -- handled in TABLE
176−addBlock (Node _ TABLE_CELL _) = id -- handled in TABLE
167+addBlock _ (Node _ TABLE_CELL _) = id -- handled in TABLE
177−addBlock _ = id
168+addBlock _ _ = id
179isBlockNode :: Node -> Bool
170isBlockNode :: Node -> Bool
180isBlockNode (Node _ nodetype _) =
171isBlockNode (Node _ nodetype _) =
@@ -207,11 +198,11 @@ isBlockNode (Node _ nodetype _) =
207children :: Node -> [Node]
198children :: Node -> [Node]
208children (Node _ _ ns) = ns
199children (Node _ _ ns) = ns
210−addInlines :: [Node] -> [Inline]
201+addInlines :: ReaderOptions -> [Node] -> [Inline]
211−addInlines = foldr addInline []
202+addInlines opts = foldr (addInline opts) []
213−addInline :: Node -> [Inline] -> [Inline]
204+addInline :: ReaderOptions -> Node -> [Inline] -> [Inline]
214−addInline (Node _ (TEXT t) _) = (map toinl clumps ++)
205+addInline opts (Node _ (TEXT t) _) = (map toinl clumps ++)
215 where raw = unpack t
206 where raw = unpack t
216 clumps = groupBy samekind raw
207 clumps = groupBy samekind raw
217 samekind ' ' ' ' = True
208 samekind ' ' ' ' = True
@@ -219,25 +210,30 @@ addInline (Node _ (TEXT t) _) = (map toinl clumps ++)
219 samekind _ ' ' = False
210 samekind _ ' ' = False
220 samekind _ _ = True
211 samekind _ _ = True
221 toinl (' ':_) = Space
212 toinl (' ':_) = Space
222− toinl xs = Str xs
213+ toinl xs = Str $ if enabled Ext_emoji opts
214+ then convertEmojis xs
223−addInline (Node _ LINEBREAK _) = (LineBreak :)
216+addInline _ (Node _ LINEBREAK _) = (LineBreak :)
224−addInline (Node _ SOFTBREAK _) = (SoftBreak :)
217+addInline opts (Node _ SOFTBREAK _)
218+ | enabled Ext_hard_line_breaks opts = (LineBreak :)
219+ | otherwise = (SoftBreak :)
225−addInline (Node _ (HTML_INLINE t) _) =
220+addInline opts (Node _ (HTML_INLINE t) _)
226− (RawInline (Format "html") (unpack t) :)
221+ | enabled Ext_raw_html opts = (RawInline (Format "html") (unpack t) :)
227-- Note: the cmark parser will never generate CUSTOM_BLOCK,
223-- Note: the cmark parser will never generate CUSTOM_BLOCK,
228-- so we don't need to handle it:
224-- so we don't need to handle it:
229−addInline (Node _ (CUSTOM_INLINE _onEnter _onExit) _nodes) =
225+addInline _ (Node _ (CUSTOM_INLINE _onEnter _onExit) _nodes) =
231−addInline (Node _ (CODE t) _) =
227+addInline _ (Node _ (CODE t) _) =
232 (Code ("",[],[]) (unpack t) :)
228 (Code ("",[],[]) (unpack t) :)
233−addInline (Node _ EMPH nodes) =
229+addInline opts (Node _ EMPH nodes) =
234− (Emph (addInlines nodes) :)
230+ (Emph (addInlines opts nodes) :)
235−addInline (Node _ STRONG nodes) =
231+addInline opts (Node _ STRONG nodes) =
236− (Strong (addInlines nodes) :)
232+ (Strong (addInlines opts nodes) :)
237−addInline (Node _ STRIKETHROUGH nodes) =
233+addInline opts (Node _ STRIKETHROUGH nodes) =
238− (Strikeout (addInlines nodes) :)
234+ (Strikeout (addInlines opts nodes) :)
239−addInline (Node _ (LINK url title) nodes) =
235+addInline opts (Node _ (LINK url title) nodes) =
240− (Link nullAttr (addInlines nodes) (unpack url, unpack title) :)
236+ (Link nullAttr (addInlines opts nodes) (unpack url, unpack title) :)
241−addInline (Node _ (IMAGE url title) nodes) =
237+addInline opts (Node _ (IMAGE url title) nodes) =
242− (Image nullAttr (addInlines nodes) (unpack url, unpack title) :)
238+ (Image nullAttr (addInlines opts nodes) (unpack url, unpack title) :)
243−addInline _ = id
239+addInline _ _ = id