@@ -180,38 +180,31 @@ someUntil p end = first <$> ((:) <$> p) <*> manyUntil p end
180180-- ** HTML parsers
181181
182182openTag :: PandocMonad m => String -> MuseParser m [(String, String)]
183−openTag tag = try $ do
184− char '<'
185− string tag
186− manyTill attr (char '>')
183+openTag tag = try $
184+ char '<' *> string tag *> manyTill attr (char '>')
187185 where
188− attr = try $ do
189− many1 spaceChar
190− key <- many1 (noneOf "=\n")
191− string "=\""
192− value <- manyTill (noneOf "\"") (char '"')
193− return (key, value)
186+ attr = try $ (,)
187+ <$ many1 spaceChar
188+ <*> many1 (noneOf "=\n")
189+ <* string "=\""
190+ <*> manyTill (noneOf "\"") (char '"')
194191
195192closeTag :: PandocMonad m => String -> MuseParser m ()
196−closeTag tag = try $ string "</" >> string tag >> void (char '>')
193+closeTag tag = try $ string "</" *> string tag *> void (char '>')
197194
198195-- | Parse HTML tag, returning its attributes and literal contents.
199196htmlElement :: PandocMonad m
200197 => String -- ^ Tag name
201198 -> MuseParser m (Attr, String)
202−htmlElement tag = try $ do
203− attr <- openTag tag
204− content <- manyTill anyChar $ closeTag tag
205− return (htmlAttrToPandoc attr, content)
199+htmlElement tag = try $ (,)
200+ <$> (htmlAttrToPandoc <$> openTag tag)
201+ <*> manyTill anyChar (closeTag tag)
206202
207203htmlBlock :: PandocMonad m
208204 => String -- ^ Tag name
209205 -> MuseParser m (Attr, String)
210−htmlBlock tag = try $ do
211− many spaceChar
212− res <- htmlElement tag
213− manyTill spaceChar eol
214− return res
206+htmlBlock tag = try $
207+ many spaceChar *> htmlElement tag <* manyTill spaceChar eol
215208
216209-- | Convert HTML attributes to Pandoc 'Attr'
217210htmlAttrToPandoc :: [Attribute String] -> Attr
@@ -229,7 +222,7 @@ parseHtmlContent tag = try $ do
229222 pos <- getPosition
230223 attr <- openTag tag
231224 manyTill spaceChar eol
232− content <- parseBlocksTill $ try $ count (sourceColumn pos - 1) spaceChar >> closeTag tag
225+ content <- parseBlocksTill $ try $ count (sourceColumn pos - 1) spaceChar *> closeTag tag
233226 manyTill spaceChar eol -- closing tag must be followed by optional whitespace and newline
234227 return (htmlAttrToPandoc attr, content)
235228
@@ -240,21 +233,19 @@ parseDirectiveKey :: PandocMonad m => MuseParser m String
240233parseDirectiveKey = char '#' *> many (letter <|> char '-')
241234
242235parseEmacsDirective :: PandocMonad m => MuseParser m (String, F Inlines)
243−parseEmacsDirective = do
244− key <- parseDirectiveKey
245− spaceChar
246− value <- trimInlinesF . mconcat <$> manyTill (choice inlineList) eol
247− return (key, value)
236+parseEmacsDirective = (,)
237+ <$> parseDirectiveKey
238+ <* spaceChar
239+ <*> (trimInlinesF . mconcat <$> manyTill (choice inlineList) eol)
248240
249241parseAmuseDirective :: PandocMonad m => MuseParser m (String, F Inlines)
250−parseAmuseDirective = do
251− key <- parseDirectiveKey
252− many1 spaceChar
253− value <- trimInlinesF . mconcat <$> many1Till inline endOfDirective
254− many blankline
255− return (key, value)
242+parseAmuseDirective = (,)
243+ <$> parseDirectiveKey
244+ <* many1 spaceChar
245+ <*> (trimInlinesF . mconcat <$> many1Till inline endOfDirective)
246+ <* many blankline
256247 where
257− endOfDirective = lookAhead $ eof <|> try (newline >> (void blankline <|> void parseDirectiveKey))
248+ endOfDirective = lookAhead $ eof <|> try (newline *> (void blankline <|> void parseDirectiveKey))
258249
259250directive :: PandocMonad m => MuseParser m ()
260251directive = do
@@ -372,18 +363,17 @@ comment :: PandocMonad m => MuseParser m (F Blocks)
372363comment = try $ do
373364 getPosition >>= \pos -> guard (sourceColumn pos == 1)
374365 char ';'
375− optional (spaceChar >> many (noneOf "\n"))
366+ optional (spaceChar *> many (noneOf "\n"))
376367 eol
377368 return mempty
378369
379370-- | Parse a horizontal rule, consisting of 4 or more @\'-\'@ characters.
380371separator :: PandocMonad m => MuseParser m (F Blocks)
381−separator = try $ do
382− string "----"
383− many $ char '-'
384− many spaceChar
385− eol
386− return $ return B.horizontalRule
372+separator = try $ pure B.horizontalRule
373+ <$ string "----"
374+ <* many (char '-')
375+ <* many spaceChar
376+ <* eol
387377
388378headingStart :: PandocMonad m => MuseParser m (String, Int)
389379headingStart = try $ do
@@ -418,11 +408,10 @@ amuseHeadingUntil end = try $ do
418408-- | Parse an example between @{{{@ and @}}}@.
419409-- It is an Amusewiki extension influenced by Creole wiki, as described in @Text::Amuse@ documentation.
420410example :: PandocMonad m => MuseParser m (F Blocks)
421−example = try $ do
422− string "{{{"
423− optional blankline
424− contents <- manyTill anyChar $ try (optional blankline >> string "}}}")
425− return $ return $ B.codeBlock contents
411+example = try $ pure . B.codeBlock
412+ <$ string "{{{"
413+ <* optional blankline
414+ <*> manyTill anyChar (try (optional blankline *> string "}}}"))
426415
427416-- | Parse an @\<example>@ tag.
428417exampleTag :: PandocMonad m => MuseParser m (F Blocks)
@@ -482,7 +471,7 @@ playTag = do
482471
483472verseLine :: PandocMonad m => MuseParser m (F Inlines)
484473verseLine = do
485− indent <- (B.str <$> many1 (char ' ' >> pure '\160')) <|> pure mempty
474+ indent <- (B.str <$> many1 ('\160' <$ char ' ')) <|> pure mempty
486475 rest <- manyTill (choice inlineList) newline
487476 return $ trimInlinesF $ mconcat (pure indent : rest)
488477
@@ -494,13 +483,13 @@ verseTag = try $ do
494483 openTag "verse"
495484 manyTill spaceChar eol
496485 let indent = count (sourceColumn pos - 1) spaceChar
497− content <- sequence <$> manyTill (indent >> verseLine) (try $ indent >> closeTag "verse")
486+ content <- sequence <$> manyTill (indent *> verseLine) (try $ indent *> closeTag "verse")
498487 manyTill spaceChar eol
499488 return $ B.lineBlock <$> content
500489
501490-- | Parse @\<comment>@ tag.
502491commentTag :: PandocMonad m => MuseParser m (F Blocks)
503−commentTag = htmlBlock "comment" >> return mempty
492+commentTag = mempty <$ htmlBlock "comment"
504493
505494-- | Parse paragraph contents.
506495paraContentsUntil :: PandocMonad m
@@ -508,7 +497,7 @@ paraContentsUntil :: PandocMonad m
508497 -> MuseParser m (F Inlines, a)
509498paraContentsUntil end = do
510499 updateState (\st -> st { museInPara = True })
511− (l, e) <- someUntil inline $ try (manyTill spaceChar eol >> end)
500+ (l, e) <- someUntil inline $ try (manyTill spaceChar eol *> end)
512501 updateState (\st -> st { museInPara = False })
513502 return (trimInlinesF $ mconcat l, e)
514503
@@ -522,9 +511,10 @@ paraUntil end = do
522511 first (fmap B.para) <$> paraContentsUntil end
523512
524513noteMarker :: PandocMonad m => MuseParser m String
525−noteMarker = try $ do
526− char '['
527− (:) <$> oneOf "123456789" <*> manyTill digit (char ']')
514+noteMarker = try $ (:)
515+ <$ char '['
516+ <*> oneOf "123456789"
517+ <*> manyTill digit (char ']')
528518
529519-- Amusewiki version of note
530520-- Parsing is similar to list item, except that note marker is used instead of list marker
@@ -567,16 +557,15 @@ emacsNoteBlock = try $ do
567557lineVerseLine :: PandocMonad m => MuseParser m (F Inlines)
568558lineVerseLine = try $ do
569559 string "> "
570− indent <- many (char ' ' >> pure '\160')
560+ indent <- many ('\160' <$ char ' ')
571561 let indentEl = if null indent then mempty else B.str indent
572562 rest <- manyTill (choice inlineList) eol
573563 return $ trimInlinesF $ mconcat (pure indentEl : rest)
574564
575565blanklineVerseLine :: PandocMonad m => MuseParser m (F Inlines)
576−blanklineVerseLine = try $ do
577− char '>'
578− blankline
579− pure mempty
566+blanklineVerseLine = try $ mempty
567+ <$ char '>'
568+ <* blankline
580569
581570-- | Parse a line block indicated by @\'>\'@ characters.
582571lineBlock :: PandocMonad m => MuseParser m (F Blocks)
@@ -596,7 +585,7 @@ bulletListItemsUntil indent end = try $ do
596585 char '-'
597586 void spaceChar <|> lookAhead eol
598587 updateState (\st -> st { museInPara = False })
599− (x, (xs, e)) <- listItemContentsUntil (indent + 2) (try (optional blankline >> indentWith indent >> bulletListItemsUntil indent end)) (([],) <$> end)
588+ (x, (xs, e)) <- listItemContentsUntil (indent + 2) (try (optional blankline *> indentWith indent *> bulletListItemsUntil indent end)) (([],) <$> end)
600589 return (x:xs, e)
601590
602591-- | Parse a bullet list.
@@ -643,7 +632,7 @@ orderedListItemsUntil indent style end =
643632 pos <- getPosition
644633 void spaceChar <|> lookAhead eol
645634 updateState (\st -> st { museInPara = False })
646− (x, (xs, e)) <- listItemContentsUntil (sourceColumn pos) (try (optional blankline >> indentWith indent >> museOrderedListMarker style >> continuation)) (([],) <$> end)
635+ (x, (xs, e)) <- listItemContentsUntil (sourceColumn pos) (try (optional blankline *> indentWith indent *> museOrderedListMarker style *> continuation)) (([],) <$> end)
647636 return (x:xs, e)
648637
649638-- | Parse an ordered list.
@@ -667,7 +656,7 @@ descriptionsUntil :: PandocMonad m
667656descriptionsUntil indent end = do
668657 void spaceChar <|> lookAhead eol
669658 updateState (\st -> st { museInPara = False })
670− (x, (xs, e)) <- listItemContentsUntil indent (try (optional blankline >> indentWith indent >> manyTill spaceChar (string "::") >> descriptionsUntil indent end)) (([],) <$> end)
659+ (x, (xs, e)) <- listItemContentsUntil indent (try (optional blankline *> indentWith indent *> manyTill spaceChar (string "::") *> descriptionsUntil indent end)) (([],) <$> end)
671660 return (x:xs, e)
672661
673662definitionListItemsUntil :: PandocMonad m
@@ -680,7 +669,7 @@ definitionListItemsUntil indent end =
680669 continuation = try $ do
681670 pos <- getPosition
682671 term <- trimInlinesF . mconcat <$> manyTill (choice inlineList) (try $ string "::")
683− (x, (xs, e)) <- descriptionsUntil (sourceColumn pos) (try (optional blankline >> indentWith indent >> continuation) <|> (([],) <$> end))
672+ (x, (xs, e)) <- descriptionsUntil (sourceColumn pos) (try (optional blankline *> indentWith indent *> continuation) <|> (([],) <$> end))
684673 let xx = (,) <$> term <*> sequence x
685674 return (xx:xs, e)
686675
@@ -736,7 +725,7 @@ museAppendElement element tbl =
736725
737726tableCell :: PandocMonad m => MuseParser m (F Blocks)
738727tableCell = try $ fmap B.plain . trimInlinesF . mconcat <$> manyTill inline (lookAhead cellEnd)
739− where cellEnd = try $ void (many1 spaceChar >> char '|') <|> eol
728+ where cellEnd = try $ void (many1 spaceChar *> char '|') <|> eol
740729
741730tableElements :: PandocMonad m => MuseParser m (F [MuseTableElement])
742731tableElements = sequence <$> (tableParseElement `sepEndBy1` eol)
@@ -758,11 +747,10 @@ tableParseElement = tableParseHeader
758747tableParseRow :: PandocMonad m
759748 => Int -- ^ Number of separator characters
760749 -> MuseParser m (F [Blocks])
761−tableParseRow n = try $ do
762− fields <- tableCell `sepBy2` fieldSep
763− return $ sequence fields
764− where p `sepBy2` sep = (:) <$> p <*> many1 (sep >> p)
765− fieldSep = many1 spaceChar >> count n (char '|') >> (void (many1 spaceChar) <|> void (lookAhead newline))
750+tableParseRow n = try $
751+ sequence <$> (tableCell `sepBy2` fieldSep)
752+ where p `sepBy2` sep = (:) <$> p <*> many1 (sep *> p)
753+ fieldSep = many1 spaceChar *> count n (char '|') *> (void (many1 spaceChar) <|> void (lookAhead newline))
766754
767755-- | Parse a table header row.
768756tableParseHeader :: PandocMonad m => MuseParser m (F MuseTableElement)
@@ -778,10 +766,10 @@ tableParseFooter = fmap MuseFooterRow <$> tableParseRow 3
778766
779767-- | Parse table caption.
780768tableParseCaption :: PandocMonad m => MuseParser m (F MuseTableElement)
781−tableParseCaption = try $ do
782− many spaceChar
783− string "|+"
784− fmap MuseCaption <$> (trimInlinesF . mconcat <$> many1Till inline (string "+|"))
769+tableParseCaption = try $ fmap MuseCaption . trimInlinesF . mconcat
770+ <$ many spaceChar
771+ <* string "|+"
772+ <*> many1Till inline (string "+|")
785773
786774-- ** Inline parsers
787775
@@ -815,10 +803,7 @@ inline = endline <|> choice inlineList <?> "inline"
815803
816804-- | Parse a soft break.
817805endline :: PandocMonad m => MuseParser m (F Inlines)
818−endline = try $ do
819− newline
820− notFollowedBy blankline
821− return $ return B.softbreak
806+endline = try $ pure B.softbreak <$ newline <* notFollowedBy blankline
822807
823808parseAnchor :: PandocMonad m => MuseParser m String
824809parseAnchor = try $ do
@@ -848,15 +833,11 @@ footnote = try $ do
848833 return $ B.note contents'
849834
850835whitespace :: PandocMonad m => MuseParser m (F Inlines)
851−whitespace = try $ do
852− skipMany1 spaceChar
853− return $ return B.space
836+whitespace = try $ pure B.space <$ skipMany1 spaceChar
854837
855838-- | Parse @\<br>@ tag.
856839br :: PandocMonad m => MuseParser m (F Inlines)
857−br = try $ do
858− string "<br>"
859− return $ return B.linebreak
840+br = try $ pure B.linebreak <$ string "<br>"
860841
861842emphasisBetween :: (PandocMonad m, Show a) => MuseParser m a -> MuseParser m (F Inlines)
862843emphasisBetween c = try $ enclosedInlines c c
@@ -867,7 +848,7 @@ enclosed :: (Show end, Stream s m Char) => ParserT s st m t -- ^ start parser
867848 -> ParserT s st m a -- ^ content parser (to be used repeatedly)
868849 -> ParserT s st m [a]
869850enclosed start end parser = try $
870− start >> notFollowedBy spaceChar >> many1Till parser end
851+ start *> notFollowedBy spaceChar *> many1Till parser end
871852
872853enclosedInlines :: (PandocMonad m, Show a, Show b)
873854 => MuseParser m a
@@ -880,9 +861,9 @@ enclosedInlines start end = try $
880861inlineTag :: PandocMonad m
881862 => String -- ^ Tag name
882863 -> MuseParser m (F Inlines)
883−inlineTag tag = try $ do
884− openTag tag
885− mconcat <$> manyTill inline (closeTag tag)
864+inlineTag tag = try $ mconcat
865+ <$ openTag tag
866+ <*> manyTill inline (closeTag tag)
886867
887868-- | Parse strong inline markup, indicated by @**@.
888869strong :: PandocMonad m => MuseParser m (F Inlines)
@@ -933,9 +914,7 @@ classTag = do
933914
934915-- | Parse "~~" as nonbreaking space.
935916nbsp :: PandocMonad m => MuseParser m (F Inlines)
936−nbsp = try $ do
937− string "~~"
938− return $ return $ B.str "\160"
917+nbsp = try $ pure (B.str "\160") <$ string "~~"
939918
940919-- | Parse code markup, indicated by @\'=\'@ characters.
941920code :: PandocMonad m => MuseParser m (F Inlines)
@@ -983,7 +962,9 @@ linkOrImage = try $ do
983962 return res
984963
985964linkContent :: PandocMonad m => MuseParser m (F Inlines)
986−linkContent = char '[' >> trimInlinesF . mconcat <$> manyTill inline (char ']')
965+linkContent = trimInlinesF . mconcat
966+ <$ char '['
967+ <*> manyTill inline (char ']')
987968
988969-- | Parse a link starting with @URL:@
989970explicitLink :: PandocMonad m => MuseParser m (F Inlines)
@@ -1016,12 +997,11 @@ image = try $ do
1016997 ext <- imageExtension
1017998 (width, align) <- option (Nothing, Nothing) imageAttrs
1018999 return (ext, width, align)
1019− imageAttrs = do
1020− many1 spaceChar
1021− width <- optionMaybe (many1 digit)
1022− many spaceChar
1023− align <- optionMaybe (oneOf "rlf")
1024− return (width, align)
1000+ imageAttrs = (,)
1001+ <$ many1 spaceChar
1002+ <*> optionMaybe (many1 digit)
1003+ <* many spaceChar
1004+ <*> optionMaybe (oneOf "rlf")
10251005
10261006link :: PandocMonad m => MuseParser m (F Inlines)
10271007link = try $ do