{-# 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 sel :: [SimpleSelector]
sel) = [SimpleSelector] -> SelectorFunc
compileInner [SimpleSelector]
sel
compile (Child upSel :: Selector
upSel sel :: [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 up :: Selector
up sel :: [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 up :: Selector
up sel :: [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 up :: Selector
up sel :: [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 sel :: [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 tag :: Text
tag:tests :: [IL]
tests, attrs :: [(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 ns :: Text
ns:tests :: [IL]
tests, attrs :: [(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' (Fail:_, _) = \_ -> Bool
False
compileInner' (Recursive negate' :: Bool
negate' sels :: [Selector]
sels:tests :: [IL]
tests, attrs :: [(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 ofType :: Bool
ofType n :: Integer
n 0:tests :: [IL]
tests, attrs :: [(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 ofType :: Bool
ofType a :: Integer
a b :: Integer
b:tests :: [IL]
tests, attrs :: [(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' (Root:tests :: [IL]
tests, attrs :: [(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' ([], attrs :: [(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 ((tag :: Text
tag, Nothing, test :: String -> Bool
test):attrs :: [(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 ((tag :: Text
tag, Just ns :: Text
ns, test :: String -> Bool
test):attrs :: [(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 ns :: Text
ns:sel :: [SimpleSelector]
sel) = (Text -> IL
NS Text
nsIL -> [IL] -> [IL]
forall a. a -> [a] -> [a]
:[IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) where (tests :: [IL]
tests, attrs :: [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
sel
lowerInner (Tag tag :: Text
tag:sel :: [SimpleSelector]
sel) = (Text -> IL
Tagname Text
tagIL -> [IL] -> [IL]
forall a. a -> [a] -> [a]
:[IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) where (tests :: [IL]
tests, attrs :: [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
sel
lowerInner (Id i :: Text
i:s :: [SimpleSelector]
s) = ([IL]
tests, ("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 (tests :: [IL]
tests, attrs :: [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
s
lowerInner (Class c :: Text
c:s :: [SimpleSelector]
s) = ([IL]
tests, ("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 (tests :: [IL]
tests, attrs :: [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
s
lowerInner (Property ns :: Maybe Text
ns prop :: Text
prop test :: PropertyTest
test:s :: [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 (tests :: [IL]
tests, attrs :: [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
s
-- psuedos, TODO handle argumented psuedoclasses.
lowerInner (Psuedoclass c :: Text
c args :: [Token]
args:s :: [SimpleSelector]
s)
    | Text
c Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["is", "where"], (sels :: [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 (tests :: [IL]
tests, attrs :: [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
s
lowerInner (Psuedoclass "not" args :: [Token]
args:s :: [SimpleSelector]
s) | (sels :: [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 (tests :: [IL]
tests, attrs :: [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
s
lowerInner (Psuedoclass "nth-child" args :: [Token]
args:s :: [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 (tests :: [IL]
tests, attrs :: [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
s
lowerInner (Psuedoclass "nth-of-type" args :: [Token]
args:s :: [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 (tests :: [IL]
tests, attrs :: [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
s
lowerInner (Psuedoclass "root" []:s :: [SimpleSelector]
s) = (IL
RootIL -> [IL] -> [IL]
forall a. a -> [a] -> [a]
:[IL]
tests, [(Text, Maybe Text, String -> Bool)]
attrs) where (tests :: [IL]
tests, attrs :: [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
s
lowerInner (Psuedoclass c :: Text
c []:s :: [SimpleSelector]
s) =
    ([IL]
tests, ("", 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 (tests :: [IL]
tests, attrs :: [(Text, Maybe Text, String -> Bool)]
attrs) = [SimpleSelector] -> ([IL], [(Text, Maybe Text, String -> Bool)])
lowerInner [SimpleSelector]
s
lowerInner (Psuedoclass _ _:_) = ([IL
Fail], [])
lowerInner [] = ([], [])

sortAttrs :: [(Text, Maybe Text, b)] -> [(Text, Maybe Text, b)]
sortAttrs :: [(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 (x :: a
x, x' :: b
x', _) (y :: a
y, y' :: b
y', _) = (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 tag :: Text
tag success :: SelectorFunc
success el :: 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 ns :: Text
ns success :: SelectorFunc
success el :: 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 attrsTest :: AttrsFunc
attrsTest success :: SelectorFunc
success el :: 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 traverser :: Element -> Maybe Element
traverser upTest :: SelectorFunc
upTest test :: SelectorFunc
test el :: Element
el | Just up :: 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 traverser :: Element -> Maybe Element
traverser upTest :: SelectorFunc
upTest test :: SelectorFunc
test el :: 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 expected :: Text
expected test :: String -> Bool
test next :: AttrsFunc
next attrs :: [Attribute]
attrs@(Attribute attr :: Text
attr _ value :: String
value : attrs' :: [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 _ _ _ [] = Bool
False
testAttrNS :: Text -> Text -> (String -> Bool) -> AttrsFunc -> AttrsFunc
testAttrNS :: Text -> Text -> (String -> Bool) -> AttrsFunc -> AttrsFunc
testAttrNS expectedNS :: Text
expectedNS expected :: Text
expected test :: String -> Bool
test next :: AttrsFunc
next attrs :: [Attribute]
attrs@(Attribute attr :: Text
attr ns :: Text
ns value :: String
value : attrs' :: [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 _ _ _ _ [] = Bool
False

--- Pseudoclasses
recursiveSelect :: Bool -> [SelectorFunc] -> SelectorFunc -> SelectorFunc
recursiveSelect :: Bool -> [SelectorFunc] -> SelectorFunc -> SelectorFunc
recursiveSelect negate' :: Bool
negate' sels :: [SelectorFunc]
sels success :: SelectorFunc
success el :: 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 ofType :: Bool
ofType [Ident "odd"] = Bool -> Integer -> Integer -> IL
Nth Bool
ofType 2 1
parseNth ofType :: Bool
ofType [Ident "even"] = Bool -> Integer -> Integer -> IL
Nth Bool
ofType 2 0
parseNth x :: Bool
x [Dimension _ (NVInteger a :: Integer
a) "n", Number _ (NVInteger b :: Integer
b)] = Bool -> Integer -> Integer -> IL
Nth Bool
x Integer
a Integer
b
parseNth x :: Bool
x [Number _ (NVInteger b :: Integer
b), Dimension _ (NVInteger a :: Integer
a) "n"] = Bool -> Integer -> Integer -> IL
Nth Bool
x Integer
a Integer
b
parseNth x :: Bool
x [Dimension _ (NVInteger a :: Integer
a) "n", Delim '+', Number _ (NVInteger b :: Integer
b)] = Bool -> Integer -> Integer -> IL
Nth Bool
x Integer
a Integer
b
parseNth x :: Bool
x [Number _ (NVInteger b :: Integer
b), Delim '+', Dimension _ (NVInteger a :: Integer
a) "n"] = Bool -> Integer -> Integer -> IL
Nth Bool
x Integer
a Integer
b
parseNth x :: Bool
x [Dimension _ (NVInteger a :: Integer
a) "n", Delim '-', Number _ (NVInteger b :: 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 x :: Bool
x [Number _ (NVInteger b :: Integer
b), Delim '-', Dimension _ (NVInteger a :: Integer
a) "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 _ _ = IL
Fail

nthChild :: Bool -> Int -> (Element -> Bool) -> Element -> Bool
nthChild :: Bool -> Int -> SelectorFunc -> SelectorFunc
nthChild ofType :: Bool
ofType n :: Int
n success :: SelectorFunc
success el :: 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' ofType :: Bool
ofType a :: Int
a b :: Int
b success :: SelectorFunc
success el :: 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 ofType :: Bool
ofType el :: 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 :: (t -> Maybe t) -> t -> [t]
maybeStar cb :: t -> Maybe t
cb x :: t
x | Just y :: 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 cb :: SelectorFunc
cb el :: Element
el | Just _ <- 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 self :: inner
self) priority :: [Int]
priority rule :: 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 self :: inner
self) el :: 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' _ test :: SelectorFunc
test _) = SelectorFunc
test Element
el