{-# LANGUAGE OverloadedStrings #-}
-- | Evaluates CSS selectors over an element.
-- INTERNAL MODULE.
module Data.CSS.Style.Selector.Interpret(
        compile, SelectorFunc,
        InterpretedRuleStore(..)
    ) where

import Data.CSS.Style.Common
import Stylist (compileAttrTest, matched, hasWord)

import Data.Text (unpack)
import Data.List
import Data.Maybe
import Data.Bits (xor)

-- For pseudoclasses
import Data.CSS.Syntax.Selector (parseSelectors)
import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))

-- | A compiled(?) CSS selector.
type SelectorFunc = Element -> Bool
type AttrsFunc = [Attribute] -> Bool
-- Mostly here for the sake of pseudoclasses.
data IL = Tagname Text | NS Text | Fail | Recursive Bool [Selector] | Nth Bool Integer Integer | Root

-- | Converts a parsed CSS selector into a callable function.
compile :: Selector -> SelectorFunc
compile :: Selector -> SelectorFunc
compile (Element [SimpleSelector]
sel) = [SimpleSelector] -> SelectorFunc
compileInner [SimpleSelector]
sel
compile (Child Selector
upSel [SimpleSelector]
sel) = (Element -> Maybe Element)
-> SelectorFunc -> SelectorFunc -> SelectorFunc
direct Element -> Maybe Element
parent (Selector -> SelectorFunc
compile Selector
upSel) (SelectorFunc -> SelectorFunc) -> SelectorFunc -> SelectorFunc
forall a b. (a -> b) -> a -> b
$ [SimpleSelector] -> SelectorFunc
compileInner [SimpleSelector]
sel
compile (Descendant Selector
up [SimpleSelector]
sel) = (Element -> Maybe Element)
-> SelectorFunc -> SelectorFunc -> SelectorFunc
indirect Element -> Maybe Element
parent (Selector -> SelectorFunc
compile Selector
up) (SelectorFunc -> SelectorFunc) -> SelectorFunc -> SelectorFunc
forall a b. (a -> b) -> a -> b
$ [SimpleSelector] -> SelectorFunc
compileInner [SimpleSelector]
sel
compile (Adjacent Selector
up [SimpleSelector]
sel) = (Element -> Maybe Element)
-> SelectorFunc -> SelectorFunc -> SelectorFunc
direct Element -> Maybe Element
previous (Selector -> SelectorFunc
compile Selector
up) (SelectorFunc -> SelectorFunc) -> SelectorFunc -> SelectorFunc
forall a b. (a -> b) -> a -> b
$ [SimpleSelector] -> SelectorFunc
compileInner [SimpleSelector]
sel
compile (Sibling Selector
up [SimpleSelector]
sel) = (Element -> Maybe Element)
-> SelectorFunc -> SelectorFunc -> SelectorFunc
indirect Element -> Maybe Element
previous (Selector -> SelectorFunc
compile Selector
up) (SelectorFunc -> SelectorFunc) -> SelectorFunc -> SelectorFunc
forall a b. (a -> b) -> a -> b
$ [SimpleSelector] -> SelectorFunc
compileInner [SimpleSelector]
sel

compileInner :: [SimpleSelector] -> SelectorFunc
compileInner :: [SimpleSelector] -> SelectorFunc
compileInner [SimpleSelector]
sel = ([IL], [(Text, Maybe Text, String -> Bool)]) -> SelectorFunc
compileInner' (([IL], [(Text, Maybe Text, String -> Bool)]) -> SelectorFunc)
-> ([IL], [(Text, Maybe Text, String -> Bool)]) -> SelectorFunc
forall a b. (a -> b) -> a -> b
$ [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
sel
compileInner' :: ([IL], [(Text, Maybe Text, String -> Bool)]) -> SelectorFunc
compileInner' :: ([IL], [(Text, Maybe Text, String -> Bool)]) -> SelectorFunc
compileInner' (Tagname Text
tag:[IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) = Text -> SelectorFunc -> SelectorFunc
testTag Text
tag (SelectorFunc -> SelectorFunc) -> SelectorFunc -> SelectorFunc
forall a b. (a -> b) -> a -> b
$ ([IL], [(Text, Maybe Text, String -> Bool)]) -> SelectorFunc
compileInner' ([IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs)
compileInner' (NS Text
ns:[IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) = Text -> SelectorFunc -> SelectorFunc
testNS Text
ns (SelectorFunc -> SelectorFunc) -> SelectorFunc -> SelectorFunc
forall a b. (a -> b) -> a -> b
$ ([IL], [(Text, Maybe Text, String -> Bool)]) -> SelectorFunc
compileInner' ([IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs)
compileInner' (IL
Fail:[IL]
_, [(Text, Maybe Text, String -> Bool)]
_) = \Element
_ -> Bool
False
compileInner' (Recursive Bool
negate' [Selector]
sels:[IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) =
    Bool -> [SelectorFunc] -> SelectorFunc -> SelectorFunc
recursiveSelect Bool
negate' ((Selector -> SelectorFunc) -> [Selector] -> [SelectorFunc]
forall a b. (a -> b) -> [a] -> [b]
map Selector -> SelectorFunc
compile [Selector]
sels) (SelectorFunc -> SelectorFunc) -> SelectorFunc -> SelectorFunc
forall a b. (a -> b) -> a -> b
$ ([IL], [(Text, Maybe Text, String -> Bool)]) -> SelectorFunc
compileInner' ([IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs)
compileInner' (Nth Bool
ofType Integer
n Integer
0:[IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) =
    Bool -> Int -> SelectorFunc -> SelectorFunc
nthChild Bool
ofType (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n) (SelectorFunc -> SelectorFunc) -> SelectorFunc -> SelectorFunc
forall a b. (a -> b) -> a -> b
$ ([IL], [(Text, Maybe Text, String -> Bool)]) -> SelectorFunc
compileInner' ([IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs)
compileInner' (Nth Bool
ofType Integer
a Integer
b:[IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) =
    Bool -> Int -> Int -> SelectorFunc -> SelectorFunc
nthChild' Bool
ofType (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
a) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
b) (SelectorFunc -> SelectorFunc) -> SelectorFunc -> SelectorFunc
forall a b. (a -> b) -> a -> b
$ ([IL], [(Text, Maybe Text, String -> Bool)]) -> SelectorFunc
compileInner' ([IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs)
compileInner' (IL
Root:[IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) = SelectorFunc -> SelectorFunc
testRoot (SelectorFunc -> SelectorFunc) -> SelectorFunc -> SelectorFunc
forall a b. (a -> b) -> a -> b
$ ([IL], [(Text, Maybe Text, String -> Bool)]) -> SelectorFunc
compileInner' ([IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs)
compileInner' ([], [(Text, Maybe Text, String -> Bool)]
attrs) = AttrsFunc -> SelectorFunc -> SelectorFunc
testAttrs ([(Text, Maybe Text, String -> Bool)] -> AttrsFunc
compileAttrs ([(Text, Maybe Text, String -> Bool)] -> AttrsFunc)
-> [(Text, Maybe Text, String -> Bool)] -> AttrsFunc
forall a b. (a -> b) -> a -> b
$ [(Text, Maybe Text, String -> Bool)]
-> [(Text, Maybe Text, String -> Bool)]
forall b. [(Text, Maybe Text, b)] -> [(Text, Maybe Text, b)]
sortAttrs [(Text, Maybe Text, String -> Bool)]
attrs) SelectorFunc
forall t. t -> Bool
matched
compileAttrs :: [(Text, Maybe Text, String -> Bool)] -> AttrsFunc
compileAttrs :: [(Text, Maybe Text, String -> Bool)] -> AttrsFunc
compileAttrs ((Text
tag, Maybe Text
Nothing, String -> Bool
test):[(Text, Maybe Text, String -> Bool)]
attrs) = Text -> (String -> Bool) -> AttrsFunc -> AttrsFunc
testAttr Text
tag String -> Bool
test (AttrsFunc -> AttrsFunc) -> AttrsFunc -> AttrsFunc
forall a b. (a -> b) -> a -> b
$ [(Text, Maybe Text, String -> Bool)] -> AttrsFunc
compileAttrs [(Text, Maybe Text, String -> Bool)]
attrs
compileAttrs ((Text
tag, Just Text
ns, String -> Bool
test):[(Text, Maybe Text, String -> Bool)]
attrs) = Text -> Text -> (String -> Bool) -> AttrsFunc -> AttrsFunc
testAttrNS Text
ns Text
tag String -> Bool
test (AttrsFunc -> AttrsFunc) -> AttrsFunc -> AttrsFunc
forall a b. (a -> b) -> a -> b
$ [(Text, Maybe Text, String -> Bool)] -> AttrsFunc
compileAttrs [(Text, Maybe Text, String -> Bool)]
attrs
compileAttrs [] = AttrsFunc
forall t. t -> Bool
matched

lowerInner :: [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner :: [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner (Namespace Text
ns:[SimpleSelector]
sel) = (Text -> IL
NS Text
nsIL -> [IL] -> [IL]
forall a. a -> [a] -> [a]
:[IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) where ([IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
sel
lowerInner (Tag Text
tag:[SimpleSelector]
sel) = (Text -> IL
Tagname Text
tagIL -> [IL] -> [IL]
forall a. a -> [a] -> [a]
:[IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) where ([IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
sel
lowerInner (Id Text
i:[SimpleSelector]
s) = ([IL]
tests, (Text
"id", Maybe Text
forall a. Maybe a
Nothing, String -> String -> Bool
hasWord (String -> String -> Bool) -> String -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
i)(Text, Maybe Text, String -> Bool)
-> [(Text, Maybe Text, String -> Bool)]
-> [(Text, Maybe Text, String -> Bool)]
forall a. a -> [a] -> [a]
:[(Text, Maybe Text, String -> Bool)]
attrs) where ([IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
s
lowerInner (Class Text
c:[SimpleSelector]
s) = ([IL]
tests, (Text
"class", Maybe Text
forall a. Maybe a
Nothing, String -> String -> Bool
hasWord (String -> String -> Bool) -> String -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
c)(Text, Maybe Text, String -> Bool)
-> [(Text, Maybe Text, String -> Bool)]
-> [(Text, Maybe Text, String -> Bool)]
forall a. a -> [a] -> [a]
:[(Text, Maybe Text, String -> Bool)]
attrs) where ([IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
s
lowerInner (Property Maybe Text
ns Text
prop PropertyTest
test:[SimpleSelector]
s) = ([IL]
tests, (Text
prop, Maybe Text
ns, PropertyTest -> String -> Bool
compileAttrTest PropertyTest
test)(Text, Maybe Text, String -> Bool)
-> [(Text, Maybe Text, String -> Bool)]
-> [(Text, Maybe Text, String -> Bool)]
forall a. a -> [a] -> [a]
:[(Text, Maybe Text, String -> Bool)]
attrs)
    where ([IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
s
-- psuedos, TODO handle argumented psuedoclasses.
lowerInner (Psuedoclass Text
c [Token]
args:[SimpleSelector]
s)
    | Text
c Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"is", Text
"where"], ([Selector]
sels, []) <- Parser [Selector]
parseSelectors [Token]
args =
        (Bool -> [Selector] -> IL
Recursive Bool
False [Selector]
selsIL -> [IL] -> [IL]
forall a. a -> [a] -> [a]
:[IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) where ([IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
s
lowerInner (Psuedoclass Text
"not" [Token]
args:[SimpleSelector]
s) | ([Selector]
sels, []) <- Parser [Selector]
parseSelectors [Token]
args =
    (Bool -> [Selector] -> IL
Recursive Bool
True [Selector]
selsIL -> [IL] -> [IL]
forall a. a -> [a] -> [a]
:[IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) where ([IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
s
lowerInner (Psuedoclass Text
"nth-child" [Token]
args:[SimpleSelector]
s) =
    (Bool -> [Token] -> IL
parseNth Bool
False ((Token -> Bool) -> [Token] -> [Token]
forall a. (a -> Bool) -> [a] -> [a]
filter (Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
Whitespace) [Token]
args)IL -> [IL] -> [IL]
forall a. a -> [a] -> [a]
:[IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) where ([IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
s
lowerInner (Psuedoclass Text
"nth-of-type" [Token]
args:[SimpleSelector]
s) =
    (Bool -> [Token] -> IL
parseNth Bool
True ((Token -> Bool) -> [Token] -> [Token]
forall a. (a -> Bool) -> [a] -> [a]
filter (Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
Whitespace) [Token]
args)IL -> [IL] -> [IL]
forall a. a -> [a] -> [a]
:[IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) where ([IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
s
lowerInner (Psuedoclass Text
"root" []:[SimpleSelector]
s) = (IL
RootIL -> [IL] -> [IL]
forall a. a -> [a] -> [a]
:[IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) where ([IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
s
lowerInner (Psuedoclass Text
c []:[SimpleSelector]
s) =
    ([IL]
tests, (Text
"", Maybe Text
forall a. Maybe a
Nothing, String -> String -> Bool
hasWord (String -> String -> Bool) -> String -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
c)(Text, Maybe Text, String -> Bool)
-> [(Text, Maybe Text, String -> Bool)]
-> [(Text, Maybe Text, String -> Bool)]
forall a. a -> [a] -> [a]
:[(Text, Maybe Text, String -> Bool)]
attrs) where ([IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
s
lowerInner (Psuedoclass Text
_ [Token]
_:[SimpleSelector]
_) = ([IL
Fail], [])
lowerInner [] = ([], [])

sortAttrs :: [(Text, Maybe Text, b)] -> [(Text, Maybe Text, b)]
sortAttrs :: forall b. [(Text, Maybe Text, b)] -> [(Text, Maybe Text, b)]
sortAttrs = ((Text, Maybe Text, b) -> (Text, Maybe Text, b) -> Ordering)
-> [(Text, Maybe Text, b)] -> [(Text, Maybe Text, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Text, Maybe Text, b) -> (Text, Maybe Text, b) -> Ordering
forall {a} {b} {c} {c}.
(Ord a, Ord b) =>
(a, b, c) -> (a, b, c) -> Ordering
compareAttrs where compareAttrs :: (a, b, c) -> (a, b, c) -> Ordering
compareAttrs (a
x, b
x', c
_) (a
y, b
y', c
_) = (a
x, b
x') (a, b) -> (a, b) -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (a
y, b
y')

--------
---- Runtime
--------
testTag :: Text -> SelectorFunc -> SelectorFunc
testTag :: Text -> SelectorFunc -> SelectorFunc
testTag Text
tag SelectorFunc
success Element
el | Element -> Text
name Element
el Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tag = SelectorFunc
success Element
el
    | Bool
otherwise = Bool
False
testNS :: Text -> SelectorFunc -> SelectorFunc
testNS :: Text -> SelectorFunc -> SelectorFunc
testNS Text
ns SelectorFunc
success Element
el | Element -> Text
namespace Element
el Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
ns = SelectorFunc
success Element
el
    | Bool
otherwise = Bool
False
testAttrs :: AttrsFunc -> SelectorFunc -> SelectorFunc
testAttrs :: AttrsFunc -> SelectorFunc -> SelectorFunc
testAttrs AttrsFunc
attrsTest SelectorFunc
success Element
el | AttrsFunc
attrsTest AttrsFunc -> AttrsFunc
forall a b. (a -> b) -> a -> b
$ Element -> [Attribute]
attributes Element
el = SelectorFunc
success Element
el
    | Bool
otherwise = Bool
False
direct :: (Element -> Maybe Element) -> SelectorFunc -> SelectorFunc -> SelectorFunc
direct :: (Element -> Maybe Element)
-> SelectorFunc -> SelectorFunc -> SelectorFunc
direct Element -> Maybe Element
traverser SelectorFunc
upTest SelectorFunc
test Element
el | Just Element
up <- Element -> Maybe Element
traverser Element
el = SelectorFunc
test Element
el Bool -> Bool -> Bool
&& SelectorFunc
upTest Element
up
    | Bool
otherwise = Bool
False
indirect :: (Element -> Maybe Element) -> SelectorFunc -> SelectorFunc -> SelectorFunc
indirect :: (Element -> Maybe Element)
-> SelectorFunc -> SelectorFunc -> SelectorFunc
indirect Element -> Maybe Element
traverser SelectorFunc
upTest SelectorFunc
test Element
el | Maybe Element
Nothing <- Element -> Maybe Element
traverser Element
el = Bool
False
    | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SelectorFunc
test Element
el = Bool
False
    | SelectorFunc
upTest (Maybe Element -> Element
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Element -> Element) -> Maybe Element -> Element
forall a b. (a -> b) -> a -> b
$ Element -> Maybe Element
traverser Element
el) = Bool
True
    | Bool
otherwise = (Element -> Maybe Element)
-> SelectorFunc -> SelectorFunc -> SelectorFunc
indirect Element -> Maybe Element
traverser SelectorFunc
upTest SelectorFunc
test SelectorFunc -> SelectorFunc
forall a b. (a -> b) -> a -> b
$ Maybe Element -> Element
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Element -> Element) -> Maybe Element -> Element
forall a b. (a -> b) -> a -> b
$ Element -> Maybe Element
traverser Element
el

testAttr :: Text -> (String -> Bool) -> AttrsFunc -> AttrsFunc
testAttr :: Text -> (String -> Bool) -> AttrsFunc -> AttrsFunc
testAttr Text
expected String -> Bool
test AttrsFunc
next attrs :: [Attribute]
attrs@(Attribute Text
attr Text
_ String
value : [Attribute]
attrs')
    | Text
attr Text -> Text -> Bool
forall a. Ord a => a -> a -> Bool
< Text
expected = Text -> (String -> Bool) -> AttrsFunc -> AttrsFunc
testAttr Text
expected String -> Bool
test AttrsFunc
next [Attribute]
attrs'
    | Text
attr Text -> Text -> Bool
forall a. Ord a => a -> a -> Bool
> Text
expected = Bool
False
    | Text
attr Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
expected Bool -> Bool -> Bool
&& String -> Bool
test String
value = AttrsFunc
next [Attribute]
attrs
    | Bool
otherwise = Bool
False
testAttr Text
_ String -> Bool
_ AttrsFunc
_ [] = Bool
False
testAttrNS :: Text -> Text -> (String -> Bool) -> AttrsFunc -> AttrsFunc
testAttrNS :: Text -> Text -> (String -> Bool) -> AttrsFunc -> AttrsFunc
testAttrNS Text
expectedNS Text
expected String -> Bool
test AttrsFunc
next attrs :: [Attribute]
attrs@(Attribute Text
attr Text
ns String
value : [Attribute]
attrs')
    | (Text
attr, Text
ns) (Text, Text) -> (Text, Text) -> Bool
forall a. Ord a => a -> a -> Bool
< (Text
expected, Text
expectedNS) = Text -> Text -> (String -> Bool) -> AttrsFunc -> AttrsFunc
testAttrNS Text
expectedNS Text
expected String -> Bool
test AttrsFunc
next [Attribute]
attrs'
    | (Text
attr, Text
ns) (Text, Text) -> (Text, Text) -> Bool
forall a. Ord a => a -> a -> Bool
> (Text
expected, Text
expectedNS) = Bool
False
    | (Text
attr, Text
ns) (Text, Text) -> (Text, Text) -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
expected, Text
expectedNS) Bool -> Bool -> Bool
&& String -> Bool
test String
value = AttrsFunc
next [Attribute]
attrs
    | Bool
otherwise = Bool
False
testAttrNS Text
_ Text
_ String -> Bool
_ AttrsFunc
_ [] = Bool
False

--- Pseudoclasses
recursiveSelect :: Bool -> [SelectorFunc] -> SelectorFunc -> SelectorFunc
recursiveSelect :: Bool -> [SelectorFunc] -> SelectorFunc -> SelectorFunc
recursiveSelect Bool
negate' [SelectorFunc]
sels SelectorFunc
success Element
el | Bool
negate' Bool -> Bool -> Bool
forall a. Bits a => a -> a -> a
`xor` (SelectorFunc -> Bool) -> [SelectorFunc] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (SelectorFunc -> SelectorFunc
forall a b. (a -> b) -> a -> b
$ Element
el) [SelectorFunc]
sels = SelectorFunc
success Element
el
    | Bool
otherwise = Bool
False

parseNth :: Bool -> [Token] -> IL
parseNth :: Bool -> [Token] -> IL
parseNth Bool
ofType [Ident Text
"odd"] = Bool -> Integer -> Integer -> IL
Nth Bool
ofType Integer
2 Integer
1
parseNth Bool
ofType [Ident Text
"even"] = Bool -> Integer -> Integer -> IL
Nth Bool
ofType Integer
2 Integer
0
parseNth Bool
x [Dimension Text
_ (NVInteger Integer
a) Text
"n", Number Text
_ (NVInteger Integer
b)] = Bool -> Integer -> Integer -> IL
Nth Bool
x Integer
a Integer
b
parseNth Bool
x [Number Text
_ (NVInteger Integer
b), Dimension Text
_ (NVInteger Integer
a) Text
"n"] = Bool -> Integer -> Integer -> IL
Nth Bool
x Integer
a Integer
b
parseNth Bool
x [Dimension Text
_ (NVInteger Integer
a) Text
"n", Delim Char
'+', Number Text
_ (NVInteger Integer
b)] = Bool -> Integer -> Integer -> IL
Nth Bool
x Integer
a Integer
b
parseNth Bool
x [Number Text
_ (NVInteger Integer
b), Delim Char
'+', Dimension Text
_ (NVInteger Integer
a) Text
"n"] = Bool -> Integer -> Integer -> IL
Nth Bool
x Integer
a Integer
b
parseNth Bool
x [Dimension Text
_ (NVInteger Integer
a) Text
"n", Delim Char
'-', Number Text
_ (NVInteger Integer
b)] = Bool -> Integer -> Integer -> IL
Nth Bool
x Integer
a (Integer -> IL) -> Integer -> IL
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
negate Integer
b
parseNth Bool
x [Number Text
_ (NVInteger Integer
b), Delim Char
'-', Dimension Text
_ (NVInteger Integer
a) Text
"n"] = Bool -> Integer -> Integer -> IL
Nth Bool
x Integer
a (Integer -> IL) -> Integer -> IL
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
negate Integer
b
parseNth Bool
_ [Token]
_ = IL
Fail

nthChild :: Bool -> Int -> (Element -> Bool) -> Element -> Bool
nthChild :: Bool -> Int -> SelectorFunc -> SelectorFunc
nthChild Bool
ofType Int
n SelectorFunc
success Element
el | Bool -> Element -> Int
countPrev Bool
ofType Element
el Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = SelectorFunc
success Element
el
    | Bool
otherwise = Bool
False
nthChild' :: Bool -> Int -> Int -> (Element -> Bool) -> Element -> Bool
nthChild' :: Bool -> Int -> Int -> SelectorFunc -> SelectorFunc
nthChild' Bool
ofType Int
a Int
b SelectorFunc
success Element
el | Bool -> Element -> Int
countPrev Bool
ofType Element
el Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b = SelectorFunc
success Element
el
    | Bool
otherwise = Bool
False
countPrev :: Bool -> Element -> Int
countPrev :: Bool -> Element -> Int
countPrev Bool
ofType Element
el =
    [Element] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Element
el' | Element
el' <- (Element -> Maybe Element) -> Element -> [Element]
forall t. (t -> Maybe t) -> t -> [t]
maybeStar Element -> Maybe Element
previous Element
el, Element -> Text
name Element
el Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Element -> Text
name Element
el' Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
ofType]
maybeStar :: (t -> Maybe t) -> t -> [t]
maybeStar :: forall t. (t -> Maybe t) -> t -> [t]
maybeStar t -> Maybe t
cb t
x | Just t
y <- t -> Maybe t
cb t
x = t
x t -> [t] -> [t]
forall a. a -> [a] -> [a]
: (t -> Maybe t) -> t -> [t]
forall t. (t -> Maybe t) -> t -> [t]
maybeStar t -> Maybe t
cb t
y
    | Bool
otherwise = [t
x]

testRoot :: (Element -> Bool) -> Element -> Bool
testRoot :: SelectorFunc -> SelectorFunc
testRoot SelectorFunc
cb Element
el | Just Element
_ <- Element -> Maybe Element
parent Element
el = SelectorFunc
cb Element
el
    | Bool
otherwise = Bool
False
--------
---- RuleStore wrapper
--------
-- | Compiles & fully evaluates CSS selectors.
data InterpretedRuleStore inner = InterpretedRuleStore inner
instance RuleStore inner => RuleStore (InterpretedRuleStore inner) where
    new :: InterpretedRuleStore inner
new = inner -> InterpretedRuleStore inner
forall inner. inner -> InterpretedRuleStore inner
InterpretedRuleStore inner
forall a. RuleStore a => a
new
    addStyleRule :: InterpretedRuleStore inner
-> [Int] -> StyleRule' -> InterpretedRuleStore inner
addStyleRule (InterpretedRuleStore inner
self) [Int]
priority StyleRule'
rule =
        inner -> InterpretedRuleStore inner
forall inner. inner -> InterpretedRuleStore inner
InterpretedRuleStore (inner -> InterpretedRuleStore inner)
-> inner -> InterpretedRuleStore inner
forall a b. (a -> b) -> a -> b
$ inner -> [Int] -> StyleRule' -> inner
forall a. RuleStore a => a -> [Int] -> StyleRule' -> a
addStyleRule inner
self [Int]
priority (StyleRule' -> inner) -> StyleRule' -> inner
forall a b. (a -> b) -> a -> b
$ StyleRule'
rule {
            compiledSelector :: SelectorFunc
compiledSelector = Selector -> SelectorFunc
compile (Selector -> SelectorFunc) -> Selector -> SelectorFunc
forall a b. (a -> b) -> a -> b
$ StyleRule' -> Selector
selector StyleRule'
rule
        }
    lookupRules :: InterpretedRuleStore inner -> Element -> [StyleRule']
lookupRules (InterpretedRuleStore inner
self) Element
el = (StyleRule' -> Bool) -> [StyleRule'] -> [StyleRule']
forall a. (a -> Bool) -> [a] -> [a]
filter StyleRule' -> Bool
call ([StyleRule'] -> [StyleRule']) -> [StyleRule'] -> [StyleRule']
forall a b. (a -> b) -> a -> b
$ inner -> Element -> [StyleRule']
forall a. RuleStore a => a -> Element -> [StyleRule']
lookupRules inner
self Element
el
        where call :: StyleRule' -> Bool
call (StyleRule' StyleRule
_ SelectorFunc
test ([Int], (Int, Int, Int), Int)
_) = SelectorFunc
test Element
el