:is and :has pseudo classes

Author: yaitskov

src/CssParser/Lexer.x

@@ -117,6 +117,8 @@ $pm       = [\-\+]
 @profile = @p@r@o@f@i@l@e
 
 @to      = @t@o
+@is      = @i@s
+@has     = @h@a@s
 @not     = @n@o@t
 @where   = @w@h@e@r@e
 @and     = @a@n@d
@@ -278,8 +280,10 @@ tokens :-
   @psc @nthh@lasth@child "("              { constAndBegin (PseudoFunction NthFLastChild) nth_state }
   @psc @nthh@lasth@oftype "("             { constAndBegin (PseudoFunction NthFLastOfType) nth_state }
   @psc @nthh@oftype "("                   { constAndBegin (PseudoFunction NthFOfType) nth_state }
-  @psc @not "(" @wo                       { constoken TNot }
+  @psc @not                               { constoken TNot }
   @psc @where                             { constoken TWhere }
+  @psc @has                               { constoken THas }
+  @psc @is                                { constoken TIs }
   @wo ")"                                 { constoken TClose }
   "("                                     { constoken TOpen }
   @psc @onlyh@oftype                      { constoken (AtomicPseudoClassT OnlyOfType) }
@@ -431,6 +435,8 @@ data Token
     | TClose
     | TNot
     | TWhere
+    | TIs
+    | THas
     | TLang
     deriving (Show, Eq)
 

src/CssParser/Parser.y

@@ -36,7 +36,7 @@ import CssParser.Lexer
     , TOpen, TClose
     , Greater, Less, LessEqual, GreaterEqual
     , RatioT, Percents, Pixels
-    , UrlT, TWhere
+    , UrlT, TWhere, THas, TIs
     , PseudoPageT, PageT, PageMarginT
     , KeyframesT, ColorProfileT, FontFaceT, SrcPropT, UnicodeRangeT, UnicodeRangeVal
     , FontFeatureValuesT, AtT, FontPaletteValuesT, ContainerT, DivT, PositionTryT
@@ -152,8 +152,10 @@ import Prelude
     px          { TokenLoc (Pixels $$) _ _ }
     var         { TokenLoc (Var $$) _ _ }
     nth         { TokenLoc (TNth $$) _ _ }
-    'not('      { TokenLoc TNot _ _ }
+    ':not'      { TokenLoc TNot _ _ }
     where       { TokenLoc TWhere _ _ }
+    is          { TokenLoc TIs _ _ }
+    has         { TokenLoc THas _ _ }
     'lang('     { TokenLoc TLang _ _ }
     '('         { TokenLoc TOpen _ _ }
     ')'         { TokenLoc TClose _ _ }
@@ -440,12 +442,15 @@ CssRuleBody :: { [ CssRuleBodyItem ] }
     | IdKwd pseudc ContinueRule CssRuleBody       { upsertHeadTagSelector
                                                       (setTag $1 . addClass (AtomicPseudoClass $2)) $3 $4 }
     | IdKwd pseudc ERB CssRuleBody                { newRule (addClass (AtomicPseudoClass $2) . setTag $1) $3 $4 }
-    | IdKwd 'not(' SelectorList ')' ContinueRule CssRuleBody
-                                                  { upsertHeadTagSelector (setTag $1 . addClass (NotClass $3)) $5 $6 }
-    | IdKwd 'not(' SelectorList ')' ERB CssRuleBody
-                                                  { newRule (setTag $1 . addClass (NotClass $3)) $5 $6 }
+    | IdKwd ':not' ESL ContinueRule CssRuleBody   { upsertHeadTagSelector (setTag $1 . addClass (NotClass $3)) $4 $5 }
+    | IdKwd ':not' ESL ERB CssRuleBody            { newRule (setTag $1 . addClass (NotClass $3)) $4 $5 }
     | IdKwd where ESL ContinueRule CssRuleBody    { upsertHeadTagSelector (setTag $1 . addClass (Where $3)) $4 $5 }
     | IdKwd where ESL ERB CssRuleBody             { newRule (setTag $1 . addClass (Where $3)) $4 $5 }
+    | IdKwd is    ESL ContinueRule CssRuleBody    { upsertHeadTagSelector (setTag $1 . addClass (Is $3)) $4 $5 }
+    | IdKwd is    ESL ERB          CssRuleBody    { newRule (setTag $1 . addClass (Is $3)) $4 $5 }
+    | IdKwd has   ESL ContinueRule CssRuleBody    { upsertHeadTagSelector (setTag $1 . addClass (Has $3)) $4 $5 }
+    | IdKwd has   ESL ERB          CssRuleBody    { newRule (setTag $1 . addClass (Has $3)) $4 $5 }
+
     | IdKwd 'lang(' Str ')' ContinueRule CssRuleBody
                                                   { upsertHeadTagSelector (setTag $1 . addClass (Lang (Language $3))) $5 $6 }
     | IdKwd 'lang(' Str ')' ERB CssRuleBody       { newRule (setTag $1 . addClass (Lang (Language $3))) $5 $6 }
@@ -501,9 +506,11 @@ TagClasses :: { [ Class ] }
 TagClass :: { Class }
     : '.' Ident                                       { AtomicClass $2 }
     | pseudc                                          { AtomicPseudoClass $1 }
-    | 'not(' SelectorList ')'                         { NotClass $2 }
-    | 'lang(' string ')'                              { Lang (Language (pack $2)) }
+    | ':not' ESL                                      { NotClass $2 }
+    | 'lang(' Str ')'                                 { Lang (Language $2) }
     | where ESL                                       { Where $2 }
+    | is ESL                                          { Is $2 }
+    | has ESL                                         { Has $2 }
     | pseudf Os Nth                                   { call $1 $3 }
 ZipTagRelAndTagSel :: { [ (TagRelation, TagSelector) ] }
     :                                                 { [] }

src/CssParser/Rule.hs

@@ -68,6 +68,8 @@ data Class
   | NotClass SelectorList
   | Lang Language
   | Where SelectorList
+  | Has SelectorList
+  | Is SelectorList
   | NthChild Nth
   | NthLastChild Nth
   | NthLastOfType Nth

src/CssParser/Rule/Show.hs

@@ -85,6 +85,8 @@ instance CssShow Class where
     NotClass nes -> ":not(" <> toCssText nes <> ")"
     Lang (Language l) -> ":lang(" <> fromStrict l <> ")"
     Where nes -> ":where(" <> toCssText nes <> ")"
+    Is nes -> ":is(" <> toCssText nes <> ")"
+    Has nes -> ":has(" <> toCssText nes <> ")"
     NthChild nth -> ":nth-child(" <> toCssText nth <> ")"
     NthLastChild nth -> ":nth-last-child(" <> toCssText nth <> ")"
     NthLastOfType nth -> ":nth-last-of-type(" <> toCssText nth <> ")"

test/Spec.hs

@@ -245,6 +245,8 @@ validSelectors =
   , "body > h2:nth-of-type(n+2):nth-last-of-type(n+2)"
   , "body > h2:not(:first-of-type):not(:last-of-type)"
   , ":where(ol, ul, menu:focus)"
+  , "h1:has(+ p)"
+  , ":is(ol, ul) :is(ol, ul) ol"
   , "div:where(ol, ul) :where(ol, ul, menu:hover) ol"
   , "h1, h2, h3"
   , "h1"