~alcinnz/haskell-stylist

ref: 0b37dedff7149662870aba77fb424bf16aa1602d haskell-stylist/src/Data/CSS/Style/Selector/Specificity.hs -rw-r--r-- 2.2 KiB
0b37dedf — Adrian Cochrane Tweak priority to be a list for the sake of cascadeLayers. 2 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