module Text.HTML.TagSoup.HT.Match where

import qualified Text.HTML.TagSoup.HT.Tag as Tag


ignore :: a -> Bool
ignore _ = True


-- | match an opening tag
open :: (String -> Bool) -> ([Tag.Attribute char] -> Bool) -> Tag.T char -> Bool
open pName pAttrs (Tag.Open name attrs) =
   pName name && pAttrs attrs
open _ _ _ = False

-- | match an closing tag
close :: (String -> Bool) -> Tag.T char -> Bool
close pName (Tag.Close name) = pName name
close _ _ = False

-- | match a text
text :: ([char] -> Bool) -> Tag.T char -> Bool
text p (Tag.Text str) = p str
text _ _ = False

comment :: (String -> Bool) -> Tag.T char -> Bool
comment p (Tag.Comment str) = p str
comment _ _ = False

special :: (String -> Bool) -> (String -> Bool) -> Tag.T char -> Bool
special pType pInfo (Tag.Special typ info) = pType typ && pInfo info
special _ _ _ = False


-- | match a opening tag's name literally
openLit :: String -> ([Tag.Attribute char] -> Bool) -> Tag.T char -> Bool
openLit name = open (name==)

-- | match a closing tag's name literally
closeLit :: String -> Tag.T char -> Bool
closeLit name = close (name==)

openAttrLit :: (Eq char) =>
   String -> Tag.Attribute char -> Tag.T char -> Bool
openAttrLit name attr =
   openLit 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.
-}
openAttrNameLit :: String -> String -> ([char] -> Bool) -> Tag.T char -> Bool
openAttrNameLit tagName attrName pAttrValue =
   openLit tagName
      (anyAttr (\(name,value) -> name==attrName && pAttrValue value))


-- | Check if the 'Tag.T' is 'Tag.Open' and matches the given name
openNameLit :: String -> Tag.T char -> Bool
openNameLit name = openLit name ignore

-- | Check if the 'Tag.T' is 'Tag.Close' and matches the given name
closeNameLit :: String -> Tag.T char -> Bool
closeNameLit name = closeLit name




anyAttr :: ((String,[char]) -> Bool) -> [Tag.Attribute char] -> Bool
anyAttr = any

anyAttrName :: (String -> Bool) -> [Tag.Attribute char] -> Bool
anyAttrName p = any (p . fst)

anyAttrValue :: ([char] -> Bool) -> [Tag.Attribute char] -> Bool
anyAttrValue p = any (p . snd)


anyAttrLit :: (Eq char) => (String,[char]) -> [Tag.Attribute char] -> Bool
anyAttrLit attr = anyAttr (attr==)

anyAttrNameLit :: String -> [Tag.Attribute char] -> Bool
anyAttrNameLit name = anyAttrName (name==)

anyAttrValueLit :: (Eq char) => [char] -> [Tag.Attribute char] -> Bool
anyAttrValueLit value = anyAttrValue (value==)


{-
getTagContent :: String -> ([Tag.Attribute char] -> Bool) -> [Tag.T char] -> [Tag.T char]
getTagContent name pAttrs =
   takeWhile (not . tagCloseLit name) . drop 1 .
   head . sections (tagOpenLit name pAttrs)
-}