From e6f767b581742343bd7319bcc4c3632e18c58a70 Mon Sep 17 00:00:00 2001
From: Alexander <ilabdsf@gmail.com>
Date: Fri, 25 Aug 2017 17:09:28 +0300
Subject: Muse reader: parse <verse> tag (#3872)

---
 src/Text/Pandoc/Readers/Muse.hs | 22 +++++++++++++++++++++-
 1 file changed, 21 insertions(+), 1 deletion(-)

(limited to 'src')

diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs
index 74622a639..77f75c8c6 100644
--- a/src/Text/Pandoc/Readers/Muse.hs
+++ b/src/Text/Pandoc/Readers/Muse.hs
@@ -32,7 +32,7 @@ TODO:
 - {{{ }}} syntax for <example>
 - Page breaks (five "*")
 - Headings with anchors (make it round trip with Muse writer)
-- <verse> and ">"
+- Verse markup (">")
 - Org tables
 - table.el tables
 - Images with attributes (floating and width)
@@ -180,6 +180,7 @@ blockElements = choice [ comment
                        , centerTag
                        , rightTag
                        , quoteTag
+                       , verseTag
                        , bulletList
                        , orderedList
                        , definitionList
@@ -244,6 +245,25 @@ rightTag = blockTag id "right"
 quoteTag :: PandocMonad m => MuseParser m (F Blocks)
 quoteTag = withQuoteContext InDoubleQuote $ blockTag B.blockQuote "quote"
 
+verseLine :: PandocMonad m => MuseParser m String
+verseLine = do
+  line <- anyLine <|> many1Till anyChar eof
+  let (white, rest) = span (== ' ') line
+  return $ replicate (length white) '\160' ++ rest
+
+verseLines :: PandocMonad m => MuseParser m (F Blocks)
+verseLines = do
+  optionMaybe blankline -- Skip blankline after opening tag on separate line
+  lns <- many verseLine
+  lns' <- mapM (parseFromString' (trimInlinesF . mconcat <$> many inline)) lns
+  return $ B.lineBlock <$> sequence lns'
+
+verseTag :: PandocMonad m => MuseParser m (F Blocks)
+verseTag = do
+  (_, content) <- htmlElement "verse"
+  parsedContent <- parseFromString verseLines content
+  return parsedContent
+
 commentTag :: PandocMonad m => MuseParser m (F Blocks)
 commentTag = parseHtmlContent "comment" anyChar >> return mempty
 
-- 
cgit v1.2.3