aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Text/Pandoc/Readers/Muse.hs20
-rw-r--r--test/Tests/Readers/Muse.hs12
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" =: