-- | 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 @\@ 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 @\@ 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 pName pAttrs (TagOpen name attrs) =

   pName name && pAttrs attrs

tagOpen _ _ _ = 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 pName (TagClose name) = pName name

tagClose _ _ = False

-- | Match text tags

--

-- ==== __Examples__

--

-- /Match all text tags:/

--

-- >>> let tags = parseTags "
This is a paragraph
"

-- [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 p (TagText text) = p text

tagText _ _ = False

-- | Match comment tags

--

-- ==== __Examples__

--

-- /Matching comment tags that include an exclamation mark:/

--

-- >>> let tags = parseTags ""

-- [TagComment "This is a comment!"]

-- >>> all (tagComment (\s -> '!' `elem` s)) tags

-- True

tagComment :: (str -> Bool) -> Tag str -> Bool

tagComment p (TagComment text) = p text

tagComment _ _ = False

-- | Match an opening tag's name literally

--

-- ==== __Examples__

--

-- /Matching @\@ 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 name = tagOpen (name==)

-- | Match a closing tag's name literally

--

-- ==== __Examples__

--

-- /Match a closing @\@ tag:/

--

-- >>> tagCloseLit "a" (TagClose "a")

-- True

--

-- >>> tagCloseLit "a" (TagClose "em")

-- False

tagCloseLit :: Eq str => str -> Tag str -> Bool

tagCloseLit name = tagClose (name==)

-- | Match an opening tag's name literally, and at least one of its attributes

--

-- ==== __Examples__

--

-- /Matching a @\
@ tag with the @id@ "foo":/

--

-- >>> tagOpenAttrLit "div" ("id", "foo") (TagOpen "div" [("id", "foo")])

-- True

tagOpenAttrLit :: Eq str => str -> Attribute str -> Tag str -> Bool

tagOpenAttrLit name attr =

   tagOpenLit name (anyAttrLit 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 @\@ 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 tagName attrName pAttrValue =

   tagOpenLit tagName

      (anyAttr (\(name,value) -> name==attrName && pAttrValue value))

-- | Check if the 'Tag str' is 'TagOpen' and matches the given name

--

-- ==== __Examples__

--

-- /Matching an @\@ tag:/

--

-- >>> tagOpenNameLit "a" (TagOpen "a" [])

-- True

--

-- >>> tagOpenNameLit "a" (TagOpen "div" [])

-- False

tagOpenNameLit :: Eq str => str -> Tag str -> Bool

tagOpenNameLit name = tagOpenLit name (const 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 name = tagCloseLit name

-- * Matching attributes

-- | Does any attribute name/value match the predicate.

anyAttr :: ((str,str) -> Bool) -> [Attribute str] -> Bool

anyAttr = any

-- | Does any attribute name match the predicate.

anyAttrName :: (str -> Bool) -> [Attribute str] -> Bool

anyAttrName p = any (p . fst)

-- | Does any attribute value match the predicate.

anyAttrValue :: (str -> Bool) -> [Attribute str] -> Bool

anyAttrValue p = any (p . snd)

-- | Does any attribute name/value match.

anyAttrLit :: Eq str => (str,str) -> [Attribute str] -> Bool

anyAttrLit attr = anyAttr (attr==)

-- | Does any attribute name match.

anyAttrNameLit :: Eq str => str -> [Attribute str] -> Bool

anyAttrNameLit name = anyAttrName (name==)

-- | Does any attribute value match.

anyAttrValueLit :: Eq str => str -> [Attribute str] -> Bool

anyAttrValueLit value = anyAttrValue (value==)

-- | 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 name pAttrs =

   takeWhile (not . tagCloseLit name) . drop 1 .

   head . sections (tagOpenLit name pAttrs)

    where sections p = filter (p . head) . init . tails