From 62083a71501b9a9051924abf451e8f810b890363 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Sat, 14 Nov 2020 14:12:00 +1300
Subject: [PATCH] Add hook for callers to run their own tests against
 attributes.

---
 src/Data/CSS/Style/Selector/Index.hs     |  1 +
 src/Data/CSS/Style/Selector/Interpret.hs |  3 ++-
 src/Data/CSS/Syntax/Selector.hs          | 10 +++++++++-
 3 files changed, 12 insertions(+), 2 deletions(-)

diff --git a/src/Data/CSS/Style/Selector/Index.hs b/src/Data/CSS/Style/Selector/Index.hs
index 6dd8adb..0a8cbde 100644
--- a/src/Data/CSS/Style/Selector/Index.hs
+++ b/src/Data/CSS/Style/Selector/Index.hs
@@ -97,3 +97,4 @@ instance Hashable PropertyTest where
     hashWithSalt seed (Substring val) = seed `hashWithSalt` (4::Int) `hashWithSalt` unpack val
     hashWithSalt seed (Include val) = seed `hashWithSalt` (5::Int) `hashWithSalt` unpack val
     hashWithSalt seed (Dash val) = seed `hashWithSalt` (6::Int) `hashWithSalt` unpack val
+    hashWithSalt seed (Callback _) = seed `hashWithSalt` (7::Int)
diff --git a/src/Data/CSS/Style/Selector/Interpret.hs b/src/Data/CSS/Style/Selector/Interpret.hs
index b165681..435dec3 100644
--- a/src/Data/CSS/Style/Selector/Interpret.hs
+++ b/src/Data/CSS/Style/Selector/Interpret.hs
@@ -14,7 +14,7 @@ import Data.Maybe
 import Data.Bits (xor)
 
 -- For pseudoclasses
-import Data.CSS.Syntax.Selector (parseSelectors)
+import Data.CSS.Syntax.Selector (parseSelectors, PropertyFunc(..))
 import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
 
 -- | A compiled(?) CSS selector.
@@ -81,6 +81,7 @@ compileAttrTest (Prefix val) = isPrefixOf $ unpack val
 compileAttrTest (Substring val) = isInfixOf $ unpack val
 compileAttrTest (Include val) = hasWord $ unpack val
 compileAttrTest (Dash val) = hasLang $ unpack val
+compileAttrTest (Callback (PropertyFunc cb)) = cb
 
 sortAttrs :: [(Text, Maybe Text, b)] -> [(Text, Maybe Text, b)]
 sortAttrs = sortBy compareAttrs where compareAttrs (x, x', _) (y, y', _) = (x, x') `compare` (y, y')
diff --git a/src/Data/CSS/Syntax/Selector.hs b/src/Data/CSS/Syntax/Selector.hs
index 502bf43..6b209ab 100644
--- a/src/Data/CSS/Syntax/Selector.hs
+++ b/src/Data/CSS/Syntax/Selector.hs
@@ -1,7 +1,7 @@
 -- | Parses CSS selectors
 -- See `parseSelectors`
 module Data.CSS.Syntax.Selector(
-        Selector(..), SimpleSelector(..), PropertyTest(..),
+        Selector(..), SimpleSelector(..), PropertyTest(..), PropertyFunc(..),
         parseSelectors
     ) where
 
@@ -33,7 +33,15 @@ data PropertyTest = Exists -- ^ Matches whether an attribute actually exists, e.
     | Substring Text -- ^ Matches whether the attribute contains the given value, e.g. "*="
     | Include Text -- ^ Is one of the whitespace-seperated values the one specified? e.g. "~="
     | Dash Text -- ^ Matches whitespace seperated values, or their "-"-seperated prefixes. e.g. "|="
+    | Callback PropertyFunc -- ^ Calls the given function to test this property.
     deriving (Show, Eq)
+-- | Caller-specified functions to extend property selection.
+-- Has incorrect Show/Eq implementations so this rare exception doesn't break things.
+data PropertyFunc = PropertyFunc (String -> Bool)
+instance Show PropertyFunc where
+    show _ = "xx"
+instance Eq PropertyFunc where
+    _ == _ = False
 
 -- | Parses a CSS selector.
 parseSelectors :: Parser [Selector]
-- 
2.30.2