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.

Author: Alexander Krotov

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 '*'

test/Tests/Readers/Muse.hs

@@ -625,6 +625,18 @@ tests =
           T.unlines [ "* Foo"
                     , "bar"
                     ] =?> header 1 "Foo\nbar"
+        , test (purely $ readMuse def { readerExtensions = extensionsFromList [Ext_amuse, Ext_auto_identifiers]})
+               "Auto identifiers"
+          (T.unlines [ "* foo"
+                     , "** Foo"
+                     , "* bar"
+                     , "** foo"
+                     , "* foo"
+                     ] =?> headerWith ("foo",[],[]) 1 "foo" <>
+                           headerWith ("foo-1",[],[]) 2 "Foo" <>
+                           headerWith ("bar",[],[]) 1 "bar" <>
+                           headerWith ("foo-2",[],[]) 2 "foo" <>
+                           headerWith ("foo-3",[],[]) 1 "foo")
         ]
       , testGroup "Directives"
         [ "Title" =: