Muse reader: autonumber sections in the correct order

Parsing now stops at each section header to ensure the
header is registered before parsing of the next section starts.

1 files changed, 16 insertions, 4 deletions

diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs
index b251f2237..0b5d3dc1f 100644
--- a/src/Text/Pandoc/Readers/Muse.hs
+++ b/src/Text/Pandoc/Readers/Muse.hs
@@ -123,7 +123,9 @@ instance HasLogMessages MuseState where
 parseMuse :: PandocMonad m => MuseParser m Pandoc
 parseMuse = do
   many directive
-  blocks <- parseBlocks
+  firstSection <- parseBlocks
+  rest <- many parseSection
+  let blocks = mconcat $ (firstSection : rest)
   st <- getState
   let doc = runF (do Pandoc _ bs <- B.doc <$> blocks
                      meta <- museMeta st
@@ -252,17 +254,20 @@ directive = do
 
 -- ** Block parsers
 
+-- | Parse section contents until EOF or next header
 parseBlocks :: PandocMonad m
             => MuseParser m (F Blocks)
 parseBlocks =
   try (parseEnd <|>
+       nextSection <|>
        blockStart <|>
        listStart <|>
        paraStart)
   where
+    nextSection = mempty <$ lookAhead headingStart
     parseEnd = mempty <$ eof
-    blockStart = ((B.<>) <$> (emacsHeading <|> blockElements <|> emacsNoteBlock)
-                         <*> parseBlocks) <|> (uncurry (B.<>) <$> amuseHeadingUntil parseBlocks)
+    blockStart = ((B.<>) <$> (blockElements <|> emacsNoteBlock)
+                         <*> parseBlocks)
     listStart = do
       updateState (\st -> st { museInPara = False })
       uncurry (B.<>) <$> (anyListUntil parseBlocks <|> amuseNoteBlockUntil parseBlocks)
@@ -271,6 +276,13 @@ parseBlocks =
       uncurry (B.<>) . first (p indent) <$> paraUntil parseBlocks
       where p indent = if indent >= 2 && indent < 6 then fmap B.blockQuote else id
 
+-- | Parse section that starts with a header
+parseSection :: PandocMonad m
+             => MuseParser m (F Blocks)
+parseSection =
+  ((B.<>) <$> emacsHeading <*> parseBlocks) <|>
+  ((uncurry (B.<>)) <$> amuseHeadingUntil parseBlocks)
+
 parseBlocksTill :: PandocMonad m
                 => MuseParser m a
                 -> MuseParser m (F Blocks)
@@ -362,7 +374,7 @@ separator = try $ do
   return $ return B.horizontalRule
 
 headingStart :: PandocMonad m => MuseParser m (String, Int)
-headingStart = do
+headingStart = try $ do
   anchorId <- option "" $ try (parseAnchor <* manyTill spaceChar eol)
   getPosition >>= \pos -> guard (sourceColumn pos == 1)
   level <- fmap length $ many1 $ char '*'