From 38022972af85067203abd9b8855ad0f9e56a0399 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Tue, 18 Jun 2019 10:19:00 +1200
Subject: [PATCH] Implement dispatching parser of CSS properties.

---
 src/Stylish/Style/Selector.hs | 57 ++++++++++++++++++++++++++++-------
 1 file changed, 46 insertions(+), 11 deletions(-)

diff --git a/src/Stylish/Style/Selector.hs b/src/Stylish/Style/Selector.hs
index 5efa0e5..24cb5b5 100644
--- a/src/Stylish/Style/Selector.hs
+++ b/src/Stylish/Style/Selector.hs
@@ -1,6 +1,7 @@
 module Stylish.Style.Selector(
         QueryableStyleSheet(..), queryableStyleSheet,
-        queryRules
+        queryRules,
+        PropertyParser(..), cascade
     ) where
 
 import Stylish.Style.Selector.Index
@@ -9,7 +10,7 @@ import Stylish.Style.Selector.Specificity
 import Stylish.Style.Selector.Importance
 import Stylish.Style.Selector.Common
 
-import Stylish.Parse (StyleSheet(..))
+import Stylish.Parse (StyleSheet(..), StyleRule(..))
 
 -- TODO do performance tests to decide beside between strict/lazy,
 --      or is another Map implementation better?
@@ -17,24 +18,25 @@ import Data.HashMap.Strict
 import Data.Text.Internal (Text(..))
 import Data.CSS.Syntax.Tokens
 
-type QueryableStyleSheet = QueryableStyleSheet' (ImportanceSplitter (
-        OrderedRuleStore (InterpretedRuleStore StyleIndex)
-    ))
+type QueryableStyleSheet parser = QueryableStyleSheet' (ImportanceSplitter (
+        PropertyExpander parser (OrderedRuleStore (InterpretedRuleStore StyleIndex))
+    )) parser
 
-data QueryableStyleSheet' store = QueryableStyleSheet' {
+data QueryableStyleSheet' store parser = QueryableStyleSheet' {
     store :: store,
+    parser :: parser,
     priority :: Int -- author vs user agent vs user styles
 }
 
-queryableStyleSheet :: QueryableStyleSheet
-queryableStyleSheet = QueryableStyleSheet' {store = new, priority = 0}
+queryableStyleSheet :: PropertyParser p => QueryableStyleSheet p
+queryableStyleSheet = QueryableStyleSheet' {store = new, parser = temp, priority = 0}
 
-instance RuleStore s => StyleSheet (QueryableStyleSheet' s) where
-    addRule self@(QueryableStyleSheet' store priority) rule = self {
+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
+queryRules (QueryableStyleSheet' store _ _) el = lookupRules store el
 
 --------
 ---- Cascade
@@ -43,3 +45,36 @@ queryRules (QueryableStyleSheet' store _) el = lookupRules store el
 cascadeRules rules = cascadeProperties $ concat $ Prelude.map properties rules
 
 cascadeProperties ((name, value):props) = insert name value $ cascadeProperties props
+
+--------
+---- 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 -> p -> p
+cascade self el parent = dispatch parent parent $ toList $ cascadeRules $ 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
+
+--- 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 _ [] = []
-- 
2.30.2