diff options
| -rw-r--r-- | src/Text/Pandoc/Readers/Muse.hs | 20 | ||||
| -rw-r--r-- | test/Tests/Readers/Muse.hs | 12 |
2 files changed, 28 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 '*' diff --git a/test/Tests/Readers/Muse.hs b/test/Tests/Readers/Muse.hs index ca3324e34..edb8ba21a 100644 --- a/test/Tests/Readers/Muse.hs +++ b/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" =: |