{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiWayIf #-}
{-# OPTIONS_HADDOCK hide #-}
module Text.HTML.Scalpel.Internal.Select.Combinators (
    (//)
,   (@:)
,   (@=)
,   (@=~)
,   atDepth
,   hasClass
,   match
,   notP
) where

import Text.HTML.Scalpel.Internal.Select.Types

import qualified Data.Text as T
import qualified Text.Regex.Base.RegexLike as RE
import qualified Text.StringLike as TagSoup


-- | The '@:' operator creates a 'Selector' by combining a 'TagName' with a list
-- of 'AttributePredicate's.
(@:) :: TagName -> [AttributePredicate] -> Selector
@: :: TagName -> [AttributePredicate] -> Selector
(@:) TagName
tag [AttributePredicate]
attrs = [(SelectNode, SelectSettings)] -> Selector
MkSelector [(TagName -> [AttributePredicate] -> SelectNode
toSelectNode TagName
tag [AttributePredicate]
attrs, SelectSettings
defaultSelectSettings)]
infixl 9 @:

-- | The '@=' operator creates an 'AttributePredicate' that will match
-- attributes with the given name and value.
--
-- If you are attempting to match a specific class of a tag with potentially
-- multiple classes, you should use the 'hasClass' utility function.
(@=) :: AttributeName -> String -> AttributePredicate
@= :: AttributeName -> String -> AttributePredicate
(@=) AttributeName
key String
value = (forall str. StringLike str => (str, str) -> Bool)
-> AttributePredicate
anyAttrPredicate forall a b. (a -> b) -> a -> b
$ \(str
attrKey, str
attrValue) ->
                                      forall str. StringLike str => AttributeName -> str -> Bool
matchKey AttributeName
key str
attrKey
                                      Bool -> Bool -> Bool
&& forall a. IsString a => String -> a
TagSoup.fromString String
value forall a. Eq a => a -> a -> Bool
== str
attrValue
infixl 6 @=

-- | The '@=~' operator creates an 'AttributePredicate' that will match
-- attributes with the given name and whose value matches the given regular
-- expression.
(@=~) :: RE.RegexLike re String
      => AttributeName -> re -> AttributePredicate
@=~ :: forall re.
RegexLike re String =>
AttributeName -> re -> AttributePredicate
(@=~) AttributeName
key re
re = (forall str. StringLike str => (str, str) -> Bool)
-> AttributePredicate
anyAttrPredicate forall a b. (a -> b) -> a -> b
$ \(str
attrKey, str
attrValue) ->
       forall str. StringLike str => AttributeName -> str -> Bool
matchKey AttributeName
key str
attrKey
    Bool -> Bool -> Bool
&& forall regex source.
RegexLike regex source =>
regex -> source -> Bool
RE.matchTest re
re (forall a. StringLike a => a -> String
TagSoup.toString str
attrValue)
infixl 6 @=~

-- | The 'atDepth' operator constrains a 'Selector' to only match when it is at
-- @depth@ below the previous selector.
--
-- For example, @"div" // "a" `atDepth` 1@ creates a 'Selector' that matches
-- anchor tags that are direct children of a div tag.
atDepth :: Selector -> Int -> Selector
atDepth :: Selector -> Int -> Selector
atDepth (MkSelector [(SelectNode, SelectSettings)]
xs) Int
depth = [(SelectNode, SelectSettings)] -> Selector
MkSelector (forall {a}. [(a, SelectSettings)] -> [(a, SelectSettings)]
addDepth [(SelectNode, SelectSettings)]
xs)
  where addDepth :: [(a, SelectSettings)] -> [(a, SelectSettings)]
addDepth []                 = []
        addDepth [(a
node, SelectSettings
settings)] = [
            (a
node, SelectSettings
settings { selectSettingsDepth :: Maybe Int
selectSettingsDepth = forall a. a -> Maybe a
Just Int
depth })
          ]
        addDepth ((a, SelectSettings)
x : [(a, SelectSettings)]
xs)           = (a, SelectSettings)
x forall a. a -> [a] -> [a]
: [(a, SelectSettings)] -> [(a, SelectSettings)]
addDepth [(a, SelectSettings)]
xs
infixl 6 `atDepth`

-- | The '//' operator creates an 'Selector' by nesting one 'Selector' in
-- another. For example, @"div" // "a"@ will create a 'Selector' that matches
-- anchor tags that are nested arbitrarily deep within a div tag.
(//) :: Selector -> Selector -> Selector
// :: Selector -> Selector -> Selector
(//) Selector
a Selector
b = [(SelectNode, SelectSettings)] -> Selector
MkSelector ([(SelectNode, SelectSettings)]
as forall a. [a] -> [a] -> [a]
++ [(SelectNode, SelectSettings)]
bs)
    where (MkSelector [(SelectNode, SelectSettings)]
as) = Selector
a
          (MkSelector [(SelectNode, SelectSettings)]
bs) = Selector
b
infixl 5 //

-- | The classes of a tag are defined in HTML as a space separated list given by
-- the @class@ attribute. The 'hasClass' function will match a @class@ attribute
-- if the given class appears anywhere in the space separated list of classes.
hasClass :: String -> AttributePredicate
hasClass :: String -> AttributePredicate
hasClass String
clazz = (forall str. StringLike str => (str, str) -> Bool)
-> AttributePredicate
anyAttrPredicate forall {a} {b}. (StringLike a, StringLike b) => (a, b) -> Bool
hasClass'
    where
        hasClass' :: (a, b) -> Bool
hasClass' (a
attrName, b
classes)
            | String
"class" forall a. Eq a => a -> a -> Bool
== forall a. StringLike a => a -> String
TagSoup.toString a
attrName = Text
textClass forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classList
            | Bool
otherwise                            = Bool
False
            where textClass :: Text
textClass   = forall a b. (StringLike a, StringLike b) => a -> b
TagSoup.castString String
clazz
                  textClasses :: Text
textClasses = forall a b. (StringLike a, StringLike b) => a -> b
TagSoup.castString b
classes
                  classList :: [Text]
classList   = (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
' ') Text
textClasses

-- | Negates an 'AttributePredicate'.
notP :: AttributePredicate -> AttributePredicate
notP :: AttributePredicate -> AttributePredicate
notP (MkAttributePredicate forall str. StringLike str => [Attribute str] -> Bool
p) = (forall str. StringLike str => [Attribute str] -> Bool)
-> AttributePredicate
MkAttributePredicate forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall str. StringLike str => [Attribute str] -> Bool
p

-- | The 'match' function allows for the creation of arbitrary
-- 'AttributePredicate's. The argument is a function that takes the attribute
-- key followed by the attribute value and returns a boolean indicating if the
-- attribute satisfies the predicate.
match :: (String -> String -> Bool) -> AttributePredicate
match :: (String -> String -> Bool) -> AttributePredicate
match String -> String -> Bool
f = (forall str. StringLike str => (str, str) -> Bool)
-> AttributePredicate
anyAttrPredicate forall a b. (a -> b) -> a -> b
$ \(str
attrKey, str
attrValue) ->
              String -> String -> Bool
f (forall a. StringLike a => a -> String
TagSoup.toString str
attrKey) (forall a. StringLike a => a -> String
TagSoup.toString str
attrValue)