diff options
Diffstat (limited to 'src/Text')
-rw-r--r-- | src/Text/Pandoc/Readers/Muse.hs | 40 |
1 files changed, 19 insertions, 21 deletions
diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index 8a065196f..e8e309115 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -195,20 +195,6 @@ openTag tag = try $ closeTag :: PandocMonad m => String -> MuseParser m () closeTag tag = try $ string "</" *> string tag *> void (char '>') --- | Parse HTML tag, returning its attributes and literal contents. -htmlElement :: PandocMonad m - => String -- ^ Tag name - -> MuseParser m (Attr, String) -htmlElement tag = try $ (,) - <$> (htmlAttrToPandoc <$> openTag tag) - <*> manyTill anyChar (closeTag tag) - -htmlBlock :: PandocMonad m - => String -- ^ Tag name - -> MuseParser m (Attr, String) -htmlBlock tag = try $ - many spaceChar *> htmlElement tag <* manyTill spaceChar eol - -- | Convert HTML attributes to Pandoc 'Attr' htmlAttrToPandoc :: [Attribute String] -> Attr htmlAttrToPandoc attrs = (ident, classes, keyvals) @@ -415,9 +401,11 @@ example = try $ pure . B.codeBlock -- | Parse an @\<example>@ tag. exampleTag :: PandocMonad m => MuseParser m (F Blocks) -exampleTag = try $ do - (attr, contents) <- htmlBlock "example" - return $ return $ B.codeBlockWith attr $ rchop $ intercalate "\n" $ dropSpacePrefix $ splitOn "\n" $ lchop contents +exampleTag = try $ fmap pure $ B.codeBlockWith + <$ many spaceChar + <*> (htmlAttrToPandoc <$> openTag "example") + <*> (rchop . intercalate "\n" . dropSpacePrefix . splitOn "\n" . lchop <$> manyTill anyChar (closeTag "example")) + <* manyTill spaceChar eol -- | Parse a @\<literal>@ tag as a raw block. -- For 'RawInline' @\<literal>@ parser, see 'inlineLiteralTag'. @@ -484,7 +472,11 @@ verseTag = try $ do -- | Parse @\<comment>@ tag. commentTag :: PandocMonad m => MuseParser m (F Blocks) -commentTag = mempty <$ htmlBlock "comment" +commentTag = try $ mempty + <$ many spaceChar + <* openTag "comment" + <* manyTill anyChar (closeTag "comment") + <* manyTill spaceChar eol -- | Parse paragraph contents. paraContentsUntil :: PandocMonad m @@ -892,7 +884,9 @@ strikeoutTag = fmap B.strikeout <$> inlineTag "del" -- | Parse @\<verbatim>@ tag. verbatimTag :: PandocMonad m => MuseParser m (F Inlines) -verbatimTag = return . B.text . snd <$> htmlElement "verbatim" +verbatimTag = return . B.text + <$ openTag "verbatim" + <*> manyTill anyChar (closeTag "verbatim") -- | Parse @\<class>@ tag. classTag :: PandocMonad m => MuseParser m (F Inlines) @@ -918,12 +912,16 @@ code = try $ do -- | Parse @\<code>@ tag. codeTag :: PandocMonad m => MuseParser m (F Inlines) -codeTag = return . uncurry B.codeWith <$> htmlElement "code" +codeTag = fmap pure $ B.codeWith + <$> (htmlAttrToPandoc <$> openTag "code") + <*> manyTill anyChar (closeTag "code") -- | Parse @\<math>@ tag. -- @\<math>@ tag is an Emacs Muse extension enabled by @(require 'muse-latex2png)@ mathTag :: PandocMonad m => MuseParser m (F Inlines) -mathTag = return . B.math . snd <$> htmlElement "math" +mathTag = return . B.math + <$ openTag "math" + <*> manyTill anyChar (closeTag "math") -- | Parse inline @\<literal>@ tag as a raw inline. inlineLiteralTag :: PandocMonad m => MuseParser m (F Inlines) |