e26313d · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Muse reader: refactoring

e26313dAlexander Krotov8 years ago

src/Text/Pandoc/Readers/Muse.hs+21−18

compare with master

unifiedsplit

@@ -165,6 +165,9 @@ atStart p = do

165 guard $ museLastStrPos st /= Just pos

166 p

167

168+firstColumn :: PandocMonad m => MuseParser m ()

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

170+

168-- * Parsers

171-- * Parsers

169

172

170-- | Parse end-of-line, which can be either a newline or end-of-file.

173-- | Parse end-of-line, which can be either a newline or end-of-file.

@@ -360,12 +363,11 @@ blockElements = do

360

363

361-- | Parse a line comment, starting with @;@ in the first column.

364-- | Parse a line comment, starting with @;@ in the first column.

362comment :: PandocMonad m => MuseParser m (F Blocks)

365comment :: PandocMonad m => MuseParser m (F Blocks)

363−comment = try $ do

366+comment = try $ mempty

364− getPosition >>= \pos -> guard (sourceColumn pos == 1)

367+ <$ firstColumn

365− char ';'

368+ <* char ';'

366− optional (spaceChar *> many (noneOf "\n"))

369+ <* optional (spaceChar *> many (noneOf "\n"))

367− eol

370+ <* eol

368− return mempty

369

371

370-- | Parse a horizontal rule, consisting of 4 or more @\'-\'@ characters.

372-- | Parse a horizontal rule, consisting of 4 or more @\'-\'@ characters.

371separator :: PandocMonad m => MuseParser m (F Blocks)

373separator :: PandocMonad m => MuseParser m (F Blocks)

@@ -378,7 +380,7 @@ separator = try $ pure B.horizontalRule

378headingStart :: PandocMonad m => MuseParser m (String, Int)

380headingStart :: PandocMonad m => MuseParser m (String, Int)

379headingStart = try $ do

381headingStart = try $ do

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

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

381− getPosition >>= \pos -> guard (sourceColumn pos == 1)

383+ firstColumn

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

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

383 guard $ level <= 5

385 guard $ level <= 5

384 spaceChar

386 spaceChar

@@ -801,10 +803,11 @@ endline :: PandocMonad m => MuseParser m (F Inlines)

801endline = try $ pure B.softbreak <$ newline <* notFollowedBy blankline

803endline = try $ pure B.softbreak <$ newline <* notFollowedBy blankline

802

804

803parseAnchor :: PandocMonad m => MuseParser m String

805parseAnchor :: PandocMonad m => MuseParser m String

804−parseAnchor = try $ do

806+parseAnchor = try $ (:)

805− getPosition >>= \pos -> guard (sourceColumn pos == 1)

807+ <$ firstColumn

806− char '#'

808+ <* char '#'

809+ <*> letter

807− (:) <$> letter <*> many (letter <|> digit <|> char '-')

810+ <*> many (letter <|> digit <|> char '-')

808

811

809anchor :: PandocMonad m => MuseParser m (F Inlines)

812anchor :: PandocMonad m => MuseParser m (F Inlines)

810anchor = try $ do

813anchor = try $ do

@@ -849,8 +852,9 @@ enclosedInlines :: (PandocMonad m, Show a, Show b)

849 => MuseParser m a

852 => MuseParser m a

850 -> MuseParser m b

853 -> MuseParser m b

851 -> MuseParser m (F Inlines)

854 -> MuseParser m (F Inlines)

852−enclosedInlines start end = try $

855+enclosedInlines start end = try $ trimInlinesF . mconcat

856+ <$> enclosed (atStart start) end inline

853− trimInlinesF . mconcat <$> (enclosed (atStart start) end inline <* notFollowedBy (satisfy ((||) <$> isLetter <*> isDigit)))

857+ <* notFollowedBy (satisfy ((||) <$> isLetter <*> isDigit))

854

858

855-- | Parse an inline tag, such as @\@ and @\@.

859-- | Parse an inline tag, such as @\@ and @\@.

856inlineTag :: PandocMonad m

860inlineTag :: PandocMonad m

@@ -871,9 +875,9 @@ emph = fmap B.emph <$> emphasisBetween (char '*')

871-- | Parse underline inline markup, indicated by @_@.

875-- | Parse underline inline markup, indicated by @_@.

872-- Supported only in Emacs Muse mode, not Text::Amuse.

876-- Supported only in Emacs Muse mode, not Text::Amuse.

873underlined :: PandocMonad m => MuseParser m (F Inlines)

877underlined :: PandocMonad m => MuseParser m (F Inlines)

874−underlined = do

878+underlined = fmap underlineSpan

875− guardDisabled Ext_amuse -- Supported only by Emacs Muse

879+ <$ guardDisabled Ext_amuse -- Supported only by Emacs Muse

876− fmap underlineSpan <$> emphasisBetween (char '_')

880+ <*> emphasisBetween (char '_')

877

881

878-- | Parse @\@ tag.

882-- | Parse @\@ tag.

879strongTag :: PandocMonad m => MuseParser m (F Inlines)

883strongTag :: PandocMonad m => MuseParser m (F Inlines)

@@ -902,9 +906,8 @@ verbatimTag = return . B.text . snd <$> htmlElement "verbatim"

902-- | Parse @\<class>@ tag.

906-- | Parse @\<class>@ tag.

903classTag :: PandocMonad m => MuseParser m (F Inlines)

907classTag :: PandocMonad m => MuseParser m (F Inlines)

904classTag = do

908classTag = do

905− attrs <- openTag "class"

909+ classes <- maybe [] words . lookup "name" <$> openTag "class"

906 res <- manyTill inline $ closeTag "class"

910 res <- manyTill inline $ closeTag "class"

907− let classes = maybe [] words $ lookup "name" attrs

908 return $ B.spanWith ("", classes, []) <$> mconcat res

911 return $ B.spanWith ("", classes, []) <$> mconcat res

909

912

910-- | Parse "~~" as nonbreaking space.

913-- | Parse "~~" as nonbreaking space.