@@ -930,14 +930,45 @@ htmlInBalanced :: (Monad m)
930930 => (Tag String -> Bool)
931931 -> ParserT String st m String
932932htmlInBalanced f = try $ do
933− (TagOpen t _, tag) <- htmlTag f
934− guard $ not $ "/>" `isSuffixOf` tag -- not a self-closing tag
935− let stopper = htmlTag (~== TagClose t)
936− let anytag = snd <$> htmlTag (const True)
937− contents <- many $ notFollowedBy' stopper >>
938− (htmlInBalanced f <|> anytag <|> count 1 anyChar)
939− endtag <- liftM snd stopper
940− return $ tag ++ concat contents ++ endtag
933+ lookAhead (char '<')
934+ inp <- getInput
935+ let ts = canonicalizeTags $
936+ parseTagsOptions parseOptions{ optTagWarning = True,
937+ optTagPosition = True } inp
938+ case ts of
939+ (TagPosition sr sc : t@(TagOpen tn _) : rest) -> do
940+ guard $ f t
941+ guard $ not $ hasTagWarning (t : take 1 rest)
942+ case htmlInBalanced' tn (t:rest) of
943+ [] -> mzero
944+ xs -> case reverse xs of
945+ (TagClose _ : TagPosition er ec : _) -> do
946+ let ls = er - sr
947+ let cs = ec - sc
948+ lscontents <- concat <$> count ls anyLine
949+ cscontents <- count cs anyChar
950+ (_,closetag) <- htmlTag (~== TagClose tn)
951+ return (lscontents ++ cscontents ++ closetag)
952+ _ -> mzero
953+ _ -> mzero
954+
955+htmlInBalanced' :: String
956+ -> [Tag String]
957+ -> [Tag String]
958+htmlInBalanced' tagname ts = fromMaybe [] $ go 0 ts
959+ where go :: Int -> [Tag String] -> Maybe [Tag String]
960+ go n (t@(TagOpen tn' _):rest) | tn' == tagname =
961+ (t :) <$> go (n + 1) rest
962+ go 1 (t@(TagClose tn'):_) | tn' == tagname =
963+ return [t]
964+ go n (t@(TagClose tn'):rest) | tn' == tagname =
965+ (t :) <$> go (n - 1) rest
966+ go n (t:ts') = (t :) <$> go n ts'
967+ go n [] = mzero
968+
969+hasTagWarning :: [Tag String] -> Bool
970+hasTagWarning (TagWarning _:_) = True
971+hasTagWarning _ = False
941972
942973-- | Matches a tag meeting a certain condition.
943974htmlTag :: Monad m
@@ -946,8 +977,6 @@ htmlTag :: Monad m
946977htmlTag f = try $ do
947978 lookAhead (char '<')
948979 inp <- getInput
949− let hasTagWarning (TagWarning _:_) = True
950− hasTagWarning _ = False
951980 let (next : rest) = canonicalizeTags $ parseTagsOptions
952981 parseOptions{ optTagWarning = True } inp
953982 guard $ f next