From 6e0ed7114e8f5d5a209223cf9f2f27f9d2582b6d Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <alcinnz@lavabit.com>
Date: Tue, 9 Aug 2022 16:36:21 +1200
Subject: [PATCH] Integrate @layer support into core engine!

---
 src/Data/CSS/Style.hs          | 32 +++++++++++++++++++++++++-------
 src/Data/CSS/Syntax/AtLayer.hs |  6 +++++-
 2 files changed, 30 insertions(+), 8 deletions(-)

diff --git a/src/Data/CSS/Style.hs b/src/Data/CSS/Style.hs
index a703d40..0af565b 100644
--- a/src/Data/CSS/Style.hs
+++ b/src/Data/CSS/Style.hs
@@ -19,7 +19,9 @@ import qualified Data.CSS.Style.Cascade as Cascade
 import Data.CSS.Style.Cascade (PropertyParser(..), TrivialPropertyParser, Props)
 
 import Data.CSS.Syntax.Tokens (Token(..))
-import Data.CSS.Syntax.StyleSheet (StyleSheet(..))
+import Data.CSS.Syntax.StyleSheet (StyleSheet(..), skipAtRule)
+import Data.CSS.Syntax.AtLayer as AtLayer
+
 import Data.HashMap.Strict (HashMap, lookupDefault, fromList)
 import Data.Text (isPrefixOf)
 import Data.List (elemIndex)
@@ -38,25 +40,41 @@ data QueryableStyleSheet' store parser = QueryableStyleSheet' {
     -- | The "PropertyParser" to use for property syntax validation.
     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
+    -- The tail of this list indicates which Cascade Layer is active.
+    priority :: [Int], -- author vs user agent vs user styles, incorporates Cascade Layers
+    -- | Priority without Cascade Layers
+    priority' :: Int,
+    -- | Parse data for @layer, to give webdevs explicit control over the cascade.
+    layers :: AtLayer.Tree,
+    --- | The name of the @layer we're within.
+    layerNamespace :: [Text]
 }
 
 -- | Constructs an empty QueryableStyleSheet'.
 queryableStyleSheet :: PropertyParser p => QueryableStyleSheet p
-queryableStyleSheet = QueryableStyleSheet' {store = new, parser = temp, priority = [0]}
+queryableStyleSheet = QueryableStyleSheet' {
+    store = new, parser = temp, layers = AtLayer.emptyTree,
+    priority = [0], priority' = 0, layerNamespace = [] }
 
 instance (RuleStore s, PropertyParser p) => StyleSheet (QueryableStyleSheet' s p) where
-    setPriority v self = self {priority = [v]}
-    addRule self@(QueryableStyleSheet' store' _ priority') rule = self {
+    setPriority v self = self {priority = [v], priority' = v}
+    addRule self@(QueryableStyleSheet' store' _ priority' _ _ _) rule = self {
             store = addStyleRule store' priority' $ styleRule' rule
         }
+    addAtRule self@QueryableStyleSheet' { layerNamespace = ns, layers = layers_, priority' = v }
+            "layer" toks =
+        case parseAtLayer ns toks layers_ $ \ns' path -> self {
+            priority = v : path, layerNamespace = ns'
+        } of
+            (layers', Just self', toks') -> (self { store = store self', layers = layers' }, toks')
+            (layers', Nothing, toks') -> (self { layers = layers' }, toks')
+    addAtRule self _ toks = (self, skipAtRule toks)
 
 --- Reexpose cascade methods
 -- | Looks up style rules matching the specified element, grouped by psuedoelement.
 queryRules :: (PropertyParser p, RuleStore s) =>
     QueryableStyleSheet' s p -> Element -> HashMap Text [StyleRule']
-queryRules (QueryableStyleSheet' store' _ _) = Cascade.query store'
+queryRules (QueryableStyleSheet' store' _ _ _ _ _) = Cascade.query store'
 
 -- | Selects used property values from the given style rules,
 -- & populates into a new `PropertyParser` inheriting from the one given.
diff --git a/src/Data/CSS/Syntax/AtLayer.hs b/src/Data/CSS/Syntax/AtLayer.hs
index cd8aaed..b9645bb 100644
--- a/src/Data/CSS/Syntax/AtLayer.hs
+++ b/src/Data/CSS/Syntax/AtLayer.hs
@@ -1,4 +1,5 @@
-module Data.CSS.Syntax.AtLayer where
+module Data.CSS.Syntax.AtLayer(parseAtLayer, Tree(..),
+    registerLayer, layerPath, uniqueName, emptyTree) where
 
 import Data.HashMap.Lazy as M (HashMap, (!?), insert, size, empty)
 import Data.Text as T hiding (reverse, replicate, length)
@@ -68,3 +69,6 @@ uniqueName (namespace:namespaces) (Tree self)
     | Just (_, subtree) <- self !? namespace = namespace:uniqueName namespaces subtree
     | otherwise = replicate (length namespaces + 2) T.empty -- Should have registered first
 uniqueName [] (Tree self) = [T.pack $ show $ size self]
+
+emptyTree :: Tree
+emptyTree = Tree M.empty
-- 
2.30.2