summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorAlexander Krotov <ilabdsf@gmail.com>2017-11-21 23:46:05 +0300
committerAlexander Krotov <ilabdsf@gmail.com>2017-11-22 01:22:43 +0300
commit351765d4ad4e7bfa674fa48cb36dee824efc98ea (patch)
treed10dfba3339a3cf662c8366269bf3fdfa5866373 /src
parentdf3a80cc97e99a8f4fdb8bf80b5ca85a216111b2 (diff)
Muse reader: concatenate inlines of the same type
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/Readers/Muse.hs22
1 files changed, 18 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