Removed (>>~) function
This function is equivalent to the more general (<*) which is defined in Control.Applicative. This change makes pandoc code easier to understand for those not familar with the codebase.
This commit is contained in:
parent
f201bdcb58
commit
2fb8063f78
6 changed files with 17 additions and 22 deletions
|
@ -32,8 +32,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||||
|
|
||||||
A utility library with parsers used in pandoc readers.
|
A utility library with parsers used in pandoc readers.
|
||||||
-}
|
-}
|
||||||
module Text.Pandoc.Parsing ( (>>~),
|
module Text.Pandoc.Parsing ( anyLine,
|
||||||
anyLine,
|
|
||||||
many1Till,
|
many1Till,
|
||||||
notFollowedBy',
|
notFollowedBy',
|
||||||
oneOfStrings,
|
oneOfStrings,
|
||||||
|
@ -101,6 +100,7 @@ module Text.Pandoc.Parsing ( (>>~),
|
||||||
macro,
|
macro,
|
||||||
applyMacros',
|
applyMacros',
|
||||||
Parser,
|
Parser,
|
||||||
|
ParserT,
|
||||||
F(..),
|
F(..),
|
||||||
runF,
|
runF,
|
||||||
askF,
|
askF,
|
||||||
|
@ -205,11 +205,6 @@ instance Monoid a => Monoid (F a) where
|
||||||
mappend = liftM2 mappend
|
mappend = liftM2 mappend
|
||||||
mconcat = liftM mconcat . sequence
|
mconcat = liftM mconcat . sequence
|
||||||
|
|
||||||
-- | Like >>, but returns the operation on the left.
|
|
||||||
-- (Suggested by Tillmann Rendel on Haskell-cafe list.)
|
|
||||||
(>>~) :: (Applicative m) => m a -> m b -> m a
|
|
||||||
a >>~ b = a <* b
|
|
||||||
|
|
||||||
-- | Parse any line of text
|
-- | Parse any line of text
|
||||||
anyLine :: Stream [Char] m Char => ParserT [Char] st m [Char]
|
anyLine :: Stream [Char] m Char => ParserT [Char] st m [Char]
|
||||||
anyLine = do
|
anyLine = do
|
||||||
|
@ -484,7 +479,7 @@ mathInlineWith op cl = try $ do
|
||||||
mathDisplayWith :: Stream s m Char => String -> String -> ParserT s st m String
|
mathDisplayWith :: Stream s m Char => String -> String -> ParserT s st m String
|
||||||
mathDisplayWith op cl = try $ do
|
mathDisplayWith op cl = try $ do
|
||||||
string op
|
string op
|
||||||
many1Till (noneOf "\n" <|> (newline >>~ notFollowedBy' blankline)) (try $ string cl)
|
many1Till (noneOf "\n" <|> (newline <* notFollowedBy' blankline)) (try $ string cl)
|
||||||
|
|
||||||
mathDisplay :: Stream s m Char => ParserT s ParserState m String
|
mathDisplay :: Stream s m Char => ParserT s ParserState m String
|
||||||
mathDisplay =
|
mathDisplay =
|
||||||
|
@ -759,7 +754,7 @@ gridPart ch = do
|
||||||
return (length dashes, length dashes + 1)
|
return (length dashes, length dashes + 1)
|
||||||
|
|
||||||
gridDashedLines :: Stream s m Char => Char -> ParserT s st m [(Int,Int)]
|
gridDashedLines :: Stream s m Char => Char -> ParserT s st m [(Int,Int)]
|
||||||
gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) >>~ blankline
|
gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) <* blankline
|
||||||
|
|
||||||
removeFinalBar :: String -> String
|
removeFinalBar :: String -> String
|
||||||
removeFinalBar =
|
removeFinalBar =
|
||||||
|
|
|
@ -128,7 +128,7 @@ pBulletList = try $ do
|
||||||
-- note: if they have an <ol> or <ul> not in scope of a <li>,
|
-- note: if they have an <ol> or <ul> not in scope of a <li>,
|
||||||
-- treat it as a list item, though it's not valid xhtml...
|
-- treat it as a list item, though it's not valid xhtml...
|
||||||
skipMany nonItem
|
skipMany nonItem
|
||||||
items <- manyTill (pInTags "li" block >>~ skipMany nonItem) (pCloses "ul")
|
items <- manyTill (pInTags "li" block <* skipMany nonItem) (pCloses "ul")
|
||||||
return $ B.bulletList $ map (fixPlains True) items
|
return $ B.bulletList $ map (fixPlains True) items
|
||||||
|
|
||||||
pOrderedList :: TagParser Blocks
|
pOrderedList :: TagParser Blocks
|
||||||
|
@ -156,7 +156,7 @@ pOrderedList = try $ do
|
||||||
-- note: if they have an <ol> or <ul> not in scope of a <li>,
|
-- note: if they have an <ol> or <ul> not in scope of a <li>,
|
||||||
-- treat it as a list item, though it's not valid xhtml...
|
-- treat it as a list item, though it's not valid xhtml...
|
||||||
skipMany nonItem
|
skipMany nonItem
|
||||||
items <- manyTill (pInTags "li" block >>~ skipMany nonItem) (pCloses "ol")
|
items <- manyTill (pInTags "li" block <* skipMany nonItem) (pCloses "ol")
|
||||||
return $ B.orderedListWith (start, style, DefaultDelim) $ map (fixPlains True) items
|
return $ B.orderedListWith (start, style, DefaultDelim) $ map (fixPlains True) items
|
||||||
|
|
||||||
pDefinitionList :: TagParser Blocks
|
pDefinitionList :: TagParser Blocks
|
||||||
|
@ -244,7 +244,7 @@ pTable :: TagParser Blocks
|
||||||
pTable = try $ do
|
pTable = try $ do
|
||||||
TagOpen _ _ <- pSatisfy (~== TagOpen "table" [])
|
TagOpen _ _ <- pSatisfy (~== TagOpen "table" [])
|
||||||
skipMany pBlank
|
skipMany pBlank
|
||||||
caption <- option mempty $ pInTags "caption" inline >>~ skipMany pBlank
|
caption <- option mempty $ pInTags "caption" inline <* skipMany pBlank
|
||||||
-- TODO actually read these and take width information from them
|
-- TODO actually read these and take width information from them
|
||||||
widths' <- pColgroup <|> many pCol
|
widths' <- pColgroup <|> many pCol
|
||||||
head' <- option [] $ pOptInTag "thead" $ pInTags "tr" (pCell "th")
|
head' <- option [] $ pOptInTag "thead" $ pInTags "tr" (pCell "th")
|
||||||
|
|
|
@ -104,7 +104,7 @@ dimenarg = try $ do
|
||||||
|
|
||||||
sp :: LP ()
|
sp :: LP ()
|
||||||
sp = skipMany1 $ satisfy (\c -> c == ' ' || c == '\t')
|
sp = skipMany1 $ satisfy (\c -> c == ' ' || c == '\t')
|
||||||
<|> (try $ newline >>~ lookAhead anyChar >>~ notFollowedBy blankline)
|
<|> (try $ newline <* lookAhead anyChar <* notFollowedBy blankline)
|
||||||
|
|
||||||
isLowerHex :: Char -> Bool
|
isLowerHex :: Char -> Bool
|
||||||
isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
|
isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
|
||||||
|
|
|
@ -571,7 +571,7 @@ attributes :: MarkdownParser Attr
|
||||||
attributes = try $ do
|
attributes = try $ do
|
||||||
char '{'
|
char '{'
|
||||||
spnl
|
spnl
|
||||||
attrs <- many (attribute >>~ spnl)
|
attrs <- many (attribute <* spnl)
|
||||||
char '}'
|
char '}'
|
||||||
return $ foldl (\x f -> f x) nullAttr attrs
|
return $ foldl (\x f -> f x) nullAttr attrs
|
||||||
|
|
||||||
|
@ -688,7 +688,7 @@ birdTrackLine c = try $ do
|
||||||
--
|
--
|
||||||
|
|
||||||
emailBlockQuoteStart :: MarkdownParser Char
|
emailBlockQuoteStart :: MarkdownParser Char
|
||||||
emailBlockQuoteStart = try $ skipNonindentSpaces >> char '>' >>~ optional (char ' ')
|
emailBlockQuoteStart = try $ skipNonindentSpaces >> char '>' <* optional (char ' ')
|
||||||
|
|
||||||
emailBlockQuote :: MarkdownParser [String]
|
emailBlockQuote :: MarkdownParser [String]
|
||||||
emailBlockQuote = try $ do
|
emailBlockQuote = try $ do
|
||||||
|
@ -1165,7 +1165,7 @@ gridPart ch = do
|
||||||
return (length dashes, length dashes + 1)
|
return (length dashes, length dashes + 1)
|
||||||
|
|
||||||
gridDashedLines :: Char -> Parser [Char] st [(Int,Int)]
|
gridDashedLines :: Char -> Parser [Char] st [(Int,Int)]
|
||||||
gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) >>~ blankline
|
gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) <* blankline
|
||||||
|
|
||||||
removeFinalBar :: String -> String
|
removeFinalBar :: String -> String
|
||||||
removeFinalBar =
|
removeFinalBar =
|
||||||
|
@ -1499,7 +1499,7 @@ inlinesBetween :: (Show b)
|
||||||
inlinesBetween start end =
|
inlinesBetween start end =
|
||||||
(trimInlinesF . mconcat) <$> try (start >> many1Till inner end)
|
(trimInlinesF . mconcat) <$> try (start >> many1Till inner end)
|
||||||
where inner = innerSpace <|> (notFollowedBy' (() <$ whitespace) >> inline)
|
where inner = innerSpace <|> (notFollowedBy' (() <$ whitespace) >> inline)
|
||||||
innerSpace = try $ whitespace >>~ notFollowedBy' end
|
innerSpace = try $ whitespace <* notFollowedBy' end
|
||||||
|
|
||||||
strikeout :: MarkdownParser (F Inlines)
|
strikeout :: MarkdownParser (F Inlines)
|
||||||
strikeout = fmap B.strikeout <$>
|
strikeout = fmap B.strikeout <$>
|
||||||
|
|
|
@ -634,7 +634,7 @@ inlinesBetween :: (Show b) => MWParser a -> MWParser b -> MWParser Inlines
|
||||||
inlinesBetween start end =
|
inlinesBetween start end =
|
||||||
(trimInlines . mconcat) <$> try (start >> many1Till inner end)
|
(trimInlines . mconcat) <$> try (start >> many1Till inner end)
|
||||||
where inner = innerSpace <|> (notFollowedBy' (() <$ whitespace) >> inline)
|
where inner = innerSpace <|> (notFollowedBy' (() <$ whitespace) >> inline)
|
||||||
innerSpace = try $ whitespace >>~ notFollowedBy' end
|
innerSpace = try $ whitespace <* notFollowedBy' end
|
||||||
|
|
||||||
emph :: MWParser Inlines
|
emph :: MWParser Inlines
|
||||||
emph = B.emph <$> nested (inlinesBetween start end)
|
emph = B.emph <$> nested (inlinesBetween start end)
|
||||||
|
|
|
@ -460,7 +460,7 @@ listItem :: RSTParser Int
|
||||||
listItem start = try $ do
|
listItem start = try $ do
|
||||||
(markerLength, first) <- rawListItem start
|
(markerLength, first) <- rawListItem start
|
||||||
rest <- many (listContinuation markerLength)
|
rest <- many (listContinuation markerLength)
|
||||||
blanks <- choice [ try (many blankline >>~ lookAhead start),
|
blanks <- choice [ try (many blankline <* lookAhead start),
|
||||||
many1 blankline ] -- whole list must end with blank.
|
many1 blankline ] -- whole list must end with blank.
|
||||||
-- parsing with ListItemState forces markers at beginning of lines to
|
-- parsing with ListItemState forces markers at beginning of lines to
|
||||||
-- count as list item markers, even if not separated by blank space.
|
-- count as list item markers, even if not separated by blank space.
|
||||||
|
@ -480,7 +480,7 @@ listItem start = try $ do
|
||||||
|
|
||||||
orderedList :: RSTParser Blocks
|
orderedList :: RSTParser Blocks
|
||||||
orderedList = try $ do
|
orderedList = try $ do
|
||||||
(start, style, delim) <- lookAhead (anyOrderedListMarker >>~ spaceChar)
|
(start, style, delim) <- lookAhead (anyOrderedListMarker <* spaceChar)
|
||||||
items <- many1 (listItem (orderedListStart style delim))
|
items <- many1 (listItem (orderedListStart style delim))
|
||||||
let items' = compactify' items
|
let items' = compactify' items
|
||||||
return $ B.orderedListWith (start, style, delim) items'
|
return $ B.orderedListWith (start, style, delim) items'
|
||||||
|
@ -747,7 +747,7 @@ simpleReferenceName = do
|
||||||
|
|
||||||
referenceName :: RSTParser Inlines
|
referenceName :: RSTParser Inlines
|
||||||
referenceName = quotedReferenceName <|>
|
referenceName = quotedReferenceName <|>
|
||||||
(try $ simpleReferenceName >>~ lookAhead (char ':')) <|>
|
(try $ simpleReferenceName <* lookAhead (char ':')) <|>
|
||||||
unquotedReferenceName
|
unquotedReferenceName
|
||||||
|
|
||||||
referenceKey :: RSTParser [Char]
|
referenceKey :: RSTParser [Char]
|
||||||
|
@ -1076,7 +1076,7 @@ explicitLink = try $ do
|
||||||
|
|
||||||
referenceLink :: RSTParser Inlines
|
referenceLink :: RSTParser Inlines
|
||||||
referenceLink = try $ do
|
referenceLink = try $ do
|
||||||
(label',ref) <- withRaw (quotedReferenceName <|> simpleReferenceName) >>~
|
(label',ref) <- withRaw (quotedReferenceName <|> simpleReferenceName) <*
|
||||||
char '_'
|
char '_'
|
||||||
state <- getState
|
state <- getState
|
||||||
let keyTable = stateKeys state
|
let keyTable = stateKeys state
|
||||||
|
|
Loading…
Add table
Reference in a new issue