~alcinnz/haskell-stylist

ref: 5c97dd0e1094c7f2e405f30a14133000be310cd5 haskell-stylist/src/Data/CSS/Style/Selector/Specificity.hs -rw-r--r-- 2.2 KiB
5c97dd0e — Adrian Cochrane Fix build failure against new enough versions of 'text'. 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