From 5f57094a47c18d1849f7cd5e9306bf05d6187881 Mon Sep 17 00:00:00 2001
From: Alexander Krotov <ilabdsf@gmail.com>
Date: Thu, 18 Jan 2018 14:50:28 +0300
Subject: Muse reader: refactor definition list parsing

Test with wrong indentation is removed,
because now it is parsed as nested lists.
Emacs Muse and Text::Amuse don't have the same
behavior anyway.
---
 src/Text/Pandoc/Readers/Muse.hs | 32 +++++++++++++++-----------------
 1 file changed, 15 insertions(+), 17 deletions(-)

(limited to 'src')

diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs
index 5d032608c..b06b6e550 100644
--- a/src/Text/Pandoc/Readers/Muse.hs
+++ b/src/Text/Pandoc/Readers/Muse.hs
@@ -422,13 +422,17 @@ withListContext p = do
   updateState (\st -> st {stateParserContext = oldContext})
   return parsed
 
+listItemContents' :: PandocMonad m => Int -> MuseParser m (F Blocks)
+listItemContents' col = do
+  first <- try $ withListContext parseBlock
+  rest <- many $ try (skipMany blankline >> indentWith col >> withListContext parseBlock)
+  return $ mconcat (first : rest)
+
 listItemContents :: PandocMonad m => MuseParser m (F Blocks)
 listItemContents = do
   pos <- getPosition
   let col = sourceColumn pos - 1
-  first <- try $ withListContext parseBlock
-  rest <- many $ try (skipMany blankline >> indentWith col >> withListContext parseBlock)
-  return $ mconcat (first : rest)
+  listItemContents' col
 
 listItem :: PandocMonad m => Int -> MuseParser m () -> MuseParser m (F Blocks)
 listItem n p = try $ do
@@ -466,25 +470,19 @@ orderedList = try $ do
 
 definitionListItem :: PandocMonad m => MuseParser m (F (Inlines, [Blocks]))
 definitionListItem = try $ do
-  rawTerm <- termParser
+  guardDisabled Ext_amuse <|> void spaceChar -- Initial space is required by Amusewiki, but not Emacs Muse
+  many spaceChar
+  pos <- getPosition
+  rawTerm <- many1Till (noneOf "\n") (lookAhead (void (try (spaceChar >> string "::"))))
   term <- parseFromString (trimInlinesF . mconcat <$> many inline) rawTerm
   many1 spaceChar
   string "::"
-  firstLine <- manyTill anyChar eol
-  restLines <- manyTill anyLine endOfListItemElement
-  let lns = dropWhile (== ' ') firstLine : restLines
-  lineContent <- parseFromString (withListContext parseBlocks) $ unlines lns
-  pure $ do lineContent' <- lineContent
+  void spaceChar <|> lookAhead eol
+  contents <- listItemContents' $ sourceColumn pos
+  optionMaybe blankline
+  pure $ do lineContent' <- contents
             term' <- term
             pure (term', [lineContent'])
-  where
-    termParser = (guardDisabled Ext_amuse <|> void spaceChar) >> -- Initial space is required by Amusewiki, but not Emacs Muse
-                 many spaceChar >>
-                 many1Till (noneOf "\n") (lookAhead (void (try (spaceChar >> string "::"))))
-    endOfInput = lookAhead $ try $ skipMany blankline >> skipSpaces >> eof
-    twoBlankLines = try $ blankline >> skipMany1 blankline
-    newDefinitionListItem = try $ void termParser
-    endOfListItemElement = lookAhead $ endOfInput <|> newDefinitionListItem <|> twoBlankLines
 
 definitionListItems :: PandocMonad m => MuseParser m (F [(Inlines, [Blocks])])
 definitionListItems = sequence <$> many1 definitionListItem
-- 
cgit v1.2.3