From 5a53c0de7ff206619d4d81400f62dad79ae57fb5 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Fri, 8 May 2020 19:58:20 +1200
Subject: [PATCH] Move :root handling into interpretor.

---
 src/Data/CSS/Preprocessor/PsuedoClasses.hs | 3 +--
 src/Data/CSS/Style/Selector/Interpret.hs   | 8 +++++++-
 2 files changed, 8 insertions(+), 3 deletions(-)

diff --git a/src/Data/CSS/Preprocessor/PsuedoClasses.hs b/src/Data/CSS/Preprocessor/PsuedoClasses.hs
index a21a2fe..4ed2a9e 100644
--- a/src/Data/CSS/Preprocessor/PsuedoClasses.hs
+++ b/src/Data/CSS/Preprocessor/PsuedoClasses.hs
@@ -112,5 +112,4 @@ htmlPsuedoFilter s = psuedoClassesFilter s &
     addRewrite "readonly" "[readonly], [disabled]" &
     addRewrite "read-write" ":not([readonly]):not([disabled])" &
     addRewrite "required" "[required]" &
-    addRewrite "root" "html" &
-    addRewrite "scope" "html"
+    addRewrite "scope" ":root"
diff --git a/src/Data/CSS/Style/Selector/Interpret.hs b/src/Data/CSS/Style/Selector/Interpret.hs
index bb2505b..8f4e71d 100644
--- a/src/Data/CSS/Style/Selector/Interpret.hs
+++ b/src/Data/CSS/Style/Selector/Interpret.hs
@@ -21,7 +21,7 @@ import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
 type SelectorFunc = Element -> Bool
 type AttrsFunc = [Attribute] -> Bool
 -- Mostly here for the sake of pseudoclasses.
-data IL = Tagname Text | NS Text | Fail | Recursive Bool [Selector] | Nth Bool Integer Integer
+data IL = Tagname Text | NS Text | Fail | Recursive Bool [Selector] | Nth Bool Integer Integer | Root
 
 -- | Converts a parsed CSS selector into a callable function.
 compile :: Selector -> SelectorFunc
@@ -43,6 +43,7 @@ compileInner' ((Nth ofType n 0:tests), attrs) =
     nthChild ofType (fromInteger n) $ compileInner' (tests, attrs)
 compileInner' ((Nth ofType a b:tests), attrs) =
     nthChild' ofType (fromInteger a) (fromInteger b) $ compileInner' (tests, attrs)
+compileInner' (Root:tests, attrs) = testRoot $ compileInner' (tests, attrs)
 compileInner' ([], attrs) = testAttrs (compileAttrs $ sortAttrs attrs) matched
 compileAttrs :: [(Text, Maybe Text, String -> Bool)] -> AttrsFunc
 compileAttrs ((tag, Nothing, test):attrs) = testAttr tag test $ compileAttrs attrs
@@ -66,6 +67,7 @@ lowerInner (Psuedoclass "nth-child" args:s) =
     (parseNth False (filter (== Whitespace) args):tests, attrs) where (tests, attrs) = lowerInner s
 lowerInner (Psuedoclass "nth-of-type" args:s) =
     (parseNth True (filter (== Whitespace) args):tests, attrs) where (tests, attrs) = lowerInner s
+lowerInner (Psuedoclass "root" []:s) = (Root:tests, attrs) where (tests, attrs) = lowerInner s
 lowerInner (Psuedoclass c []:s) =
     (tests, ("", Nothing, hasWord $ unpack c):attrs) where (tests, attrs) = lowerInner s
 lowerInner (Psuedoclass _ _:_) = ([Fail], [])
@@ -154,6 +156,10 @@ countPrev ofType el =
 maybeStar :: (t -> Maybe t) -> t -> [t]
 maybeStar cb x | Just y <- cb x = x : maybeStar cb y
     | otherwise = [x]
+
+testRoot :: (Element -> Bool) -> Element -> Bool
+testRoot cb el | Just _ <- parent el = cb el
+    | otherwise = False
 --------
 ---- RuleStore wrapper
 --------
-- 
2.30.2