From ca4ee9940ce55fc640ba21dbf2ccde9b048216bb Mon Sep 17 00:00:00 2001 From: Alexander Krotov Date: Tue, 9 Oct 2018 16:14:37 +0300 Subject: Muse reader: rewrite parseHtmlContent, verseTag and lineBlock in applicative style --- src/Text/Pandoc/Readers/Muse.hs | 30 ++++++++++++------------------ 1 file changed, 12 insertions(+), 18 deletions(-) (limited to 'src/Text/Pandoc/Readers') diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index f3311c05e..409548cb3 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -211,13 +211,11 @@ htmlAttrToPandoc attrs = (ident, classes, keyvals) parseHtmlContent :: PandocMonad m => String -- ^ Tag name -> MuseParser m (Attr, F Blocks) -parseHtmlContent tag = try $ do - indent <- getIndent - attr <- openTag tag - manyTill spaceChar eol - content <- parseBlocksTill $ try $ count indent spaceChar *> closeTag tag - manyTill spaceChar eol -- closing tag must be followed by optional whitespace and newline - return (htmlAttrToPandoc attr, content) +parseHtmlContent tag = try $ getIndent >>= \indent -> (,) + <$> fmap htmlAttrToPandoc (openTag tag) + <* manyTill spaceChar eol + <*> parseBlocksTill (try $ count indent spaceChar *> closeTag tag) + <* manyTill spaceChar eol -- closing tag must be followed by optional whitespace and newline -- ** Directive parsers @@ -463,13 +461,11 @@ verseLine = (<>) -- | Parse @\@ tag. verseTag :: PandocMonad m => MuseParser m (F Blocks) -verseTag = try $ do - indent <- getIndent - openTag "verse" - manyTill spaceChar eol - content <- sequence <$> manyTill (count indent spaceChar *> verseLine) (try $ count indent spaceChar *> closeTag "verse") - manyTill spaceChar eol - return $ B.lineBlock <$> content +verseTag = try $ getIndent >>= \indent -> fmap B.lineBlock . sequence + <$ openTag "verse" + <* manyTill spaceChar eol + <*> manyTill (count indent spaceChar *> verseLine) (try $ count indent spaceChar *> closeTag "verse") + <* manyTill spaceChar eol -- | Parse @\@ tag. commentTag :: PandocMonad m => MuseParser m (F Blocks) @@ -544,10 +540,8 @@ emacsNoteBlock = try $ do -- | Parse a line block indicated by @\'>\'@ characters. lineBlock :: PandocMonad m => MuseParser m (F Blocks) -lineBlock = try $ do - indent <- getIndent - lns <- (blankVerseLine <|> nonblankVerseLine) `sepBy1'` try (indentWith indent) - return $ B.lineBlock <$> sequence lns +lineBlock = try $ getIndent >>= \indent -> fmap B.lineBlock . sequence + <$> (blankVerseLine <|> nonblankVerseLine) `sepBy1'` try (indentWith indent) where blankVerseLine = try $ mempty <$ char '>' <* blankline nonblankVerseLine = try (string "> ") *> verseLine -- cgit v1.2.3