diff options
Diffstat (limited to 'src/Text/Pandoc')
| -rw-r--r-- | src/Text/Pandoc/Readers/Muse.hs | 51 |
1 files changed, 17 insertions, 34 deletions
diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index 158b23ffc..30475d91e 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -44,6 +44,7 @@ module Text.Pandoc.Readers.Muse (readMuse) where import Prelude import Control.Monad import Control.Monad.Except (throwError) +import Data.Bifunctor import Data.Char (isLetter) import Data.Default import Data.List (stripPrefix, intercalate) @@ -199,10 +200,7 @@ someUntil :: (Stream s m t) => ParserT s u m a -> ParserT s u m b -> ParserT s u m ([a], b) -someUntil p end = do - first <- p - (rest, e) <- manyUntil p end - return (first:rest, e) +someUntil p end = first <$> ((:) <$> p) <*> manyUntil p end -- -- directive parsers @@ -250,18 +248,15 @@ parseBlocks = paraStart) where parseEnd = mempty <$ eof - blockStart = do first <- header <|> blockElements <|> emacsNoteBlock - rest <- parseBlocks - return $ first B.<> rest + blockStart = (B.<>) <$> (header <|> blockElements <|> emacsNoteBlock) + <*> parseBlocks listStart = do updateState (\st -> st { museInPara = False }) - (first, rest) <- anyListUntil parseBlocks <|> amuseNoteBlockUntil parseBlocks - return $ first B.<> rest + uncurry (B.<>) <$> (anyListUntil parseBlocks <|> amuseNoteBlockUntil parseBlocks) paraStart = do indent <- length <$> many spaceChar - (first, rest) <- paraUntil parseBlocks - let first' = if indent >= 2 && indent < 6 then B.blockQuote <$> first else first - return $ first' B.<> rest + uncurry (B.<>) . first (p indent) <$> paraUntil parseBlocks + where p indent = if indent >= 2 && indent < 6 then fmap B.blockQuote else id parseBlocksTill :: PandocMonad m => MuseParser m a @@ -276,14 +271,8 @@ parseBlocksTill end = blockStart = (B.<>) <$> blockElements <*> continuation listStart = do updateState (\st -> st { museInPara = False }) - (first, e) <- anyListUntil ((Left <$> end) <|> (Right <$> continuation)) - case e of - Left _ -> return first - Right rest -> return $ first B.<> rest - paraStart = do (first, e) <- paraUntil ((Left <$> end) <|> (Right <$> continuation)) - case e of - Left _ -> return first - Right rest -> return $ first B.<> rest + uncurry (B.<>) <$> anyListUntil (parseEnd <|> continuation) + paraStart = uncurry (B.<>) <$> paraUntil (parseEnd <|> continuation) continuation = parseBlocksTill end listItemContentsUntil :: PandocMonad m @@ -299,19 +288,14 @@ listItemContentsUntil col pre end = parsePre = (mempty,) <$> pre parseEnd = (mempty,) <$> end paraStart = do - (first, e) <- paraUntil ((Left <$> pre) <|> (Right <$> continuation) <|> (Left <$> end)) - case e of - Left ee -> return (first, ee) - Right (rest, ee) -> return (first B.<> rest, ee) - blockStart = do first <- blockElements - (rest, e) <- parsePre <|> continuation <|> parseEnd - return (first B.<> rest, e) + (f, (r, e)) <- paraUntil (parsePre <|> continuation <|> parseEnd) + return (f B.<> r, e) + blockStart = first <$> ((B.<>) <$> blockElements) + <*> (parsePre <|> continuation <|> parseEnd) listStart = do updateState (\st -> st { museInPara = False }) - (first, e) <- anyListUntil ((Left <$> pre) <|> (Right <$> continuation) <|> (Left <$> end)) - case e of - Left ee -> return (first, ee) - Right (rest, ee) -> return (first B.<> rest, ee) + (f, (r, e)) <- anyListUntil (parsePre <|> continuation <|> parseEnd) + return (f B.<> r, e) continuation = try $ do blank <- optionMaybe blankline skipMany blankline indentWith col @@ -585,7 +569,7 @@ orderedListItemsUntil indent style end = pos <- getPosition void spaceChar <|> lookAhead eol updateState (\st -> st { museInPara = False }) - (x, e) <- listItemContentsUntil (sourceColumn pos) (Right <$> try (optionMaybe blankline >> indentWith indent >> museOrderedListMarker style >> continuation)) (Left <$> end) + (x, e) <- listItemContentsUntil (sourceColumn pos) (Right <$> try (optional blankline >> indentWith indent >> museOrderedListMarker style >> continuation)) (Left <$> end) case e of Left ee -> return ([x], ee) Right (xs, ee) -> return (x:xs, ee) @@ -642,8 +626,7 @@ definitionListUntil end = try $ do pos <- getPosition let indent = sourceColumn pos - 1 guardDisabled Ext_amuse <|> guard (indent /= 0) -- Initial space is required by Amusewiki, but not Emacs Muse - (items, e) <- definitionListItemsUntil indent end - return (B.definitionList <$> sequence items, e) + first (fmap B.definitionList . sequence) <$> definitionListItemsUntil indent end anyListUntil :: PandocMonad m => MuseParser m a |