{-# LANGUAGE OverloadedStrings #-}
-- | Sorts `StyleRule'`s by specificity.
-- INTERNAL MODULE.
module Data.CSS.Style.Selector.Specificity(
        OrderedRuleStore(..)
    ) where

import Data.CSS.Syntax.Selector
import Data.CSS.Style.Common
import Data.List

type Vec = (Int, Int, Int)
computeSpecificity :: Text -> Selector -> Vec
computeSpecificity :: Text -> Selector -> Vec
computeSpecificity Text
"" (Element [SimpleSelector]
sel) = [SimpleSelector] -> Vec
computeSpecificity' [SimpleSelector]
sel
computeSpecificity Text
"" (Child Selector
upSel [SimpleSelector]
sel) = Text -> Selector -> Vec
computeSpecificity Text
"" Selector
upSel Vec -> Vec -> Vec
`add` [SimpleSelector] -> Vec
computeSpecificity' [SimpleSelector]
sel
computeSpecificity Text
"" (Descendant Selector
upSel [SimpleSelector]
sel) = Text -> Selector -> Vec
computeSpecificity Text
"" Selector
upSel Vec -> Vec -> Vec
`add` [SimpleSelector] -> Vec
computeSpecificity' [SimpleSelector]
sel
computeSpecificity Text
"" (Adjacent Selector
upSel [SimpleSelector]
sel) = Text -> Selector -> Vec
computeSpecificity Text
"" Selector
upSel Vec -> Vec -> Vec
`add` [SimpleSelector] -> Vec
computeSpecificity' [SimpleSelector]
sel
computeSpecificity Text
"" (Sibling Selector
upSel [SimpleSelector]
sel) = Text -> Selector -> Vec
computeSpecificity Text
"" Selector
upSel Vec -> Vec -> Vec
`add` [SimpleSelector] -> Vec
computeSpecificity' [SimpleSelector]
sel
computeSpecificity Text
_ Selector
sel = Text -> Selector -> Vec
computeSpecificity Text
"" Selector
sel Vec -> Vec -> Vec
`add` (Int
0, Int
0, Int
1)

computeSpecificity' :: [SimpleSelector] -> Vec
computeSpecificity' :: [SimpleSelector] -> Vec
computeSpecificity' (Namespace Text
_:[SimpleSelector]
sel) = [SimpleSelector] -> Vec
computeSpecificity' [SimpleSelector]
sel
computeSpecificity' (Tag Text
_:[SimpleSelector]
sel) = [SimpleSelector] -> Vec
computeSpecificity' [SimpleSelector]
sel Vec -> Vec -> Vec
`add` (Int
0, Int
0, Int
1)
computeSpecificity' (Class Text
_:[SimpleSelector]
sel) = [SimpleSelector] -> Vec
computeSpecificity' [SimpleSelector]
sel Vec -> Vec -> Vec
`add` (Int
0, Int
1, Int
0)
computeSpecificity' (Psuedoclass Text
c [Token]
args:[SimpleSelector]
sel)
    | Text
c Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"not", Text
"is"], ([Selector]
sels, []) <- Parser [Selector]
parseSelectors [Token]
args =
        [SimpleSelector] -> Vec
computeSpecificity' [SimpleSelector]
sel Vec -> Vec -> Vec
`add` [Vec] -> Vec
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Selector -> Vec) -> [Selector] -> [Vec]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Selector -> Vec
computeSpecificity Text
"") [Selector]
sels)
computeSpecificity' (Psuedoclass Text
_ [Token]
_:[SimpleSelector]
sel) = [SimpleSelector] -> Vec
computeSpecificity' [SimpleSelector]
sel Vec -> Vec -> Vec
`add` (Int
0, Int
1, Int
0)
computeSpecificity' (Property Maybe Text
_ Text
_ PropertyTest
_:[SimpleSelector]
sel) = [SimpleSelector] -> Vec
computeSpecificity' [SimpleSelector]
sel Vec -> Vec -> Vec
`add` (Int
0, Int
1, Int
0)
computeSpecificity' (Id Text
_:[SimpleSelector]
sel) = [SimpleSelector] -> Vec
computeSpecificity' [SimpleSelector]
sel Vec -> Vec -> Vec
`add` (Int
1, Int
0, Int
0)
computeSpecificity' [] = (Int
0, Int
0, Int
0)

add :: Vec -> Vec -> Vec
add :: Vec -> Vec -> Vec
add (Int
a, Int
b, Int
c) (Int
x, Int
y, Int
z) = (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x, Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y, Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
z)

-- | Sorts `StyleRule'`s by their selector specificity.
data OrderedRuleStore inner = OrderedRuleStore inner Int

instance RuleStore inner => RuleStore (OrderedRuleStore inner) where
    new :: OrderedRuleStore inner
new = inner -> Int -> OrderedRuleStore inner
forall inner. inner -> Int -> OrderedRuleStore inner
OrderedRuleStore inner
forall a. RuleStore a => a
new Int
0
    addStyleRule :: OrderedRuleStore inner
-> [Int] -> StyleRule' -> OrderedRuleStore inner
addStyleRule (OrderedRuleStore inner
self Int
count) [Int]
priority StyleRule'
rule = inner -> Int -> OrderedRuleStore inner
forall inner. inner -> Int -> OrderedRuleStore inner
OrderedRuleStore (
            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 {
                rank :: ([Int], Vec, Int)
rank = (
                    [Int]
priority [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
forall a. Bounded a => a
maxBound], -- Ensure unlayered rules take precedance.
                    Text -> Selector -> Vec
computeSpecificity (StyleRule' -> Text
psuedoElement StyleRule'
rule) (Selector -> Vec) -> Selector -> Vec
forall a b. (a -> b) -> a -> b
$ StyleRule' -> Selector
selector StyleRule'
rule,
                    Int
count)
            }
        ) (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    lookupRules :: OrderedRuleStore inner -> Element -> [StyleRule']
lookupRules (OrderedRuleStore inner
self Int
_) Element
el = [StyleRule'] -> [StyleRule']
forall a. Ord a => [a] -> [a]
sort ([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