diff options
| author | Alexander Krotov <ilabdsf@gmail.com> | 2017-11-21 23:46:05 +0300 |
|---|---|---|
| committer | Alexander Krotov <ilabdsf@gmail.com> | 2017-11-22 01:22:43 +0300 |
| commit | 351765d4ad4e7bfa674fa48cb36dee824efc98ea (patch) | |
| tree | d10dfba3339a3cf662c8366269bf3fdfa5866373 /src/Text | |
| parent | df3a80cc97e99a8f4fdb8bf80b5ca85a216111b2 (diff) | |
| download | pandoc-351765d4ad4e7bfa674fa48cb36dee824efc98ea.tar.gz | |
Muse reader: concatenate inlines of the same type
Diffstat (limited to 'src/Text')
| -rw-r--r-- | src/Text/Pandoc/Readers/Muse.hs | 22 |
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 |