diff options
Diffstat (limited to 'src/Text/Pandoc/Readers')
| -rw-r--r-- | src/Text/Pandoc/Readers/Muse.hs | 56 |
1 files changed, 19 insertions, 37 deletions
diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index 3e6130585..b43a53d60 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -1,5 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TupleSections #-} {- Copyright (C) 2017-2018 Alexander Krotov <ilabdsf@gmail.com> @@ -174,7 +175,7 @@ parseHtmlContent tag = try $ do pos <- getPosition (TagOpen _ attr, _) <- htmlTag (~== TagOpen tag []) manyTill spaceChar eol - content <- parseBlocksTill (try $ ((count (sourceColumn pos - 1) spaceChar) >> endtag)) + content <- parseBlocksTill $ try $ count (sourceColumn pos - 1) spaceChar >> endtag manyTill spaceChar eol -- closing tag must be followed by optional whitespace and newline return (htmlAttrToPandoc attr, content) where @@ -274,9 +275,7 @@ parseBlocksTill end = paraStart) where parseEnd = mempty <$ end - blockStart = do first <- blockElements - rest <- continuation - return $ first B.<> rest + blockStart = (B.<>) <$> blockElements <*> continuation listStart = do updateState (\st -> st { museInPara = False }) (first, e) <- anyListUntil ((Left <$> end) <|> (Right <$> continuation)) @@ -299,10 +298,8 @@ listItemContentsUntil col pre end = try listStart <|> try paraStart where - parsePre = do e <- pre - return (mempty, e) - parseEnd = do e <- end - return (mempty, e) + parsePre = (mempty,) <$> pre + parseEnd = (mempty,) <$> end paraStart = do (first, e) <- paraUntil ((Left <$> pre) <|> (Right <$> continuation) <|> (Left <$> end)) case e of @@ -468,9 +465,7 @@ paraUntil end = do noteMarker :: PandocMonad m => MuseParser m String noteMarker = try $ do char '[' - first <- oneOf "123456789" - rest <- manyTill digit (char ']') - return $ first:rest + (:) <$> oneOf "123456789" <*> manyTill digit (char ']') -- Amusewiki version of note -- Parsing is similar to list item, except that note marker is used instead of list marker @@ -713,11 +708,7 @@ elementsToTable = foldM museAppendElement emptyTable where emptyTable = MuseTable mempty mempty mempty mempty table :: PandocMonad m => MuseParser m (F Blocks) -table = try $ do - rows <- tableElements - let tbl = elementsToTable rows - let pandocTbl = museToPandocTable <$> tbl :: F Blocks - return pandocTbl +table = try $ fmap museToPandocTable <$> (elementsToTable <$> tableElements) tableParseElement :: PandocMonad m => MuseParser m MuseTableElement tableParseElement = tableParseHeader @@ -831,16 +822,14 @@ enclosedInlines start end = try $ trimInlinesF . mconcat <$> (enclosed (atStart start) end inline <* notFollowedBy (satisfy isLetter)) inlineTag :: PandocMonad m - => (Inlines -> Inlines) - -> String + => String -> MuseParser m (F Inlines) -inlineTag f tag = try $ do +inlineTag tag = try $ do htmlTag (~== TagOpen tag []) - res <- manyTill inline (void $ htmlTag (~== TagClose tag)) - return $ f <$> mconcat res + mconcat <$> manyTill inline (void $ htmlTag (~== TagClose tag)) strongTag :: PandocMonad m => MuseParser m (F Inlines) -strongTag = inlineTag B.strong "strong" +strongTag = fmap B.strong <$> inlineTag "strong" strong :: PandocMonad m => MuseParser m (F Inlines) strong = fmap B.strong <$> emphasisBetween (string "**") @@ -854,16 +843,16 @@ underlined = do fmap underlineSpan <$> emphasisBetween (char '_') emphTag :: PandocMonad m => MuseParser m (F Inlines) -emphTag = inlineTag B.emph "em" +emphTag = fmap B.emph <$> inlineTag "em" superscriptTag :: PandocMonad m => MuseParser m (F Inlines) -superscriptTag = inlineTag B.superscript "sup" +superscriptTag = fmap B.superscript <$> inlineTag "sup" subscriptTag :: PandocMonad m => MuseParser m (F Inlines) -subscriptTag = inlineTag B.subscript "sub" +subscriptTag = fmap B.subscript <$> inlineTag "sub" strikeoutTag :: PandocMonad m => MuseParser m (F Inlines) -strikeoutTag = inlineTag B.strikeout "del" +strikeoutTag = fmap B.strikeout <$> inlineTag "del" verbatimTag :: PandocMonad m => MuseParser m (F Inlines) verbatimTag = return . B.text . snd <$> htmlElement "verbatim" @@ -891,9 +880,7 @@ code = try $ do return $ return $ B.code contents codeTag :: PandocMonad m => MuseParser m (F Inlines) -codeTag = do - (attrs, content) <- htmlElement "code" - return $ return $ B.codeWith attrs content +codeTag = return . uncurry B.codeWith <$> htmlElement "code" inlineLiteralTag :: PandocMonad m => MuseParser m (F Inlines) inlineLiteralTag = @@ -904,10 +891,7 @@ inlineLiteralTag = rawInline (attrs, content) = B.rawInline (format attrs) content str :: PandocMonad m => MuseParser m (F Inlines) -str = do - result <- many1 alphaNum - updateLastStrPos - return $ return $ B.str result +str = return . B.str <$> many1 alphaNum <* updateLastStrPos symbol :: PandocMonad m => MuseParser m (F Inlines) symbol = return . B.str <$> count 1 nonspaceChar @@ -929,9 +913,7 @@ link = try $ do isImageUrl = (`elem` imageExtensions) . takeExtension linkContent :: PandocMonad m => MuseParser m (F Inlines) -linkContent = do - char '[' - trimInlinesF . mconcat <$> manyTill inline (string "]") +linkContent = char '[' >> trimInlinesF . mconcat <$> manyTill inline (string "]") linkText :: PandocMonad m => MuseParser m (String, String, Maybe (F Inlines)) linkText = do |