git.iko.soy/typeable/pandoc
on master help sign in
Muse reader: simplify block tag parsing code
commit37271fabeee917c085c9ea7f04b8c847b524db4a authorAlexander Krotov <ilabdsf@gmail.com> dateMon 29 Jan 2018, 12:05 (9 years ago) parentff31602
1 file changed+12−21
src/Text/Pandoc/Readers/Muse.hs+12−21
src/Text/Pandoc/Readers/Muse.hs+12−21
@@ -110,19 +110,16 @@ htmlAttrToPandoc attrs = (ident, classes, keyvals)
110110 classes = maybe [] words $ lookup "class" attrs
111111 keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]
112112
113−parseHtmlContentWithAttrs :: PandocMonad m
114− => String -> MuseParser m a -> MuseParser m (Attr, [a])
115−parseHtmlContentWithAttrs tag parser = do
113+parseHtmlContent :: PandocMonad m
114+ => String -> MuseParser m (Attr, F Blocks)
115+parseHtmlContent tag = do
116116 (attr, content) <- htmlElement tag
117117 parsedContent <- parseContent (content ++ "\n")
118− return (attr, parsedContent)
118+ return (attr, mconcat parsedContent)
119119 where
120− parseContent = parseFromString $ manyTill parser endOfContent
120+ parseContent = parseFromString $ manyTill parseBlock endOfContent
121121 endOfContent = try $ skipMany blankline >> skipSpaces >> eof
122122
123−parseHtmlContent :: PandocMonad m => String -> MuseParser m a -> MuseParser m [a]
124−parseHtmlContent tag p = fmap snd (parseHtmlContentWithAttrs tag p)
125−
126123commonPrefix :: String -> String -> String
127124commonPrefix _ [] = []
128125commonPrefix [] _ = []
@@ -277,30 +274,24 @@ literal = do
277274 format (_, _, kvs) = fromMaybe "html" $ lookup "style" kvs
278275 rawBlock (attrs, content) = B.rawBlock (format attrs) $ chop content
279276
280−blockTag :: PandocMonad m
281− => (Blocks -> Blocks)
282− -> String
283− -> MuseParser m (F Blocks)
284−blockTag f s = do
285− res <- parseHtmlContent s parseBlock
286− return $ f <$> mconcat res
287−
288277-- <center> tag is ignored
289278centerTag :: PandocMonad m => MuseParser m (F Blocks)
290−centerTag = blockTag id "center"
279+centerTag = snd <$> parseHtmlContent "center"
291280
292281-- <right> tag is ignored
293282rightTag :: PandocMonad m => MuseParser m (F Blocks)
294−rightTag = blockTag id "right"
283+rightTag = snd <$> parseHtmlContent "right"
295284
296285quoteTag :: PandocMonad m => MuseParser m (F Blocks)
297−quoteTag = withQuoteContext InDoubleQuote $ blockTag B.blockQuote "quote"
286+quoteTag = do
287+ res <- snd <$> withQuoteContext InDoubleQuote (parseHtmlContent "quote")
288+ return $ B.blockQuote <$> res
298289
299290-- <div> tag is supported by Emacs Muse, but not Amusewiki 2.025
300291divTag :: PandocMonad m => MuseParser m (F Blocks)
301292divTag = do
302− (attrs, content) <- parseHtmlContentWithAttrs "div" parseBlock
303− return $ B.divWith attrs <$> mconcat content
293+ (attrs, content) <- parseHtmlContent "div"
294+ return $ B.divWith attrs <$> content
304295
305296verseLine :: PandocMonad m => MuseParser m (F Inlines)
306297verseLine = do