~alcinnz/haskell-stylist

ref: 1578769433c856e9f9f8dbcd7c24191b733a7f7d haskell-stylist/src/Data/CSS/Style/Selector/Specificity.hs -rw-r--r-- 2.3 KiB
15787694 — Adrian Cochrane Minor corrections to counter rendering. 1 year, 6 months 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
b63c1787 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
47
48
49
{-# 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 ++ [maxBound], -- Ensure unlayered rules take precedance.
                    computeSpecificity (psuedoElement rule) $ selector rule,
                    count)
            }
        ) (count + 1)
    lookupRules (OrderedRuleStore self _) el = sort $ lookupRules self el