From 7b6447629bdddb04c1f065c769ce345841d08ccc Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Wed, 22 Apr 2020 17:33:33 +1200
Subject: [PATCH] Prepare to interpret functional pseudoclasses.

---
 src/Data/CSS/Style/Selector/Interpret.hs | 28 ++++++++++++++----------
 1 file changed, 16 insertions(+), 12 deletions(-)

diff --git a/src/Data/CSS/Style/Selector/Interpret.hs b/src/Data/CSS/Style/Selector/Interpret.hs
index fd621de..3fb2b18 100644
--- a/src/Data/CSS/Style/Selector/Interpret.hs
+++ b/src/Data/CSS/Style/Selector/Interpret.hs
@@ -15,6 +15,8 @@ import Data.Maybe
 -- | A compiled(?) CSS selector.
 type SelectorFunc = Element -> Bool
 type AttrsFunc = [Attribute] -> Bool
+-- Mostly here for the sake of pseudoclasses.
+data IL = Tagname Text | Fail
 
 -- | Converts a parsed CSS selector into a callable function.
 compile :: Selector -> SelectorFunc
@@ -26,23 +28,25 @@ compile (Sibling up sel) = indirect previous (compile up) $ compileInner sel
 
 compileInner :: [SimpleSelector] -> SelectorFunc
 compileInner sel = compileInner' $ lowerInner sel
-compileInner' :: (Maybe Text, [(Text, String -> Bool)]) -> SelectorFunc
-compileInner' (Just tag, attrs) = testTag tag $ testAttrs (compileAttrs $ sortAttrs attrs) matched
-compileInner' (Nothing, attrs) = testAttrs (compileAttrs $ sortAttrs attrs) matched
+compileInner' :: ([IL], [(Text, String -> Bool)]) -> SelectorFunc
+compileInner' ((Tagname tag:tests), attrs) = testTag tag $ compileInner' (tests, attrs)
+compileInner' ((Fail:_), _) = \_ -> False
+compileInner' ([], attrs) = testAttrs (compileAttrs $ sortAttrs attrs) matched
 compileAttrs :: [(Text, String -> Bool)] -> AttrsFunc
 compileAttrs ((tag, test):attrs) = testAttr tag test $ compileAttrs attrs
 compileAttrs [] = matched
 
-lowerInner :: [SimpleSelector] -> (Maybe Text, [(Text, String -> Bool)])
-lowerInner (Tag tag:sel) = (Just tag, snd $ lowerInner sel)
-lowerInner (Id i:s) = (tag, ("id", hasWord $ unpack i):attrs) where (tag, attrs) = lowerInner s
-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
+lowerInner :: [SimpleSelector] -> ([IL], [(Text, String -> Bool)])
+lowerInner (Tag tag:sel) = (Tagname tag:tests, attrs) where (tests, attrs) = lowerInner sel
+lowerInner (Id i:s) = (tests, ("id", hasWord $ unpack i):attrs) where (tests, attrs) = lowerInner s
+lowerInner (Class c:s) = (tests, ("class", hasWord $ unpack c):attrs) where (tests, attrs) = lowerInner s
+lowerInner (Property prop test:s) = (tests, (prop, compileAttrTest test):attrs)
+    where (tests, attrs) = lowerInner s
 -- psuedos, TODO handle argumented psuedoclasses.
-lowerInner (Psuedoclass c _:s) =
-        (tag, ("", hasWord $ unpack c):attrs) where (tag, attrs) = lowerInner s
-lowerInner [] = (Nothing, [])
+lowerInner (Psuedoclass c []:s) =
+    (tests, ("", hasWord $ unpack c):attrs) where (tests, attrs) = lowerInner s
+lowerInner (Psuedoclass _ _:_) = ([Fail], [])
+lowerInner [] = ([], [])
 
 compileAttrTest :: PropertyTest -> String -> Bool
 compileAttrTest Exists = matched
-- 
2.30.2