From 3df8d43cf9f4555f3b4bc55703c14708eb036cdd Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Tue, 21 Apr 2020 19:06:57 +1200
Subject: [PATCH] Implement psuedoclass rewrite rules.

---
 src/Data/CSS/Preprocessor/PsuedoClasses.hs | 38 ++++++++++++++++++++++
 stylist.cabal                              |  2 +-
 2 files changed, 39 insertions(+), 1 deletion(-)
 create mode 100644 src/Data/CSS/Preprocessor/PsuedoClasses.hs

diff --git a/src/Data/CSS/Preprocessor/PsuedoClasses.hs b/src/Data/CSS/Preprocessor/PsuedoClasses.hs
new file mode 100644
index 0000000..13e0d9c
--- /dev/null
+++ b/src/Data/CSS/Preprocessor/PsuedoClasses.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE OverloadedStrings #-}
+-- | Lowers psuedoclasses to rawer syntactic forms.
+module Data.CSS.Preprocessor.PsuedoClasses(LowerPsuedoClasses(..)) where
+
+import Data.CSS.Syntax.StyleSheet
+import Data.CSS.Syntax.Selector
+import Data.CSS.Syntax.Tokens
+
+import Data.Text
+import Data.HashMap.Lazy as HM
+
+data LowerPsuedoClasses s = LowerPsuedoClasses {
+    inner :: s,
+    rewriteRules :: HashMap Text [Token]
+}
+
+instance StyleSheet s => StyleSheet (LowerPsuedoClasses s) where
+    setPriority p self = self { inner = setPriority p $ inner self }
+    addRule self rule = self { inner = addRule (inner self) $ lowerRule self rule }
+    addAtRule self name toks = let (inner', toks') = addAtRule (inner self) name toks
+        in (self { inner = inner' }, toks')
+
+lowerRule :: LowerPsuedoClasses t -> StyleRule -> StyleRule
+lowerRule LowerPsuedoClasses { rewriteRules = rewrites } (StyleRule sel props pseudoel) =
+    StyleRule (lowerSelector rewrites sel) props pseudoel
+
+lowerSelector :: HashMap Text [Token] -> Selector -> Selector
+lowerSelector rewrites (Element sel') = Element $ lowerSelector' rewrites sel'
+lowerSelector rewrites (Child p sel') = Child p $ lowerSelector' rewrites sel'
+lowerSelector rewrites (Descendant p sel') = Descendant p $ lowerSelector' rewrites sel'
+lowerSelector rewrites (Adjacent sib sel') = Adjacent sib $ lowerSelector' rewrites sel'
+lowerSelector rewrites (Sibling sib sel') = Sibling sib $ lowerSelector' rewrites sel'
+
+lowerSelector' :: HashMap Text [Token] -> [SimpleSelector] -> [SimpleSelector]
+lowerSelector' rewrites (Psuedoclass name []:sels)
+    | Just value <- name `HM.lookup` rewrites = Psuedoclass "where" value : lowerSelector' rewrites sels
+lowerSelector' rewrites (sel:sels) = sel : lowerSelector' rewrites sels
+lowerSelector' _ [] = []
diff --git a/stylist.cabal b/stylist.cabal
index d874603..1b759e0 100644
--- a/stylist.cabal
+++ b/stylist.cabal
@@ -56,7 +56,7 @@ library
   exposed-modules:     Data.CSS.Syntax.StyleSheet, Data.CSS.Syntax.Selector,
                        Data.CSS.Style, Data.CSS.StyleTree,
                        Data.CSS.Preprocessor.Conditions, Data.CSS.Preprocessor.Conditions.Expr,
-                       Data.CSS.Preprocessor.Assets, Data.CSS.Preprocessor.Text
+                       Data.CSS.Preprocessor.Assets, Data.CSS.Preprocessor.Text, Data.CSS.Preprocessor.PsuedoClasses
   
   -- Modules included in this library but not exported.
   other-modules:       Data.CSS.Syntax.StylishUtil,
-- 
2.30.2