~alcinnz/haskell-stylist

ref: 3cd5b4addd694b2b62d579df5e6e01afec92f3ec haskell-stylist/src/Stylish/Style/Selector.hs -rw-r--r-- 3.1 KiB
3cd5b4ad — Adrian Cochrane [Project] Stylish Haskell 5 years ago
                                                                                
7d540c43 Adrian Cochrane
2881aec4 Adrian Cochrane
38022972 Adrian Cochrane
7d540c43 Adrian Cochrane
d47030fd Adrian Cochrane
7d540c43 Adrian Cochrane
38022972 Adrian Cochrane
2881aec4 Adrian Cochrane
ee89bcfd Adrian Cochrane
768a480d Adrian Cochrane
ee89bcfd Adrian Cochrane
768a480d Adrian Cochrane
38022972 Adrian Cochrane
7d540c43 Adrian Cochrane
38022972 Adrian Cochrane
d47030fd Adrian Cochrane
38022972 Adrian Cochrane
7d540c43 Adrian Cochrane
38022972 Adrian Cochrane
2881aec4 Adrian Cochrane
38022972 Adrian Cochrane
2881aec4 Adrian Cochrane
38022972 Adrian Cochrane
768a480d Adrian Cochrane
38022972 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
module Stylish.Style.Selector(
        QueryableStyleSheet(..), queryableStyleSheet,
        queryRules,
        PropertyParser(..), cascade
    ) where

import Stylish.Style.Selector.Index
import Stylish.Style.Selector.Interpret
import Stylish.Style.Selector.Specificity
import Stylish.Style.Selector.Importance
import Stylish.Style.Selector.Common

import Stylish.Parse (StyleSheet(..), StyleRule(..))

-- TODO do performance tests to decide beside between strict/lazy,
--      or is another Map implementation better?
import Data.HashMap.Strict
import Data.Text.Internal (Text(..))
import Data.CSS.Syntax.Tokens

type QueryableStyleSheet parser = QueryableStyleSheet' (ImportanceSplitter (
        PropertyExpander parser (OrderedRuleStore (InterpretedRuleStore StyleIndex))
    )) parser

data QueryableStyleSheet' store parser = QueryableStyleSheet' {
    store :: store,
    parser :: parser,
    priority :: Int -- author vs user agent vs user styles
}

queryableStyleSheet :: PropertyParser p => QueryableStyleSheet p
queryableStyleSheet = QueryableStyleSheet' {store = new, parser = temp, priority = 0}

instance (RuleStore s, PropertyParser p) => StyleSheet (QueryableStyleSheet' s p) where
    addRule self@(QueryableStyleSheet' store _ priority) rule = self {
            store = addStyleRule store priority $ styleRule' rule
        }

queryRules (QueryableStyleSheet' store _ _) el = lookupRules store el

--------
---- Cascade
--------

cascadeRules rules = cascadeProperties $ concat $ Prelude.map properties rules

cascadeProperties ((name, value):props) = insert name value $ cascadeProperties props

--------
---- Dispatch to property definitions
--------

class PropertyParser a where
    temp :: a
    shorthand :: a -> Text -> [Token] -> [(Text, [Token])]
    shorthand self name value | Just _ <- longhand self self name value = [(name, value)]
        | otherwise = []
    -- longhand parent self name value
    longhand :: a -> a -> Text -> [Token] -> Maybe a

cascade :: PropertyParser p => QueryableStyleSheet p -> Element -> p -> p
cascade self el parent = dispatch parent parent $ toList $ cascadeRules $ queryRules self el

dispatch parent child (name, value):props
    | Just child' <- longhand parent child name value = dispatch parent child' props
    | otherwise = dispatch parent child props

--- Verify syntax during parsing, so invalid properties don't interfere with cascade.
data PropertyExpander parser inner = PropertyExpander parser inner
instance (PropertyParser parser, RuleStore inner) => RuleStore (PropertyExpander parser inner) where
    new = PropertyExpander temp new
    addStyleRule (PropertyExpander parser inner) priority rule =
        PropertyExpander parser $ addStyleRule inner priority $ expandRule parser rule
    lookupRules (PropertyExpander _ inner) el = lookupRules inner el

expandRule parser rule = rule {inner = StyleRule selector $ expandProperties parser properties}
    where (StyleRule selector properties) = inner rule
expandProperties parser ((name, value):props) =
        shorthand parser name value ++ expandProperties parser props
expandProperties _ [] = []