~alcinnz/haskell-stylist

ref: e3beef67bcef116271da14637b376e084fe02bfc haskell-stylist/src/Data/CSS/Style/Selector/Specificity.hs -rw-r--r-- 2.2 KiB
e3beef67 — Adrian Cochrane Add new style tree traversals. 4 years ago
                                                                                
6344dc8e Adrian Cochrane
186cbffa Adrian Cochrane
c1fca3d5 Adrian Cochrane
af343c17 Adrian Cochrane
c1fca3d5 Adrian Cochrane
00ed62a1 Adrian Cochrane
6344dc8e Adrian Cochrane
d5e77295 Adrian Cochrane
c1fca3d5 Adrian Cochrane
00ed62a1 Adrian Cochrane
5ff74dcf Adrian Cochrane
c1fca3d5 Adrian Cochrane
d5e77295 Adrian Cochrane
e5b85906 Adrian Cochrane
5ff74dcf Adrian Cochrane
c1fca3d5 Adrian Cochrane
00ed62a1 Adrian Cochrane
c1fca3d5 Adrian Cochrane
186cbffa Adrian Cochrane
c1fca3d5 Adrian Cochrane
6344dc8e Adrian Cochrane
c1fca3d5 Adrian Cochrane
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
{-# 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 "" (Element sel) = computeSpecificity' sel
computeSpecificity "" (Child upSel sel) = computeSpecificity "" upSel `add` computeSpecificity' sel
computeSpecificity "" (Descendant upSel sel) = computeSpecificity "" upSel `add` computeSpecificity' sel
computeSpecificity "" (Adjacent upSel sel) = computeSpecificity "" upSel `add` computeSpecificity' sel
computeSpecificity "" (Sibling upSel sel) = computeSpecificity "" upSel `add` computeSpecificity' sel
computeSpecificity _ sel = computeSpecificity "" sel `add` (0, 0, 1)

computeSpecificity' :: [SimpleSelector] -> Vec
computeSpecificity' (Namespace _:sel) = computeSpecificity' sel
computeSpecificity' (Tag _:sel) = computeSpecificity' sel `add` (0, 0, 1)
computeSpecificity' (Class _:sel) = computeSpecificity' sel `add` (0, 1, 0)
computeSpecificity' (Psuedoclass c args:sel)
    | c `elem` ["not", "is"], (sels, []) <- parseSelectors args =
        computeSpecificity' sel `add` maximum (map (computeSpecificity "") sels)
computeSpecificity' (Psuedoclass _ _:sel) = computeSpecificity' sel `add` (0, 1, 0)
computeSpecificity' (Property _ _ _:sel) = computeSpecificity' sel `add` (0, 1, 0)
computeSpecificity' (Id _:sel) = computeSpecificity' sel `add` (1, 0, 0)
computeSpecificity' [] = (0, 0, 0)

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

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

instance RuleStore inner => RuleStore (OrderedRuleStore inner) where
    new = OrderedRuleStore new 0
    addStyleRule (OrderedRuleStore self count) priority rule = OrderedRuleStore (
            addStyleRule self priority $ rule {
                rank = (priority, computeSpecificity (psuedoElement rule) $ selector rule, count)
            }
        ) (count + 1)
    lookupRules (OrderedRuleStore self _) el = sort $ lookupRules self el