~alcinnz/haskell-stylist

afa21a79a3bab0dc17348ca9a5971182426bc36e — Adrian Cochrane 11 months ago a3f78f0
Incorporate property prioritization into core & resolve conflicts.
2 files changed, 15 insertions(+), 7 deletions(-)

M src/Data/CSS/Style.hs
M src/Data/CSS/Style/Cascade.hs
M src/Data/CSS/Style.hs => src/Data/CSS/Style.hs +5 -5
@@ 43,7 43,7 @@ data QueryableStyleSheet' store parser = QueryableStyleSheet' {
    parser :: parser,
    -- | Whether author, useragent, or user styles are currently being parsed.
    -- The tail of this list indicates which Cascade Layer is active.
    priority :: [Int], -- author vs user agent vs user styles, incorporates Cascade Layers
    priorities :: [Int], -- author vs user agent vs user styles, incorporates Cascade Layers
    -- | Parse data for @layer, to give webdevs explicit control over the cascade.
    layers :: AtLayer.Tree,
    --- | The name of the @layer we're within.


@@ 54,17 54,17 @@ data QueryableStyleSheet' store parser = QueryableStyleSheet' {
queryableStyleSheet :: PropertyParser p => QueryableStyleSheet p
queryableStyleSheet = QueryableStyleSheet' {
    store = new, parser = temp, layers = AtLayer.emptyTree,
    priority = [0], layerNamespace = [] }
    priorities = [0], layerNamespace = [] }

instance (RuleStore s, PropertyParser p) => StyleSheet (QueryableStyleSheet' s p) where
    setPriorities vs self = self { priority = vs }
    setPriorities vs self = self { priorities = vs }
    addRule self@(QueryableStyleSheet' store' _ priority' _ _) rule = self {
            store = addStyleRule store' priority' $ styleRule' rule
        }
    addAtRule self@QueryableStyleSheet' { layerNamespace = ns, layers = layers_, priority = v:_ }
    addAtRule self@QueryableStyleSheet' { layerNamespace = ns, layers = layers_, priorities = v:_ }
            "layer" toks =
        case parseAtLayer ns toks layers_ $ \ns' path -> self {
            priority = v : path, layerNamespace = ns'
            priorities = v : path, layerNamespace = ns'
        } of
            (layers', Just self', toks') -> (self { store = store self', layers = layers' }, toks')
            (layers', Nothing, toks') -> (self { layers = layers' }, toks')

M src/Data/CSS/Style/Cascade.hs => src/Data/CSS/Style/Cascade.hs +10 -2
@@ 12,7 12,8 @@ import Stylist (PropertyParser(..), Props)

-- TODO do performance tests to decide beside between strict/lazy,
--      or is another Map implementation better?
import Data.HashMap.Strict
import Data.Hashable (Hashable)
import Data.HashMap.Strict as HM
import qualified Data.HashMap.Lazy as HML
import Data.Text (unpack, pack, isPrefixOf)



@@ 44,13 45,20 @@ cascade styles overrides base =
-- | Variant of `cascade` which allows configuring base styles seperate from parent.
cascadeWithParent :: PropertyParser p => [StyleRule'] -> Props -> p -> p -> p
cascadeWithParent styles overrides parent' base = constructWithParent parent' base $
    HML.toList $ cascadeRules (getVars base ++ overrides) styles
    toPrioList (priority base) $ cascadeRules (getVars base ++ overrides) styles

cascadeRules :: Props -> [StyleRule'] -> HashMap Text [Token]
cascadeRules overrides rules = cascadeProperties overrides $ concat $ Prelude.map properties rules
cascadeProperties :: Props -> Props -> HashMap Text [Token]
cascadeProperties overrides props = HML.fromList (props ++ overrides)

toPrioList :: Hashable k => [k] -> HashMap k v -> [(k, v)]
toPrioList (key:keys) map
    | Just val <- key `HM.lookup` map =
        (key, val):toPrioList keys (delete key map)
    | otherwise = toPrioList keys map
toPrioList [] map = toList map

constructWithParent :: PropertyParser p => p -> p -> Props -> p
constructWithParent parent' base props = dispatch parent' child props
    where child = setVars [item | item@(n, _) <- props, isPrefixOf "--" n] base