diff options
| -rw-r--r-- | src/Text/Pandoc/Readers/Muse.hs | 22 | ||||
| -rw-r--r-- | test/Tests/Readers/Muse.hs | 2 |
2 files changed, 20 insertions, 4 deletions
diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index 0a0e86df8..760308d5d 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -139,6 +139,20 @@ parseHtmlContentWithAttrs tag parser = do parseHtmlContent :: PandocMonad m => String -> MuseParser m a -> MuseParser m [a] parseHtmlContent tag p = fmap snd (parseHtmlContentWithAttrs tag p) +normalizeInlineList :: [Inline] -> [Inline] +normalizeInlineList (Code a1 x1 : Code a2 x2 : ils) | a1 == a2 + = normalizeInlineList $ Code a1 (x1 ++ x2) : ils +normalizeInlineList (RawInline f1 x1 : RawInline f2 x2 : ils) | f1 == f2 + = normalizeInlineList $ RawInline f1 (x1 ++ x2) : ils +normalizeInlineList (x:xs) = x : normalizeInlineList xs +normalizeInlineList [] = [] + +normalizeInlines :: Inlines -> Inlines +normalizeInlines = B.fromList . normalizeInlineList . B.toList . B.trimInlines + +normalizeInlinesF :: Future s Inlines -> Future s Inlines +normalizeInlinesF = liftM normalizeInlines + -- -- directive parsers -- @@ -150,7 +164,7 @@ parseDirective = do space spaces raw <- manyTill anyChar eol - value <- parseFromString (trimInlinesF . mconcat <$> many inline) raw + value <- parseFromString (normalizeInlinesF . mconcat <$> many inline) raw return (key, value) directive :: PandocMonad m => MuseParser m () @@ -217,7 +231,7 @@ header = try $ do level <- fmap length $ many1 $ char '*' guard $ level <= 5 spaceChar - content <- trimInlinesF . mconcat <$> manyTill inline eol + content <- normalizeInlinesF . mconcat <$> manyTill inline eol attr <- registerHeader ("", [], []) (runF content defaultParserState) return $ B.headerWith attr level <$> content @@ -286,7 +300,7 @@ verseLines :: PandocMonad m => MuseParser m (F Blocks) verseLines = do optionMaybe blankline -- Skip blankline after opening tag on separate line lns <- many verseLine - lns' <- mapM (parseFromString' (trimInlinesF . mconcat <$> many inline)) lns + lns' <- mapM (parseFromString' (normalizeInlinesF . mconcat <$> many inline)) lns return $ B.lineBlock <$> sequence lns' verseTag :: PandocMonad m => MuseParser m (F Blocks) @@ -302,7 +316,7 @@ para :: PandocMonad m => MuseParser m (F Blocks) para = do indent <- length <$> many spaceChar let f = if indent >= 2 && indent < 6 then B.blockQuote else id - fmap (f . B.para) . trimInlinesF . mconcat <$> many1Till inline endOfParaElement + fmap (f . B.para) . normalizeInlinesF . mconcat <$> many1Till inline endOfParaElement where endOfParaElement = lookAhead $ endOfInput <|> endOfPara <|> newBlockElement endOfInput = try $ skipMany blankline >> skipSpaces >> eof diff --git a/test/Tests/Readers/Muse.hs b/test/Tests/Readers/Muse.hs index a0362b80c..0960c8af2 100644 --- a/test/Tests/Readers/Muse.hs +++ b/test/Tests/Readers/Muse.hs @@ -125,6 +125,8 @@ tests = , "Verbatim inside code" =: "<code><verbatim>foo</verbatim></code>" =?> para (code "<verbatim>foo</verbatim>") + , "Code normalization" =: "<code><code><</code><code>/code></code>" =?> para (code "<code></code>") + , testGroup "Links" [ "Link without description" =: "[[https://amusewiki.org/]]" =?> |