From e5b85906e0829a01e2df4bd5c41451c8e18917a4 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Mon, 15 Jul 2019 17:11:39 +1200
Subject: [PATCH] Add support for psuedoelements/classes.

---
 src/Data/CSS/Style/Selector/Index.hs       | 6 +++++-
 src/Data/CSS/Style/Selector/Interpret.hs   | 5 +++++
 src/Data/CSS/Style/Selector/Specificity.hs | 4 ++--
 src/Data/CSS/Syntax/Selector.hs            | 8 +++++++-
 stylish-haskell.cabal                      | 2 +-
 5 files changed, 20 insertions(+), 5 deletions(-)

diff --git a/src/Data/CSS/Style/Selector/Index.hs b/src/Data/CSS/Style/Selector/Index.hs
index b9c5cf1..49d08a5 100644
--- a/src/Data/CSS/Style/Selector/Index.hs
+++ b/src/Data/CSS/Style/Selector/Index.hs
@@ -11,6 +11,7 @@ import Data.CSS.Style.Common
 
 import Data.Hashable
 import Data.Text (unpack, pack)
+import Data.CSS.Syntax.Tokens (serialize) -- for easy hashing
 
 data StyleIndex = StyleIndex {
     indexed :: HashMap SimpleSelector [StyleRule'],
@@ -54,7 +55,7 @@ selectorKey (tok@(Tag _) : _) = Just tok
 selectorKey (tok@(Id _) : _) = Just tok
 selectorKey (tok@(Class _) : _) = Just tok
 selectorKey (Property prop _ : _) = Just $ Property prop Exists
---selectorKey (_ : tokens) = selectorKey tokens
+selectorKey (_ : tokens) = selectorKey tokens
 selectorKey [] = Nothing
 
 ----
@@ -80,6 +81,9 @@ instance Hashable SimpleSelector where
     hashWithSalt seed (Class class_) = seed `hashWithSalt` (2::Int) `hashWithSalt` unpack class_
     hashWithSalt seed (Property prop test) =
         seed `hashWithSalt` (3::Int) `hashWithSalt` unpack prop `hashWithSalt` test
+    hashWithSalt seed (Psuedoclass p args) =
+        seed `hashWithSalt` (4::Int) `hashWithSalt` p `hashWithSalt` serialize args
+    hashWithSalt seed (Psuedoelement p) = seed `hashWithSalt` (5::Int) `hashWithSalt` p
 
 instance Hashable PropertyTest where
     hashWithSalt seed Exists = seed `hashWithSalt` (0::Int)
diff --git a/src/Data/CSS/Style/Selector/Interpret.hs b/src/Data/CSS/Style/Selector/Interpret.hs
index a44524b..4b2f116 100644
--- a/src/Data/CSS/Style/Selector/Interpret.hs
+++ b/src/Data/CSS/Style/Selector/Interpret.hs
@@ -35,6 +35,11 @@ lowerInner (Id i:s) = (tag, ("id", hasWord $ unpack i):attrs) where (tag, attrs)
 lowerInner (Class c:s) = (tag, ("class", hasWord $ unpack c):attrs) where (tag, attrs) = lowerInner s
 lowerInner (Property prop test:s) = (tag, (prop, compileAttrTest test):attrs)
     where (tag, attrs) = lowerInner s
+-- psuedos, TODO handle argumented psuedoclasses.
+lowerInner (Psuedoclass c _:s) =
+        (tag, ("", hasWord $ unpack c):attrs) where (tag, attrs) = lowerInner s
+lowerInner (Psuedoelement t:s) =
+        (tag, ("", hasWord (':' : unpack t)):attrs) where (tag, attrs) = lowerInner s
 lowerInner [] = (Nothing, [])
 
 compileAttrTest :: PropertyTest -> String -> Bool
diff --git a/src/Data/CSS/Style/Selector/Specificity.hs b/src/Data/CSS/Style/Selector/Specificity.hs
index bc25f4b..25aeb18 100644
--- a/src/Data/CSS/Style/Selector/Specificity.hs
+++ b/src/Data/CSS/Style/Selector/Specificity.hs
@@ -16,7 +16,9 @@ computeSpecificity (Sibling upSel sel) = computeSpecificity upSel `add` computeS
 
 computeSpecificity' :: [SimpleSelector] -> Vec
 computeSpecificity' (Tag _:sel) = computeSpecificity' sel `add` (0, 0, 1)
+computeSpecificity' (Psuedoelement _:sel) = computeSpecificity' sel `add` (0, 0, 1)
 computeSpecificity' (Class _:sel) = computeSpecificity' sel `add` (0, 1, 0)
+computeSpecificity' (Psuedoclass _ _:sel) = computeSpecificity' sel `add` (0, 1, 0)
 computeSpecificity' (Property _ _:sel) = computeSpecificity' sel `add` (0, 1, 0)
 computeSpecificity' (Id _:sel) = computeSpecificity' sel `add` (1, 0, 0)
 computeSpecificity' [] = (0, 0, 0)
@@ -24,8 +26,6 @@ computeSpecificity' [] = (0, 0, 0)
 add :: Vec -> Vec -> Vec
 add (a, b, c) (x, y, z) = (a + x, b + y, c + z)
 
----
-
 data OrderedRuleStore inner = OrderedRuleStore inner Int
 
 instance RuleStore inner => RuleStore (OrderedRuleStore inner) where
diff --git a/src/Data/CSS/Syntax/Selector.hs b/src/Data/CSS/Syntax/Selector.hs
index aa8fc7c..e96490e 100644
--- a/src/Data/CSS/Syntax/Selector.hs
+++ b/src/Data/CSS/Syntax/Selector.hs
@@ -13,7 +13,8 @@ data Selector = Element [SimpleSelector] |
     Child Selector [SimpleSelector] | Descendant Selector [SimpleSelector] |
     Adjacent Selector [SimpleSelector] | Sibling Selector [SimpleSelector]
     deriving (Show, Eq)
-data SimpleSelector = Tag Text | Id Text | Class Text | Property Text PropertyTest
+data SimpleSelector = Tag Text | Id Text | Class Text | Property Text PropertyTest |
+    Psuedoclass Text [Token] | Psuedoelement Text
     deriving (Show, Eq)
 data PropertyTest = Exists | Equals Text | Suffix Text | Prefix Text | Substring Text |
     Include Text | Dash Text
@@ -40,6 +41,11 @@ parseSelector (Delim '.':Ident class_:tokens) = parseSelector' (Class class_) to
 parseSelector (LeftSquareBracket:Ident prop:tokens) =
         concatP appendPropertySel parsePropertySel parseSelector tokens
     where appendPropertySel test selector = Property prop test : selector
+parseSelector (Delim ':':Delim ':':Ident p:ts) = parseSelector' (Psuedoelement p) ts
+parseSelector (Delim ':':Ident p:ts) = parseSelector' (Psuedoclass p []) ts
+parseSelector (Delim ':':Function fn:tokens) =
+        concatP appendPseudo scanBlock parseSelector tokens
+    where appendPseudo args selector = Psuedoclass fn args : selector
 parseSelector tokens = ([], tokens)
 
 parseCombinators' :: Selector -> Parser Selector
diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal
index 2cb0e9c..886c953 100644
--- a/stylish-haskell.cabal
+++ b/stylish-haskell.cabal
@@ -10,7 +10,7 @@ name:                stylish-haskell
 -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:             0.4.0
+version:             0.5.0.0
 
 -- A short (one-line) description of the package.
 synopsis:            Apply CSS styles to a document tree.
-- 
2.30.2