From afa21a79a3bab0dc17348ca9a5971182426bc36e Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Tue, 16 May 2023 11:38:38 +1200
Subject: [PATCH] Incorporate property prioritization into core & resolve
 conflicts.

---
 src/Data/CSS/Style.hs         | 10 +++++-----
 src/Data/CSS/Style/Cascade.hs | 12 ++++++++++--
 2 files changed, 15 insertions(+), 7 deletions(-)

diff --git a/src/Data/CSS/Style.hs b/src/Data/CSS/Style.hs
index 047d7e7..96d6160 100644
--- a/src/Data/CSS/Style.hs
+++ b/src/Data/CSS/Style.hs
@@ -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')
diff --git a/src/Data/CSS/Style/Cascade.hs b/src/Data/CSS/Style/Cascade.hs
index 3c64279..623a197 100644
--- a/src/Data/CSS/Style/Cascade.hs
+++ b/src/Data/CSS/Style/Cascade.hs
@@ -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
-- 
2.30.2