diff options
| -rw-r--r-- | src/Text/Pandoc/Readers/Muse.hs | 42 | ||||
| -rw-r--r-- | test/Tests/Readers/Muse.hs | 22 |
2 files changed, 51 insertions, 13 deletions
diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index 102d8cbb9..9763652bc 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -263,8 +263,8 @@ parseBlocks = paraStart) where parseEnd = mempty <$ eof - blockStart = (B.<>) <$> (header <|> blockElements <|> emacsNoteBlock) - <*> parseBlocks + blockStart = ((B.<>) <$> (emacsHeading <|> blockElements <|> emacsNoteBlock) + <*> parseBlocks) <|> (uncurry (B.<>) <$> amuseHeadingUntil parseBlocks) listStart = do updateState (\st -> st { museInPara = False }) uncurry (B.<>) <$> (anyListUntil parseBlocks <|> amuseNoteBlockUntil parseBlocks) @@ -362,9 +362,10 @@ separator = try $ do eol return $ return B.horizontalRule --- | Parse a heading. -header :: PandocMonad m => MuseParser m (F Blocks) -header = try $ do +-- | Parse a single-line heading. +emacsHeading :: PandocMonad m => MuseParser m (F Blocks) +emacsHeading = try $ do + guardDisabled Ext_amuse anchorId <- option "" $ try (parseAnchor <* manyTill spaceChar eol) getPosition >>= \pos -> guard (sourceColumn pos == 1) level <- fmap length $ many1 $ char '*' @@ -374,6 +375,22 @@ header = try $ do attr <- registerHeader (anchorId, [], []) (runF content def) return $ B.headerWith attr level <$> content +-- | Parse a multi-line heading. +-- It is a Text::Amuse extension, Emacs Muse does not allow heading to span multiple lines. +amuseHeadingUntil :: PandocMonad m + => MuseParser m a -- ^ Terminator parser + -> MuseParser m (F Blocks, a) +amuseHeadingUntil end = try $ do + guardEnabled Ext_amuse + anchorId <- option "" $ try (parseAnchor <* manyTill spaceChar eol) + getPosition >>= \pos -> guard (sourceColumn pos == 1) + level <- fmap length $ many1 $ char '*' + guard $ level <= 5 + spaceChar + (content, e) <- paraContentsUntil end + attr <- registerHeader (anchorId, [], []) (runF content def) + return (B.headerWith attr level <$> content, e) + -- | Parse an example between @{{{@ and @}}}@. -- It is an Amusewiki extension influenced by Creole wiki, as described in @Text::Amuse@ documentation. example :: PandocMonad m => MuseParser m (F Blocks) @@ -461,6 +478,16 @@ verseTag = do commentTag :: PandocMonad m => MuseParser m (F Blocks) commentTag = htmlBlock "comment" >> return mempty +-- | Parse paragraph contents. +paraContentsUntil :: PandocMonad m + => MuseParser m a -- ^ Terminator parser + -> MuseParser m (F Inlines, a) +paraContentsUntil end = do + updateState (\st -> st { museInPara = True }) + (l, e) <- someUntil inline $ try (manyTill spaceChar eol >> end) + updateState (\st -> st { museInPara = False }) + return (trimInlinesF $ mconcat l, e) + -- | Parse a paragraph. paraUntil :: PandocMonad m => MuseParser m a -- ^ Terminator parser @@ -468,10 +495,7 @@ paraUntil :: PandocMonad m paraUntil end = do state <- getState guard $ not $ museInPara state - setState $ state{ museInPara = True } - (l, e) <- someUntil inline $ try (manyTill spaceChar eol >> end) - updateState (\st -> st { museInPara = False }) - return (fmap B.para $ trimInlinesF $ mconcat l, e) + first (fmap B.para) <$> paraContentsUntil end noteMarker :: PandocMonad m => MuseParser m String noteMarker = try $ do diff --git a/test/Tests/Readers/Muse.hs b/test/Tests/Readers/Muse.hs index 77b18e066..11eebbdc0 100644 --- a/test/Tests/Readers/Muse.hs +++ b/test/Tests/Readers/Muse.hs @@ -558,18 +558,32 @@ tests = ] =?> headerWith ("bar",[],[]) 2 "Foo" , "Headers don't consume anchors separated with a blankline" =: - T.unlines [ "** Foo" - , "" + T.unlines [ "; A comment to make sure anchor is not parsed as a directive" , "#bar" + , "" + , "** Foo" + ] =?> + para (spanWith ("bar", [], []) mempty) <> + header 2 "Foo" + , "Headers terminate paragraph" =: + T.unlines [ "foo" + , "* bar" ] =?> - header 2 "Foo" <> - para (spanWith ("bar", [], []) mempty) + para "foo" <> header 1 "bar" , "Headers terminate lists" =: T.unlines [ " - foo" , "* bar" ] =?> bulletList [ para "foo" ] <> header 1 "bar" + , test emacsMuse "Paragraphs terminate Emacs Muse headers" + (T.unlines [ "* Foo" + , "bar" + ] =?> header 1 "Foo" <> para "bar") + , "Paragraphs don't terminate Text::Amuse headers" =: + T.unlines [ "* Foo" + , "bar" + ] =?> header 1 "Foo\nbar" ] , testGroup "Directives" [ "Title" =: |