diff options
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r-- | src/Text/Pandoc/Readers/Muse.hs | 39 |
1 files changed, 21 insertions, 18 deletions
diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index 6c7ab643f..ee93c6777 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -165,6 +165,9 @@ atStart p = do guard $ museLastStrPos st /= Just pos p +firstColumn :: PandocMonad m => MuseParser m () +firstColumn = getPosition >>= \pos -> guard (sourceColumn pos == 1) + -- * Parsers -- | Parse end-of-line, which can be either a newline or end-of-file. @@ -360,12 +363,11 @@ blockElements = do -- | Parse a line comment, starting with @;@ in the first column. comment :: PandocMonad m => MuseParser m (F Blocks) -comment = try $ do - getPosition >>= \pos -> guard (sourceColumn pos == 1) - char ';' - optional (spaceChar *> many (noneOf "\n")) - eol - return mempty +comment = try $ mempty + <$ firstColumn + <* char ';' + <* optional (spaceChar *> many (noneOf "\n")) + <* eol -- | Parse a horizontal rule, consisting of 4 or more @\'-\'@ characters. separator :: PandocMonad m => MuseParser m (F Blocks) @@ -378,7 +380,7 @@ separator = try $ pure B.horizontalRule headingStart :: PandocMonad m => MuseParser m (String, Int) headingStart = try $ do anchorId <- option "" $ try (parseAnchor <* manyTill spaceChar eol) - getPosition >>= \pos -> guard (sourceColumn pos == 1) + firstColumn level <- fmap length $ many1 $ char '*' guard $ level <= 5 spaceChar @@ -801,10 +803,11 @@ endline :: PandocMonad m => MuseParser m (F Inlines) endline = try $ pure B.softbreak <$ newline <* notFollowedBy blankline parseAnchor :: PandocMonad m => MuseParser m String -parseAnchor = try $ do - getPosition >>= \pos -> guard (sourceColumn pos == 1) - char '#' - (:) <$> letter <*> many (letter <|> digit <|> char '-') +parseAnchor = try $ (:) + <$ firstColumn + <* char '#' + <*> letter + <*> many (letter <|> digit <|> char '-') anchor :: PandocMonad m => MuseParser m (F Inlines) anchor = try $ do @@ -849,8 +852,9 @@ enclosedInlines :: (PandocMonad m, Show a, Show b) => MuseParser m a -> MuseParser m b -> MuseParser m (F Inlines) -enclosedInlines start end = try $ - trimInlinesF . mconcat <$> (enclosed (atStart start) end inline <* notFollowedBy (satisfy ((||) <$> isLetter <*> isDigit))) +enclosedInlines start end = try $ trimInlinesF . mconcat + <$> enclosed (atStart start) end inline + <* notFollowedBy (satisfy ((||) <$> isLetter <*> isDigit)) -- | Parse an inline tag, such as @\<em>@ and @\<strong>@. inlineTag :: PandocMonad m @@ -871,9 +875,9 @@ emph = fmap B.emph <$> emphasisBetween (char '*') -- | Parse underline inline markup, indicated by @_@. -- Supported only in Emacs Muse mode, not Text::Amuse. underlined :: PandocMonad m => MuseParser m (F Inlines) -underlined = do - guardDisabled Ext_amuse -- Supported only by Emacs Muse - fmap underlineSpan <$> emphasisBetween (char '_') +underlined = fmap underlineSpan + <$ guardDisabled Ext_amuse -- Supported only by Emacs Muse + <*> emphasisBetween (char '_') -- | Parse @\<strong>@ tag. strongTag :: PandocMonad m => MuseParser m (F Inlines) @@ -902,9 +906,8 @@ verbatimTag = return . B.text . snd <$> htmlElement "verbatim" -- | Parse @\<class>@ tag. classTag :: PandocMonad m => MuseParser m (F Inlines) classTag = do - attrs <- openTag "class" + classes <- maybe [] words . lookup "name" <$> openTag "class" res <- manyTill inline $ closeTag "class" - let classes = maybe [] words $ lookup "name" attrs return $ B.spanWith ("", classes, []) <$> mconcat res -- | Parse "~~" as nonbreaking space. |