From 2128054b93bb30b8959f4d32b8052d8c41834698 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Mon, 15 Jul 2019 13:18:34 +1200
Subject: [PATCH] Factorize out cascade logic.

---
 src/Data/CSS/Style.hs         | 44 ++++-------------------------------
 src/Data/CSS/Style/Cascade.hs | 40 +++++++++++++++++++++++++++++++
 2 files changed, 45 insertions(+), 39 deletions(-)
 create mode 100644 src/Data/CSS/Style/Cascade.hs

diff --git a/src/Data/CSS/Style.hs b/src/Data/CSS/Style.hs
index faab3e9..333a72b 100644
--- a/src/Data/CSS/Style.hs
+++ b/src/Data/CSS/Style.hs
@@ -11,13 +11,14 @@ 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(..))
+import qualified Data.CSS.Style.Cascade as Cascade
+import Data.CSS.Style.Cascade (PropertyParser(..), TrivialPropertyParser)
 
 -- 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)
+import Data.CSS.Syntax.Tokens (Token)
+import Data.CSS.Syntax.StyleSheet (StyleSheet(..))
 
 type QueryableStyleSheet parser = QueryableStyleSheet' (ImportanceSplitter (
         PropertyExpander parser (OrderedRuleStore (InterpretedRuleStore StyleIndex))
@@ -43,33 +44,8 @@ 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
-    inherit :: a -> a
-    inherit = id
-
-    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 (inherit 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
+cascade (QueryableStyleSheet' store _ _) = Cascade.cascade store
 
 --- Verify syntax during parsing, so invalid properties don't interfere with cascade.
 data PropertyExpander parser inner = PropertyExpander parser inner
@@ -84,13 +60,3 @@ expandRule parser rule = rule {inner = StyleRule selector $ expandProperties par
 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
diff --git a/src/Data/CSS/Style/Cascade.hs b/src/Data/CSS/Style/Cascade.hs
new file mode 100644
index 0000000..19e6b36
--- /dev/null
+++ b/src/Data/CSS/Style/Cascade.hs
@@ -0,0 +1,40 @@
+module Data.CSS.Style.Cascade(
+        cascade, TrivialPropertyParser(..), PropertyParser(..)
+    ) where
+
+import Data.CSS.Style.Common
+import Data.CSS.Syntax.Tokens
+
+-- TODO do performance tests to decide beside between strict/lazy,
+--      or is another Map implementation better?
+import Data.HashMap.Strict
+import Data.Text (unpack)
+
+cascadeRules overrides rules = cascadeProperties overrides $ concat $ Prelude.map properties rules
+cascadeProperties overrides props = fromList (props ++ overrides)
+
+class PropertyParser a where
+    temp :: a
+    inherit :: a -> a
+    inherit = id
+
+    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
+
+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
+
+cascade :: (PropertyParser p, RuleStore s) => s -> Element -> [(Text, [Token])] -> p -> p
+cascade self el overrides parent = dispatch parent (inherit parent) $
+    toList $ cascadeRules overrides $ lookupRules 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
-- 
2.30.2