aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Readers/Muse.hs39
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.