~alcinnz/haskell-stylist

ref: 7083855bc0a5996936547ea4b4e5c65e0853aae9 haskell-stylist/src/Data/CSS/Style.hs -rw-r--r-- 3.5 KiB
7083855b — Adrian Cochrane Test override styles. 5 years ago
                                                                                
c1fca3d5 Adrian Cochrane
a35a8a23 Adrian Cochrane
c1fca3d5 Adrian Cochrane
3bd6ae52 Adrian Cochrane
c1fca3d5 Adrian Cochrane
af343c17 Adrian Cochrane
c1fca3d5 Adrian Cochrane
3bd6ae52 Adrian Cochrane
c1fca3d5 Adrian Cochrane
3bd6ae52 Adrian Cochrane
c1fca3d5 Adrian Cochrane
3bd6ae52 Adrian Cochrane
c1fca3d5 Adrian Cochrane
3bd6ae52 Adrian Cochrane
c1fca3d5 Adrian Cochrane
af343c17 Adrian Cochrane
c1fca3d5 Adrian Cochrane
3bd6ae52 Adrian Cochrane
c1fca3d5 Adrian Cochrane
3bd6ae52 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
module Data.CSS.Style(
        QueryableStyleSheet(..), QueryableStyleSheet'(..), queryableStyleSheet,
        queryRules,
        PropertyParser(..), cascade,
        TrivialPropertyParser(..),
        Element(..), Attribute(..)
    ) where

import Data.CSS.Style.Selector.Index
import Data.CSS.Style.Selector.Interpret
import Data.CSS.Style.Selector.Specificity
import Data.CSS.Style.Importance
import Data.CSS.Style.Common
import Data.CSS.Syntax.StyleSheet (StyleSheet(..))

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

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 overrides rules = cascadeProperties overrides $ concat $ Prelude.map properties rules

cascadeProperties overrides props = fromList (props ++ overrides)

--------
---- 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 -> [(Text, [Token])] -> p -> p
cascade self el overrides parent = dispatch parent parent $ toList $ cascadeRules overrides $ 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
dispatch _ child [] = child

--- 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 _ [] = []

--------
---- Testing utility
--------

data TrivialPropertyParser = TrivialPropertyParser (HashMap String [Token])
instance PropertyParser TrivialPropertyParser where
    temp = TrivialPropertyParser empty
    longhand _ (TrivialPropertyParser self) key value =
        Just $ TrivialPropertyParser $ insert (unpack key) value self