-- | Combinators to match tags. Some people prefer to use @(~==)@ from
--   "Text.HTML.TagSoup", others prefer these more structured combinators.
--   Which you use is personal preference.
--
-- The functions below offer maximum flexibility for matching tags.
-- Using 'tagOpen', for example, you can match all links or buttons that have the "btn" class.
--
-- For simple uses cases—like matching all comment tags, or matching opening @\<a>@ tags,
-- use the tag identification functions in "Text.HTML.TagSoup#tag-identification".
module Text.HTML.TagSoup.Match where

import Text.HTML.TagSoup.Type (Tag(..), Attribute)
import Data.List (tails)

-- * Matching Tags

-- | Match an opening tag
--
-- ==== __Examples__
--
-- /Matching an opening @\<a>@ tag with a @"btn"@ class:/
--
-- >>> let tag = TagOpen "a" [("class", "btn")]
-- >>> tagOpen (== "a") (\attrs -> any (== ("class", "btn")) attrs) tag
-- True
tagOpen :: (str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen :: forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen str -> Bool
pName [Attribute str] -> Bool
pAttrs (TagOpen str
name [Attribute str]
attrs) =
   str -> Bool
pName str
name Bool -> Bool -> Bool
&& [Attribute str] -> Bool
pAttrs [Attribute str]
attrs
tagOpen str -> Bool
_ [Attribute str] -> Bool
_ Tag str
_ = Bool
False

-- | Match a closing tag
--
-- ==== __Examples__
--
-- /Matching a closing @\<\/a>@ tag:/
--
-- >>> tagClose (== "a") (TagClose "a")
-- True
--
-- >>> tagClose (== "a") (TagOpen "a" [])
-- False
tagClose :: (str -> Bool) -> Tag str -> Bool
tagClose :: forall str. (str -> Bool) -> Tag str -> Bool
tagClose str -> Bool
pName (TagClose str
name) = str -> Bool
pName str
name
tagClose str -> Bool
_ Tag str
_ = Bool
False

-- | Match text tags
--
-- ==== __Examples__
--
-- /Match all text tags:/
--
-- >>> let tags = parseTags "<p>This is a paragraph</p>"
-- [TagOpen "p" [],TagText "This is a paragraph",TagClose "p"]
-- >>> filter (tagText (const True)) tags
-- [TagText "This is a paragraph"]
tagText :: (str -> Bool) -> Tag str -> Bool
tagText :: forall str. (str -> Bool) -> Tag str -> Bool
tagText str -> Bool
p (TagText str
text) = str -> Bool
p str
text
tagText str -> Bool
_ Tag str
_ = Bool
False

-- | Match comment tags
--
-- ==== __Examples__
--
-- /Matching comment tags that include an exclamation mark:/
--
-- >>> let tags = parseTags "<!--This is a comment-->"
-- [TagComment "This is a comment!"]
-- >>> all (tagComment (\s -> '!' `elem` s)) tags
-- True
tagComment :: (str -> Bool) -> Tag str -> Bool
tagComment :: forall str. (str -> Bool) -> Tag str -> Bool
tagComment str -> Bool
p (TagComment str
text) = str -> Bool
p str
text
tagComment str -> Bool
_ Tag str
_ = Bool
False


-- | Match an opening tag's name literally
--
-- ==== __Examples__
--
-- /Matching @\<a>@ tags with the @id@ "foo":/
--
-- >>> let tag = TagOpen "a" [("id", "foo")]
-- TagOpen "a" [("id","foo")]
-- >>> tagOpenLit "a" (\attrs -> any (== ("id", "foo")) attrs) tag
-- True
--
tagOpenLit :: Eq str => str -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpenLit :: forall str.
Eq str =>
str -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpenLit str
name = (str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
forall str.
(str -> Bool) -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpen (str
namestr -> str -> Bool
forall a. Eq a => a -> a -> Bool
==)

-- | Match a closing tag's name literally
--
-- ==== __Examples__
--
-- /Match a closing @\<a>@ tag:/
--
-- >>> tagCloseLit "a" (TagClose "a")
-- True
--
-- >>> tagCloseLit "a" (TagClose "em")
-- False
tagCloseLit :: Eq str => str -> Tag str -> Bool
tagCloseLit :: forall str. Eq str => str -> Tag str -> Bool
tagCloseLit str
name = (str -> Bool) -> Tag str -> Bool
forall str. (str -> Bool) -> Tag str -> Bool
tagClose (str
namestr -> str -> Bool
forall a. Eq a => a -> a -> Bool
==)

-- | Match an opening tag's name literally, and at least one of its attributes
--
-- ==== __Examples__
--
-- /Matching a @\<div>@ tag with the @id@ "foo":/
--
-- >>> tagOpenAttrLit "div" ("id", "foo") (TagOpen "div" [("id", "foo")])
-- True
tagOpenAttrLit :: Eq str => str -> Attribute str -> Tag str -> Bool
tagOpenAttrLit :: forall str. Eq str => str -> Attribute str -> Tag str -> Bool
tagOpenAttrLit str
name Attribute str
attr =
   str -> ([Attribute str] -> Bool) -> Tag str -> Bool
forall str.
Eq str =>
str -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpenLit str
name (Attribute str -> [Attribute str] -> Bool
forall str. Eq str => (str, str) -> [(str, str)] -> Bool
anyAttrLit Attribute str
attr)

{- |
Match a tag with given name, that contains an attribute
with given name, that satisfies a predicate.
If an attribute occurs multiple times,
all occurrences are checked.

==== __Examples__

/Matching an @\<a>@ tag with an ID that starts with "comment-":/

>>> let commentTag = TagOpen "a" [("id", "comment-45678")]
>>> tagOpenAttrNameLit "a" "id" (\idValue -> "comment-" `Data.List.isPrefixOf` idValue) commentTag
True
-}
tagOpenAttrNameLit :: Eq str => str -> str -> (str -> Bool) -> Tag str -> Bool
tagOpenAttrNameLit :: forall str.
Eq str =>
str -> str -> (str -> Bool) -> Tag str -> Bool
tagOpenAttrNameLit str
tagName str
attrName str -> Bool
pAttrValue =
   str -> ([Attribute str] -> Bool) -> Tag str -> Bool
forall str.
Eq str =>
str -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpenLit str
tagName
      ((Attribute str -> Bool) -> [Attribute str] -> Bool
forall str. ((str, str) -> Bool) -> [(str, str)] -> Bool
anyAttr (\(str
name,str
value) -> str
namestr -> str -> Bool
forall a. Eq a => a -> a -> Bool
==str
attrName Bool -> Bool -> Bool
&& str -> Bool
pAttrValue str
value))


-- | Check if the 'Tag str' is 'TagOpen' and matches the given name
--
-- ==== __Examples__
--
-- /Matching an @\<a>@ tag:/
--
-- >>> tagOpenNameLit "a" (TagOpen "a" [])
-- True
--
-- >>> tagOpenNameLit "a" (TagOpen "div" [])
-- False
tagOpenNameLit :: Eq str => str -> Tag str -> Bool
tagOpenNameLit :: forall str. Eq str => str -> Tag str -> Bool
tagOpenNameLit str
name = str -> ([Attribute str] -> Bool) -> Tag str -> Bool
forall str.
Eq str =>
str -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpenLit str
name (Bool -> [Attribute str] -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | Check if the 'Tag str' is 'TagClose' and matches the given name
--
-- ==== __Examples__
--
-- /Matching a closing @\<\/a>@ tag:/
--
-- >>> tagCloseNameLit "a" (TagClose "a")
-- True
--
-- >>> tagCloseNameLit "a" (TagClose "div")
-- False
tagCloseNameLit :: Eq str => str -> Tag str -> Bool
tagCloseNameLit :: forall str. Eq str => str -> Tag str -> Bool
tagCloseNameLit str
name = str -> Tag str -> Bool
forall str. Eq str => str -> Tag str -> Bool
tagCloseLit str
name


-- * Matching attributes

-- | Does any attribute name/value match the predicate.
anyAttr :: ((str,str) -> Bool) -> [Attribute str] -> Bool
anyAttr :: forall str. ((str, str) -> Bool) -> [(str, str)] -> Bool
anyAttr = ((str, str) -> Bool) -> [(str, str)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any

-- | Does any attribute name match the predicate.
anyAttrName :: (str -> Bool) -> [Attribute str] -> Bool
anyAttrName :: forall str. (str -> Bool) -> [Attribute str] -> Bool
anyAttrName str -> Bool
p = (Attribute str -> Bool) -> [Attribute str] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (str -> Bool
p (str -> Bool) -> (Attribute str -> str) -> Attribute str -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attribute str -> str
forall a b. (a, b) -> a
fst)

-- | Does any attribute value match the predicate.
anyAttrValue :: (str -> Bool) -> [Attribute str] -> Bool
anyAttrValue :: forall str. (str -> Bool) -> [Attribute str] -> Bool
anyAttrValue str -> Bool
p = (Attribute str -> Bool) -> [Attribute str] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (str -> Bool
p (str -> Bool) -> (Attribute str -> str) -> Attribute str -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attribute str -> str
forall a b. (a, b) -> b
snd)


-- | Does any attribute name/value match.
anyAttrLit :: Eq str => (str,str) -> [Attribute str] -> Bool
anyAttrLit :: forall str. Eq str => (str, str) -> [(str, str)] -> Bool
anyAttrLit (str, str)
attr = ((str, str) -> Bool) -> [(str, str)] -> Bool
forall str. ((str, str) -> Bool) -> [(str, str)] -> Bool
anyAttr ((str, str)
attr(str, str) -> (str, str) -> Bool
forall a. Eq a => a -> a -> Bool
==)

-- | Does any attribute name match.
anyAttrNameLit :: Eq str => str -> [Attribute str] -> Bool
anyAttrNameLit :: forall str. Eq str => str -> [Attribute str] -> Bool
anyAttrNameLit str
name = (str -> Bool) -> [Attribute str] -> Bool
forall str. (str -> Bool) -> [Attribute str] -> Bool
anyAttrName (str
namestr -> str -> Bool
forall a. Eq a => a -> a -> Bool
==)

-- | Does any attribute value match.
anyAttrValueLit :: Eq str => str -> [Attribute str] -> Bool
anyAttrValueLit :: forall str. Eq str => str -> [Attribute str] -> Bool
anyAttrValueLit str
value = (str -> Bool) -> [Attribute str] -> Bool
forall str. (str -> Bool) -> [Attribute str] -> Bool
anyAttrValue (str
valuestr -> str -> Bool
forall a. Eq a => a -> a -> Bool
==)



-- | Get the tags under tags with a given name where the attributes match some predicate.
getTagContent :: Eq str => str -> ([Attribute str] -> Bool) -> [Tag str] -> [Tag str]
getTagContent :: forall str.
Eq str =>
str -> ([Attribute str] -> Bool) -> [Tag str] -> [Tag str]
getTagContent str
name [Attribute str] -> Bool
pAttrs =
   (Tag str -> Bool) -> [Tag str] -> [Tag str]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Tag str -> Bool) -> Tag str -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. str -> Tag str -> Bool
forall str. Eq str => str -> Tag str -> Bool
tagCloseLit str
name) ([Tag str] -> [Tag str])
-> ([Tag str] -> [Tag str]) -> [Tag str] -> [Tag str]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Tag str] -> [Tag str]
forall a. Int -> [a] -> [a]
drop Int
1 ([Tag str] -> [Tag str])
-> ([Tag str] -> [Tag str]) -> [Tag str] -> [Tag str]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   [[Tag str]] -> [Tag str]
forall a. HasCallStack => [a] -> a
head ([[Tag str]] -> [Tag str])
-> ([Tag str] -> [[Tag str]]) -> [Tag str] -> [Tag str]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag str -> Bool) -> [Tag str] -> [[Tag str]]
forall {b}. (b -> Bool) -> [b] -> [[b]]
sections (str -> ([Attribute str] -> Bool) -> Tag str -> Bool
forall str.
Eq str =>
str -> ([Attribute str] -> Bool) -> Tag str -> Bool
tagOpenLit str
name [Attribute str] -> Bool
pAttrs)
    where sections :: (b -> Bool) -> [b] -> [[b]]
sections b -> Bool
p = ([b] -> Bool) -> [[b]] -> [[b]]
forall a. (a -> Bool) -> [a] -> [a]
filter (b -> Bool
p (b -> Bool) -> ([b] -> b) -> [b] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> b
forall a. HasCallStack => [a] -> a
head) ([[b]] -> [[b]]) -> ([b] -> [[b]]) -> [b] -> [[b]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[b]] -> [[b]]
forall a. HasCallStack => [a] -> [a]
init ([[b]] -> [[b]]) -> ([b] -> [[b]]) -> [b] -> [[b]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> [[b]]
forall a. [a] -> [[a]]
tails