HTML reader: parse location tags in pSatisfy.

This avoids the need for manual parsing all over the place.
This commit is contained in:
John MacFarlane 2011-01-14 20:47:32 -08:00
parent 9305114b9f
commit c31d3cc306

View file

@ -78,9 +78,8 @@ parseBody :: TagParser [Block]
parseBody = liftM concat $ manyTill block eof
block :: TagParser [Block]
block = optional pLocation >>
choice [
pPara
block = choice
[ pPara
, pHeader
, pBlockQuote
, pCodeBlock
@ -235,9 +234,8 @@ pCodeBlock = try $ do
return [CodeBlock attribs result]
inline :: TagParser [Inline]
inline = choice [
pLocation
, pTagText
inline = choice
[ pTagText
, pEmph
, pStrong
, pSuperscript
@ -250,17 +248,19 @@ inline = choice [
, pRawHtmlInline
]
pLocation :: TagParser [a]
pLocation :: TagParser ()
pLocation = do
(TagPosition r c) <- pSatisfy isTagPosition
(TagPosition r c) <- pSat isTagPosition
setPosition $ newPos "input" r c
return []
pSatisfy :: (Tag String -> Bool) -> TagParser (Tag String)
pSatisfy f = do
pSat :: (Tag String -> Bool) -> TagParser (Tag String)
pSat f = do
pos <- getPosition
token show (const pos) (\x -> if f x then Just x else Nothing)
pSatisfy :: (Tag String -> Bool) -> TagParser (Tag String)
pSatisfy f = try $ optional pLocation >> pSat f
pAnyTag :: TagParser (Tag String)
pAnyTag = pSatisfy (const True)
@ -268,7 +268,7 @@ pSelfClosing :: (String -> Bool) -> ([Attribute String] -> Bool)
-> TagParser (Tag String)
pSelfClosing f g = do
open <- pSatisfy (tagOpen f g)
optional $ try $ pLocation >> pSatisfy (tagClose f)
optional $ pSatisfy (tagClose f)
return open
pEmph :: TagParser [Inline]
@ -342,7 +342,6 @@ pInTags tagtype parser = try $ do
pCloses :: String -> TagParser ()
pCloses tagtype = try $ do
optional pLocation
t <- lookAhead $ pSatisfy $ \tag -> isTagClose tag || isTagOpen tag
case t of
(TagClose t') | t' == tagtype -> pAnyTag >> return ()
@ -360,6 +359,11 @@ pTagText = try $ do
Left _ -> fail $ "Could not parse `" ++ str ++ "'"
Right result -> return result
pBlank :: TagParser ()
pBlank = try $ do
(TagText str) <- pSatisfy isTagText
guard $ all isSpace str
pTagContents :: GenParser Char ParserState Inline
pTagContents = pStr <|> pSpace <|> smartPunctuation pTagContents <|> pSymbol