diff options
| -rw-r--r-- | src/Text/Pandoc/Readers/Muse.hs | 62 |
1 files changed, 29 insertions, 33 deletions
diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index 1507ff2c9..06f35b1be 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -44,7 +44,6 @@ import Control.Monad import Control.Monad.Reader import Control.Monad.Except (throwError) import Data.Bifunctor -import Data.Char (isAlphaNum) import Data.Default import Data.List (intercalate) import Data.List.Split (splitOn) @@ -69,7 +68,7 @@ readMuse :: PandocMonad m -> m Pandoc readMuse opts s = do let input = crFilter s - res <- runReaderT (runParserT parseMuse def{ museOptions = opts } "source" input) def + res <- flip runReaderT def $ runParserT parseMuse def{ museOptions = opts } "source" input case res of Left e -> throwError $ PandocParsecError (unpack input) e Right d -> return d @@ -132,9 +131,7 @@ parseMuse = do many directive blocks <- (:) <$> parseBlocks <*> many parseSection st <- getState - let doc = runF (Pandoc <$> museMeta st <*> fmap B.toList (mconcat blocks)) st - reportLogMessages - return doc + runF (Pandoc <$> museMeta st <*> fmap B.toList (mconcat blocks)) st <$ reportLogMessages -- * Utility functions @@ -203,7 +200,7 @@ htmlAttrToPandoc attrs = (ident, classes, keyvals) where ident = fromMaybe "" $ lookup "id" attrs classes = maybe [] words $ lookup "class" attrs - keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"] + keyvals = [(k,v) | (k,v) <- attrs, k /= "id", k /= "class"] parseHtmlContent :: PandocMonad m => String -- ^ Tag name @@ -279,28 +276,22 @@ parseSection = parseBlocksTill :: PandocMonad m => MuseParser m a -> MuseParser m (F Blocks) -parseBlocksTill end = - try (parseEnd <|> - blockStart <|> - listStart <|> - paraStart) +parseBlocksTill end = continuation where parseEnd = mempty <$ end blockStart = (B.<>) <$> blockElements <*> allowPara continuation listStart = uncurry (B.<>) <$> allowPara (anyListUntil (parseEnd <|> continuation)) paraStart = uncurry (B.<>) <$> paraUntil (parseEnd <|> continuation) - continuation = parseBlocksTill end + continuation = try $ parseEnd <|> blockStart <|> listStart <|> paraStart listItemContentsUntil :: PandocMonad m => Int -> MuseParser m a -> MuseParser m a -> MuseParser m (F Blocks, a) -listItemContentsUntil col pre end = - try blockStart <|> - try listStart <|> - try paraStart +listItemContentsUntil col pre end = p where + p = try blockStart <|> try listStart <|> try paraStart parsePre = (mempty,) <$> pre parseEnd = (mempty,) <$> end paraStart = do @@ -314,7 +305,7 @@ listItemContentsUntil col pre end = continuation = try $ do blank <- optionMaybe blankline skipMany blankline indentWith col - local (\s -> s { museInPara = museInPara s && isNothing blank }) $ listItemContentsUntil col pre end + local (\s -> s { museInPara = museInPara s && isNothing blank }) p parseBlock :: PandocMonad m => MuseParser m (F Blocks) parseBlock = do @@ -435,9 +426,9 @@ divTag = do -- | Parse @\<biblio>@ tag, the result is the same as @\<div class="biblio">@. -- @\<biblio>@ tag is supported only in Text::Amuse mode. biblioTag :: PandocMonad m => MuseParser m (F Blocks) -biblioTag = do - guardEnabled Ext_amuse - fmap (B.divWith ("", ["biblio"], [])) . snd <$> parseHtmlContent "biblio" +biblioTag = fmap (B.divWith ("", ["biblio"], [])) . snd + <$ guardEnabled Ext_amuse + <*> parseHtmlContent "biblio" -- | Parse @\<play>@ tag, the result is the same as @\<div class="play">@. -- @\<play>@ tag is supported only in Text::Amuse mode. @@ -489,6 +480,17 @@ noteMarker = try $ (:) <*> oneOf "123456789" <*> manyTill digit (char ']') +addNote :: PandocMonad m + => String + -> SourcePos + -> F Blocks + -> MuseParser m () +addNote ref pos content = do + oldnotes <- museNotes <$> getState + when (M.member ref oldnotes) + (logMessage $ DuplicateNoteReference ref pos) + updateState $ \s -> s{ museNotes = M.insert ref (pos, content) oldnotes } + -- Amusewiki version of note -- Parsing is similar to list item, except that note marker is used instead of list marker amuseNoteBlockUntil :: PandocMonad m @@ -499,10 +501,7 @@ amuseNoteBlockUntil end = try $ do ref <- noteMarker <* spaceChar pos <- getPosition (content, e) <- allowPara $ listItemContentsUntil (sourceColumn pos - 1) (fail "x") end - oldnotes <- museNotes <$> getState - when (M.member ref oldnotes) - (logMessage $ DuplicateNoteReference ref pos) - updateState $ \s -> s{ museNotes = M.insert ref (pos, content) oldnotes } + addNote ref pos content return (mempty, e) -- Emacs version of note @@ -510,13 +509,10 @@ amuseNoteBlockUntil end = try $ do emacsNoteBlock :: PandocMonad m => MuseParser m (F Blocks) emacsNoteBlock = try $ do guardDisabled Ext_amuse - pos <- getPosition ref <- noteMarker <* skipSpaces - content <- mconcat <$> blocksTillNote - oldnotes <- museNotes <$> getState - when (M.member ref oldnotes) - (logMessage $ DuplicateNoteReference ref pos) - updateState $ \s -> s{ museNotes = M.insert ref (pos, content) oldnotes } + pos <- getPosition + content <- fmap mconcat blocksTillNote + addNote ref pos content return mempty where blocksTillNote = @@ -688,7 +684,7 @@ tableParseRow :: PandocMonad m tableParseRow n = try $ sequence <$> tableCells where tableCells = (:) <$> tableCell sep <*> (tableCells <|> fmap pure (tableCell eol)) tableCell p = try $ fmap B.plain . trimInlinesF . mconcat <$> manyTill inline' p - sep = try $ many1 spaceChar *> count n (char '|') *> (void (lookAhead $ many1 spaceChar) <|> void (lookAhead eol)) + sep = try $ many1 spaceChar *> count n (char '|') *> lookAhead (void (many1 spaceChar) <|> void eol) -- | Parse a table header row. tableParseHeader :: PandocMonad m => MuseParser m (F MuseTableElement) @@ -852,7 +848,7 @@ code = try $ fmap pure $ B.code . uncurry (++) <$ atStart (char '=') <* notFollowedBy (spaceChar <|> newline) <*> manyUntil (noneOf "\n\r" <|> (newline <* notFollowedBy newline)) (try $ fmap pure $ noneOf " \t\n\r=" <* char '=') - <* notFollowedBy (satisfy isAlphaNum) + <* notFollowedBy alphaNum -- | Parse @\<code>@ tag. codeTag :: PandocMonad m => MuseParser m (F Inlines) @@ -877,7 +873,7 @@ str :: PandocMonad m => MuseParser m (F Inlines) str = return . B.str <$> many1 alphaNum <* updateLastStrPos symbol :: PandocMonad m => MuseParser m (F Inlines) -symbol = return . B.str <$> count 1 nonspaceChar +symbol = pure . B.str . pure <$> nonspaceChar -- | Parse a link or image. linkOrImage :: PandocMonad m => MuseParser m (F Inlines) |