From 6c1222a321c5d8d0ebf4ba2c1c85475693e33564 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Wed, 22 Apr 2020 19:00:42 +1200
Subject: [PATCH] Implement :nth-child() & :nth-of-type().

I don't think I'll implement :nth-last-child() & :nth-last-of-type() until I'm shown their value,
Haskell Stylist doesn't yet have access to the data to support them.
---
 ISSUES/func-psudoclasses.md              |  4 +--
 src/Data/CSS/Style/Selector/Interpret.hs | 34 +++++++++++++++++++++++-
 2 files changed, 35 insertions(+), 3 deletions(-)

diff --git a/ISSUES/func-psudoclasses.md b/ISSUES/func-psudoclasses.md
index 9590c33..0831ccb 100644
--- a/ISSUES/func-psudoclasses.md
+++ b/ISSUES/func-psudoclasses.md
@@ -5,9 +5,9 @@ These would mostly need to be added to the interpretor.
 * [x]  :dir()
 * [x]  :is() -- TODO apply specificity
 * [x]  :lang()
-* [ ]  :nth-child()
+* [x]  :nth-child()
 * [ ]  :nth-last-child()
-* [ ]  :nth-of-type()
+* [x]  :nth-of-type()
 * [ ]  :nth-last-child()
 * [x]  :where()
 * etc
diff --git a/src/Data/CSS/Style/Selector/Interpret.hs b/src/Data/CSS/Style/Selector/Interpret.hs
index f57bbb2..e733542 100644
--- a/src/Data/CSS/Style/Selector/Interpret.hs
+++ b/src/Data/CSS/Style/Selector/Interpret.hs
@@ -15,12 +15,13 @@ import Data.Bits (xor)
 
 -- For pseudoclasses
 import Data.CSS.Syntax.Selector (parseSelectors)
+import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
 
 -- | A compiled(?) CSS selector.
 type SelectorFunc = Element -> Bool
 type AttrsFunc = [Attribute] -> Bool
 -- Mostly here for the sake of pseudoclasses.
-data IL = Tagname Text | Fail | Recursive Bool [Selector]
+data IL = Tagname Text | Fail | Recursive Bool [Selector] | Nth Bool Integer Integer
 
 -- | Converts a parsed CSS selector into a callable function.
 compile :: Selector -> SelectorFunc
@@ -37,6 +38,10 @@ compileInner' ((Tagname tag:tests), attrs) = testTag tag $ compileInner' (tests,
 compileInner' ((Fail:_), _) = \_ -> False
 compileInner' ((Recursive negate' sels:tests), attrs) =
     recursiveSelect negate' (map compile sels) $ compileInner' (tests, attrs)
+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' ([], attrs) = testAttrs (compileAttrs $ sortAttrs attrs) matched
 compileAttrs :: [(Text, String -> Bool)] -> AttrsFunc
 compileAttrs ((tag, test):attrs) = testAttr tag test $ compileAttrs attrs
@@ -54,6 +59,10 @@ lowerInner (Psuedoclass c args:s)
         (Recursive False sels:tests, attrs) where (tests, attrs) = lowerInner s
 lowerInner (Psuedoclass "not" args:s) | (sels, []) <- parseSelectors args =
     (Recursive True sels:tests, attrs) where (tests, attrs) = lowerInner s
+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 c []:s) =
     (tests, ("", hasWord $ unpack c):attrs) where (tests, attrs) = lowerInner s
 lowerInner (Psuedoclass _ _:_) = ([Fail], [])
@@ -109,6 +118,29 @@ recursiveSelect :: Bool -> [SelectorFunc] -> SelectorFunc -> SelectorFunc
 recursiveSelect negate' sels success el | negate' `xor` any ($ el) sels = success el
     | otherwise = False
 
+parseNth :: Bool -> [Token] -> IL
+parseNth ofType [Ident "odd"] = Nth ofType 2 1
+parseNth ofType [Ident "even"] = Nth ofType 2 0
+parseNth x [Dimension _ (NVInteger a) "n", Number _ (NVInteger b)] = Nth x a b
+parseNth x [Number _ (NVInteger b), Dimension _ (NVInteger a) "n"] = Nth x a b
+parseNth x [Dimension _ (NVInteger a) "n", Delim '+', Number _ (NVInteger b)] = Nth x a b
+parseNth x [Number _ (NVInteger b), Delim '+', Dimension _ (NVInteger a) "n"] = Nth x a b
+parseNth x [Dimension _ (NVInteger a) "n", Delim '-', Number _ (NVInteger b)] = Nth x a $ negate b
+parseNth x [Number _ (NVInteger b), Delim '-', Dimension _ (NVInteger a) "n"] = Nth x a $ negate b
+parseNth _ _ = Fail
+
+nthChild :: Bool -> Int -> (Element -> Bool) -> Element -> Bool
+nthChild ofType n success el | countPrev ofType el == n = success el
+    | otherwise = False
+nthChild' :: Bool -> Int -> Int -> (Element -> Bool) -> Element -> Bool
+nthChild' ofType a b success el | countPrev ofType el `rem` a == b = success el
+    | otherwise = False
+countPrev :: Bool -> Element -> Int
+countPrev ofType el =
+    length [el' | el' <- maybeStar previous el, name el == name el' || not ofType]
+maybeStar :: (t -> Maybe t) -> t -> [t]
+maybeStar cb x | Just y <- cb x = x : maybeStar cb y
+    | otherwise = [x]
 --------
 ---- RuleStore wrapper
 --------
-- 
2.30.2