~alcinnz/haskell-stylist

ref: e5b85906e0829a01e2df4bd5c41451c8e18917a4 haskell-stylist/src/Data/CSS/Style/Selector/Index.hs -rw-r--r-- 4.0 KiB
e5b85906 — Adrian Cochrane Add support for psuedoelements/classes. 5 years ago
                                                                                
c1fca3d5 Adrian Cochrane
e5b85906 Adrian Cochrane
c1fca3d5 Adrian Cochrane
ccae6742 Adrian Cochrane
c1fca3d5 Adrian Cochrane
ccae6742 Adrian Cochrane
c1fca3d5 Adrian Cochrane
e8c6873f Adrian Cochrane
c1fca3d5 Adrian Cochrane
ccae6742 Adrian Cochrane
e8c6873f Adrian Cochrane
e5b85906 Adrian Cochrane
e8c6873f Adrian Cochrane
c1fca3d5 Adrian Cochrane
ccae6742 Adrian Cochrane
c1fca3d5 Adrian Cochrane
ccae6742 Adrian Cochrane
c1fca3d5 Adrian Cochrane
ccae6742 Adrian Cochrane
c1fca3d5 Adrian Cochrane
e5b85906 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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
{-# LANGUAGE OverloadedStrings #-}
module Data.CSS.Style.Selector.Index (
        StyleIndex(..),
        rulesForElement
    ) where

-- TODO do performance tests to decide beside between strict/lazy.
import Data.HashMap.Strict
import Data.List (nub)
import Data.CSS.Style.Common

import Data.Hashable
import Data.Text (unpack, pack)
import Data.CSS.Syntax.Tokens (serialize) -- for easy hashing

data StyleIndex = StyleIndex {
    indexed :: HashMap SimpleSelector [StyleRule'],
    unindexed :: [StyleRule']
}

lookup' :: SimpleSelector -> HashMap SimpleSelector [a] -> [a]
lookup' = lookupDefault []

instance RuleStore StyleIndex where
    new = StyleIndex {indexed = empty, unindexed = []}
    addStyleRule self _ rule | [] == properties rule = self
        | otherwise = addRuleForSelector self rule $ simpleSelector $ selector rule
    lookupRules self element = nub $ Prelude.foldr (++) [] rules
        where
            get key = lookup' key index
            index = indexed self
            rules = unindexed self : Prelude.map get (testsForElement element)

rulesForElement :: StyleIndex -> Element -> [StyleRule] -- For testing
rulesForElement self element = Prelude.map inner $ lookupRules self element

---

simpleSelector :: Selector -> [SimpleSelector]
simpleSelector (Element s) = s
simpleSelector (Child _ s) = s
simpleSelector (Descendant _ s) = s
simpleSelector (Adjacent _ s) = s
simpleSelector (Sibling _ s) = s

addRuleForSelector :: StyleIndex -> StyleRule' -> [SimpleSelector] -> StyleIndex
addRuleForSelector self@(StyleIndex index _) rule sel
  | Just key <- selectorKey sel = self {
        indexed = insert key (rule : lookup' key index) index
    }
  | otherwise = self {unindexed = rule : unindexed self}

selectorKey :: [SimpleSelector] -> Maybe SimpleSelector
selectorKey (tok@(Tag _) : _) = Just tok
selectorKey (tok@(Id _) : _) = Just tok
selectorKey (tok@(Class _) : _) = Just tok
selectorKey (Property prop _ : _) = Just $ Property prop Exists
selectorKey (_ : tokens) = selectorKey tokens
selectorKey [] = Nothing

----

testsForAttributes :: [Attribute] -> [SimpleSelector]
testsForElement :: Element -> [SimpleSelector]
testsForElement element =
    (Tag $ name element) : (testsForAttributes $ attributes element)
testsForAttributes (Attribute "class" value:attrs) =
    (Prelude.map (\s -> Class $ pack s) $ words value) ++
        (Property "class" Exists : testsForAttributes attrs)
testsForAttributes (Attribute "id" value:attrs) =
    (Prelude.map (\s -> Id $ pack s) $ words value) ++
        (Property "id" Exists : testsForAttributes attrs)
testsForAttributes (Attribute elName _:attrs) =
    Property elName Exists : testsForAttributes attrs
testsForAttributes [] = []

-- Implement hashable for SimpleSelector here because it proved challenging to automatically derive it.
instance Hashable SimpleSelector where
    hashWithSalt seed (Tag tag) = seed `hashWithSalt` (0::Int) `hashWithSalt` unpack tag
    hashWithSalt seed (Id i) = seed `hashWithSalt` (1::Int) `hashWithSalt` unpack i
    hashWithSalt seed (Class class_) = seed `hashWithSalt` (2::Int) `hashWithSalt` unpack class_
    hashWithSalt seed (Property prop test) =
        seed `hashWithSalt` (3::Int) `hashWithSalt` unpack prop `hashWithSalt` test
    hashWithSalt seed (Psuedoclass p args) =
        seed `hashWithSalt` (4::Int) `hashWithSalt` p `hashWithSalt` serialize args
    hashWithSalt seed (Psuedoelement p) = seed `hashWithSalt` (5::Int) `hashWithSalt` p

instance Hashable PropertyTest where
    hashWithSalt seed Exists = seed `hashWithSalt` (0::Int)
    hashWithSalt seed (Equals val) = seed `hashWithSalt` (1::Int) `hashWithSalt` unpack val
    hashWithSalt seed (Suffix val) = seed `hashWithSalt` (2::Int) `hashWithSalt` unpack val
    hashWithSalt seed (Prefix val) = seed `hashWithSalt` (3::Int) `hashWithSalt` unpack val
    hashWithSalt seed (Substring val) = seed `hashWithSalt` (4::Int) `hashWithSalt` unpack val
    hashWithSalt seed (Include val) = seed `hashWithSalt` (5::Int) `hashWithSalt` unpack val
    hashWithSalt seed (Dash val) = seed `hashWithSalt` (6::Int) `hashWithSalt` unpack val