17b0499 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Muse reader: add support for Text:Amuse multiline headings

17b0499Alexander Krotov9 years ago

src/Text/Pandoc/Readers/Muse.hs+33−9

compare with master

unifiedsplit

@@ -263,8 +263,8 @@ parseBlocks =

263 paraStart)

264 where

265 parseEnd = mempty <$ eof

266− blockStart = (B.<>) <$> (header <|> blockElements <|> emacsNoteBlock)

266+ blockStart = ((B.<>) <$> (emacsHeading <|> blockElements <|> emacsNoteBlock)

267− <*> parseBlocks

267+ <*> parseBlocks) <|> (uncurry (B.<>) <$> amuseHeadingUntil parseBlocks)

268 listStart = do

269 updateState (\st -> st { museInPara = False })

270 uncurry (B.<>) <$> (anyListUntil parseBlocks <|> amuseNoteBlockUntil parseBlocks)

@@ -362,9 +362,10 @@ separator = try $ do

362 eol

363 return $ return B.horizontalRule

364

365−-- | Parse a heading.

365+-- | Parse a single-line heading.

366−header :: PandocMonad m => MuseParser m (F Blocks)

366+emacsHeading :: PandocMonad m => MuseParser m (F Blocks)

367−header = try $ do

367+emacsHeading = try $ do

368+ guardDisabled Ext_amuse

368 anchorId <- option "" $ try (parseAnchor <* manyTill spaceChar eol)

369 anchorId <- option "" $ try (parseAnchor <* manyTill spaceChar eol)

369 getPosition >>= \pos -> guard (sourceColumn pos == 1)

370 getPosition >>= \pos -> guard (sourceColumn pos == 1)

370 level <- fmap length $ many1 $ char '*'

371 level <- fmap length $ many1 $ char '*'

@@ -374,6 +375,22 @@ header = try $ do

374 attr <- registerHeader (anchorId, [], []) (runF content def)

375 attr <- registerHeader (anchorId, [], []) (runF content def)

375 return $ B.headerWith attr level <$> content

376 return $ B.headerWith attr level <$> content

376

377

378+-- | Parse a multi-line heading.

379+-- It is a Text::Amuse extension, Emacs Muse does not allow heading to span multiple lines.

380+amuseHeadingUntil :: PandocMonad m

381+ => MuseParser m a -- ^ Terminator parser

382+ -> MuseParser m (F Blocks, a)

383+amuseHeadingUntil end = try $ do

384+ guardEnabled Ext_amuse

385+ anchorId <- option "" $ try (parseAnchor <* manyTill spaceChar eol)

386+ getPosition >>= \pos -> guard (sourceColumn pos == 1)

387+ level <- fmap length $ many1 $ char '*'

388+ guard $ level <= 5

389+ spaceChar

390+ (content, e) <- paraContentsUntil end

391+ attr <- registerHeader (anchorId, [], []) (runF content def)

392+ return (B.headerWith attr level <$> content, e)

393+

377-- | Parse an example between @{{{@ and @}}}@.

394-- | Parse an example between @{{{@ and @}}}@.

378-- It is an Amusewiki extension influenced by Creole wiki, as described in @Text::Amuse@ documentation.

395-- It is an Amusewiki extension influenced by Creole wiki, as described in @Text::Amuse@ documentation.

379example :: PandocMonad m => MuseParser m (F Blocks)

396example :: PandocMonad m => MuseParser m (F Blocks)

@@ -461,6 +478,16 @@ verseTag = do

461commentTag :: PandocMonad m => MuseParser m (F Blocks)

478commentTag :: PandocMonad m => MuseParser m (F Blocks)

462commentTag = htmlBlock "comment" >> return mempty

479commentTag = htmlBlock "comment" >> return mempty

463

480

481+-- | Parse paragraph contents.

482+paraContentsUntil :: PandocMonad m

483+ => MuseParser m a -- ^ Terminator parser

484+ -> MuseParser m (F Inlines, a)

485+paraContentsUntil end = do

486+ updateState (\st -> st { museInPara = True })

487+ (l, e) <- someUntil inline $ try (manyTill spaceChar eol >> end)

488+ updateState (\st -> st { museInPara = False })

489+ return (trimInlinesF $ mconcat l, e)

490+

464-- | Parse a paragraph.

491-- | Parse a paragraph.

465paraUntil :: PandocMonad m

492paraUntil :: PandocMonad m

466 => MuseParser m a -- ^ Terminator parser

493 => MuseParser m a -- ^ Terminator parser

@@ -468,10 +495,7 @@ paraUntil :: PandocMonad m

468paraUntil end = do

495paraUntil end = do

469 state <- getState

496 state <- getState

470 guard $ not $ museInPara state

497 guard $ not $ museInPara state

471− setState $ state{ museInPara = True }

498+ first (fmap B.para) <$> paraContentsUntil end

472− (l, e) <- someUntil inline $ try (manyTill spaceChar eol >> end)

473− updateState (\st -> st { museInPara = False })

474− return (fmap B.para $ trimInlinesF $ mconcat l, e)

475

499

476noteMarker :: PandocMonad m => MuseParser m String

500noteMarker :: PandocMonad m => MuseParser m String

477noteMarker = try $ do

501noteMarker = try $ do

test/Tests/Readers/Muse.hs+18−4

@@ -558,18 +558,32 @@ tests =

558 ] =?>

559 headerWith ("bar",[],[]) 2 "Foo"

560 , "Headers don't consume anchors separated with a blankline" =:

561− T.unlines [ "** Foo"

561+ T.unlines [ "; A comment to make sure anchor is not parsed as a directive"

562− , ""

563 , "#bar"

562 , "#bar"

563+ , ""

564+ , "** Foo"

565+ ] =?>

566+ para (spanWith ("bar", [], []) mempty) <>

567+ header 2 "Foo"

568+ , "Headers terminate paragraph" =:

569+ T.unlines [ "foo"

570+ , "* bar"

564 ] =?>

571 ] =?>

565− header 2 "Foo" <>

572+ para "foo" <> header 1 "bar"

566− para (spanWith ("bar", [], []) mempty)

567 , "Headers terminate lists" =:

573 , "Headers terminate lists" =:

568 T.unlines [ " - foo"

574 T.unlines [ " - foo"

569 , "* bar"

575 , "* bar"

570 ] =?>

576 ] =?>

571 bulletList [ para "foo" ] <>

577 bulletList [ para "foo" ] <>

572 header 1 "bar"

578 header 1 "bar"

579+ , test emacsMuse "Paragraphs terminate Emacs Muse headers"

580+ (T.unlines [ "* Foo"

581+ , "bar"

582+ ] =?> header 1 "Foo" <> para "bar")

583+ , "Paragraphs don't terminate Text::Amuse headers" =:

584+ T.unlines [ "* Foo"

585+ , "bar"

586+ ] =?> header 1 "Foo\nbar"

573 ]

587 ]

574 , testGroup "Directives"

588 , testGroup "Directives"

575 [ "Title" =:

589 [ "Title" =: