aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorAlexander Krotov <ilabdsf@gmail.com>2018-01-29 12:05:00 +0300
committerAlexander Krotov <ilabdsf@gmail.com>2018-01-29 12:07:40 +0300
commit37271fabeee917c085c9ea7f04b8c847b524db4a (patch)
treec97e36e48d0058d646d43322091fc80c27425cf4 /src
parentff31602267d2d8aebda319cd8f55ba5e1399bb1f (diff)
downloadpandoc-37271fabeee917c085c9ea7f04b8c847b524db4a.tar.gz
Muse reader: simplify block tag parsing code
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/Readers/Muse.hs33
1 files changed, 12 insertions, 21 deletions
diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs
index 6d9794f9e..c4175c4b2 100644
--- a/src/Text/Pandoc/Readers/Muse.hs
+++ b/src/Text/Pandoc/Readers/Muse.hs
@@ -110,19 +110,16 @@ htmlAttrToPandoc attrs = (ident, classes, keyvals)
classes = maybe [] words $ lookup "class" attrs
keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]
-parseHtmlContentWithAttrs :: PandocMonad m
- => String -> MuseParser m a -> MuseParser m (Attr, [a])
-parseHtmlContentWithAttrs tag parser = do
+parseHtmlContent :: PandocMonad m
+ => String -> MuseParser m (Attr, F Blocks)
+parseHtmlContent tag = do
(attr, content) <- htmlElement tag
parsedContent <- parseContent (content ++ "\n")
- return (attr, parsedContent)
+ return (attr, mconcat parsedContent)
where
- parseContent = parseFromString $ manyTill parser endOfContent
+ parseContent = parseFromString $ manyTill parseBlock endOfContent
endOfContent = try $ skipMany blankline >> skipSpaces >> eof
-parseHtmlContent :: PandocMonad m => String -> MuseParser m a -> MuseParser m [a]
-parseHtmlContent tag p = fmap snd (parseHtmlContentWithAttrs tag p)
-
commonPrefix :: String -> String -> String
commonPrefix _ [] = []
commonPrefix [] _ = []
@@ -277,30 +274,24 @@ literal = do
format (_, _, kvs) = fromMaybe "html" $ lookup "style" kvs
rawBlock (attrs, content) = B.rawBlock (format attrs) $ chop content
-blockTag :: PandocMonad m
- => (Blocks -> Blocks)
- -> String
- -> MuseParser m (F Blocks)
-blockTag f s = do
- res <- parseHtmlContent s parseBlock
- return $ f <$> mconcat res
-
-- <center> tag is ignored
centerTag :: PandocMonad m => MuseParser m (F Blocks)
-centerTag = blockTag id "center"
+centerTag = snd <$> parseHtmlContent "center"
-- <right> tag is ignored
rightTag :: PandocMonad m => MuseParser m (F Blocks)
-rightTag = blockTag id "right"
+rightTag = snd <$> parseHtmlContent "right"
quoteTag :: PandocMonad m => MuseParser m (F Blocks)
-quoteTag = withQuoteContext InDoubleQuote $ blockTag B.blockQuote "quote"
+quoteTag = do
+ res <- snd <$> withQuoteContext InDoubleQuote (parseHtmlContent "quote")
+ return $ B.blockQuote <$> res
-- <div> tag is supported by Emacs Muse, but not Amusewiki 2.025
divTag :: PandocMonad m => MuseParser m (F Blocks)
divTag = do
- (attrs, content) <- parseHtmlContentWithAttrs "div" parseBlock
- return $ B.divWith attrs <$> mconcat content
+ (attrs, content) <- parseHtmlContent "div"
+ return $ B.divWith attrs <$> content
verseLine :: PandocMonad m => MuseParser m (F Inlines)
verseLine = do