feat: NS class selectors

elm.json

@@ -21,6 +21,7 @@
         "elm/html": "1.0.0 <= v < 2.0.0",
         "elm/json": "1.0.0 <= v < 2.0.0",
         "elm/random": "1.0.0 <= v < 2.0.0",
+        "elm/svg": "1.0.1 <= v < 2.0.0",
         "elm/virtual-dom": "1.0.0 <= v < 2.0.0"
     },
     "test-dependencies": {}

src/Test/Html/Internal/ElmHtml/Query.elm

@@ -29,7 +29,9 @@ import Test.Html.Internal.ElmHtml.InternalTypes exposing (..)
 type Selector
     = Id String
     | ClassName String
+    | ClassNameNS String
     | ClassList (List String)
+    | ClassListNS (List String)
     | Tag String
     | Attribute String String
     | BoolAttribute String Bool
@@ -242,11 +244,21 @@ hasClass queryString facts =
     List.member queryString (classnames facts)
 
 
+hasClassNS : String -> Facts msg -> Bool
+hasClassNS queryString facts =
+    List.member queryString (classnamesNS facts)
+
+
 hasClasses : List String -> Facts msg -> Bool
 hasClasses classList facts =
     containsAll classList (classnames facts)
 
 
+hasClassesNS : List String -> Facts msg -> Bool
+hasClassesNS classList facts =
+    containsAll classList (classnamesNS facts)
+
+
 hasStyle : { key : String, value : String } -> Facts msg -> Bool
 hasStyle style facts =
     Dict.get style.key facts.styles == Just style.value
@@ -259,6 +271,13 @@ classnames facts =
         |> String.split " "
 
 
+classnamesNS : Facts msg -> List String
+classnamesNS facts =
+    Dict.get "class" facts.stringAttributes
+        |> Maybe.withDefault ""
+        |> String.split " "
+
+
 containsAll : List a -> List a -> Bool
 containsAll a b =
     b
@@ -277,10 +296,18 @@ nodeRecordPredicate selector =
             .facts
                 >> hasClass classname
 
+        ClassNameNS classname ->
+            .facts
+                >> hasClassNS classname
+
         ClassList classList ->
             .facts
                 >> hasClasses classList
 
+        ClassListNS classList ->
+            .facts
+                >> hasClassesNS classList
+
         Tag tag ->
             .tag
                 >> (==) tag
@@ -316,10 +343,18 @@ markdownPredicate selector =
             .facts
                 >> hasClass classname
 
+        ClassNameNS classname ->
+            .facts
+                >> hasClassNS classname
+
         ClassList classList ->
             .facts
                 >> hasClasses classList
 
+        ClassListNS classList ->
+            .facts
+                >> hasClassesNS classList
+
         Tag tag ->
             always False
 

src/Test/Html/Selector.elm

@@ -1,7 +1,7 @@
 module Test.Html.Selector exposing
     ( Selector
     , tag, text, containing, attribute, all
-    , id, class, classes, exactClassName, style, checked, selected, disabled
+    , id, class, classNS, classes, classesNS, exactClassName, exactClassNameNS, style, checked, selected, disabled
     )
 
 {-| Selecting HTML elements.
@@ -16,7 +16,7 @@ module Test.Html.Selector exposing
 
 ## Attributes
 
-@docs id, class, classes, exactClassName, style, checked, selected, disabled
+@docs id, class, classNS, classes, classesNS, exactClassName, exactClassNameNS, style, checked, selected, disabled
 
 -}
 
@@ -85,6 +85,32 @@ classes =
     Classes
 
 
+{-| Matches svg elements that have all the given classes (and possibly others as well).
+
+When you only care about one class instead of several, you can use
+[`classNS`](#classNS) instead of passing this function a list with one value in it.
+
+To match the element's exact class attribute string, use [`exactClassNameNS`](#exactClassNameNS).
+
+    import Svg.Html as SvgHtml
+    import Svg.Attributes as SvgAttr
+    import Test.Html.Query as Query
+    import Test exposing (test)
+    import Test.Html.Selector exposing (classesNS)
+
+
+    test "Svg has the classes svg-styles and svg-large" <|
+        \() ->
+            SvgHtml.svg [ SvgAttr.class "svg-styles svg-large" ] []
+                |> Query.fromHtml
+                |> Query.has [ classesNS [ "svg-styles", "svg-large" ] ]
+
+-}
+classesNS : List String -> Selector
+classesNS =
+    ClassesNS
+
+
 {-| Matches elements that have the given class (and possibly others as well).
 
 To match multiple classes at once, use [`classes`](#classes) instead.
@@ -110,6 +136,31 @@ class =
     Class
 
 
+{-| Matches svg elements that have the given class (and possibly others as well).
+
+To match multiple classes at once, use [`classesNS`](#classesNS) instead.
+
+To match the element's exact class attribute string, use [`exactClassNameNS`](#exactClassNameNS).
+
+    import Svg.Html as SvgHtml
+    import Svg.Attributes as SvgAttr
+    import Test.Html.Query as Query
+    import Test exposing (test)
+    import Test.Html.Selector exposing (classNS)
+
+
+    test "Svg has the class svg-large" <|
+        \() ->
+            SvgHtml.svg [ SvgAttr.class "svg-styles svg-large" ] [  ]
+                |> Query.fromHtml
+                |> Query.has [ classNS "svg-large" ]
+
+-}
+classNS : String -> Selector
+classNS =
+    ClassNS
+
+
 {-| Matches the element's exact class attribute string.
 
 This is used less often than [`class`](#class), [`classes`](#classes) or
@@ -135,6 +186,31 @@ exactClassName =
     namedAttr "className"
 
 
+{-| Matches the svg element's exact class attribute string.
+
+This is used less often than [`classNS`](#classNS) or [`classesNS`](#classesNS),
+which check for the _presence_ of a class as opposed to matching the entire
+class attribute exactly.
+
+    import Svg.Html as SvgHtml
+    import Svg.Attributes as SvgAttr
+    import Test.Html.Query as Query
+    import Test exposing (test)
+    import Test.Html.Selector exposing (exactClassNameNS)
+
+
+    test "Svg has the exact class 'svg-styles svg-large'" <|
+        \() ->
+            SvgHtml.svg [ SvgAttr.class "btn btn-large" ] []
+                |> Query.fromHtml
+                |> Query.has [ exactClassNameNS "svg-styles svg-large" ]
+
+-}
+exactClassNameNS : String -> Selector
+exactClassNameNS =
+    namedAttr "class"
+
+
 {-| Matches elements that have the given `id` attribute.
 
     import Html

src/Test/Html/Selector/Internal.elm

@@ -7,7 +7,9 @@ import Test.Html.Internal.ElmHtml.Query as ElmHtmlQuery
 type Selector
     = All (List Selector)
     | Classes (List String)
+    | ClassesNS (List String)
     | Class String
+    | ClassNS String
     | Attribute { name : String, value : String }
     | BoolAttribute { name : String, value : Bool }
     | Style { key : String, value : String }
@@ -40,9 +42,15 @@ selectorToString criteria =
         Classes list ->
             "classes " ++ quoteString (String.join " " list)
 
+        ClassesNS list ->
+            "classesNS " ++ quoteString (String.join " " list)
+
         Class class ->
             "class " ++ quoteString class
 
+        ClassNS class ->
+            "classNS " ++ quoteString class
+
         Attribute { name, value } ->
             "attribute "
                 ++ quoteString name
@@ -137,9 +145,15 @@ query fn fnAll selector list =
                 Classes classes ->
                     List.concatMap (fn (ElmHtmlQuery.ClassList classes)) elems
 
+                ClassesNS classes ->
+                    List.concatMap (fn (ElmHtmlQuery.ClassListNS classes)) elems
+
                 Class class ->
                     List.concatMap (fn (ElmHtmlQuery.ClassList [ class ])) elems
 
+                ClassNS class ->
+                    List.concatMap (fn (ElmHtmlQuery.ClassListNS [ class ])) elems
+
                 Attribute { name, value } ->
                     List.concatMap (fn (ElmHtmlQuery.Attribute name value)) elems
 

tests/elm.json

@@ -6,20 +6,20 @@
     "elm-version": "0.19.1",
     "dependencies": {
         "direct": {
-            "elm/browser": "1.0.0",
-            "elm/core": "1.0.0",
+            "elm/browser": "1.0.1",
+            "elm/core": "1.0.5",
             "elm/html": "1.0.0",
-            "elm/json": "1.0.0",
+            "elm/json": "1.1.3",
             "elm/random": "1.0.0",
-            "elm/svg": "1.0.0",
+            "elm/svg": "1.0.1",
             "elm/time": "1.0.0",
             "elm/url": "1.0.0",
-            "elm/virtual-dom": "1.0.0",
+            "elm/virtual-dom": "1.0.2",
             "elm-explorations/linear-algebra": "1.0.3",
             "elm-explorations/markdown": "1.0.0",
             "elm-explorations/test": "1.2.2",
-            "elm-explorations/webgl": "1.0.1",
-            "jinjor/elm-diff": "1.0.5",
+            "elm-explorations/webgl": "1.1.3",
+            "jinjor/elm-diff": "1.0.6",
             "rtfeldman/elm-validate": "4.0.1"
         },
         "indirect": {

tests/src/Test/Html/SelectorTests.elm

@@ -4,10 +4,12 @@ module Test.Html.SelectorTests exposing (all)
 -}
 
 import Fuzz exposing (..)
-import Html exposing (Html, a, div, footer, header, li, section, span, ul)
+import Html
 import Html.Attributes as Attr
+import Svg
+import Svg.Attributes as SvgAttribs
 import Test exposing (..)
-import Test.Html.Query as Query exposing (Single)
+import Test.Html.Query as Query
 import Test.Html.Selector exposing (..)
 
 
@@ -16,6 +18,104 @@ all =
     describe "Test.Html.Selector"
         [ bug13
         , textSelectors
+        , classSelectors
+        , attributeSelectors
+        , nsSelectors
+        ]
+
+
+nsSelectors : Test
+nsSelectors =
+    describe "NS selectors"
+        [ test "classNS selector finds class on svg with one class" <|
+            \() ->
+                let
+                    svgClass =
+                        "some-NS-class"
+                in
+                Svg.svg
+                    [ SvgAttribs.class svgClass ]
+                    [ Svg.circle [ SvgAttribs.cx "50", SvgAttribs.cy "50", SvgAttribs.r "40" ] [] ]
+                    |> Query.fromHtml
+                    |> Query.has [ classNS svgClass ]
+        , test "classNS selector finds class on svg with multiple classes" <|
+            \() ->
+                let
+                    svgClass =
+                        "some-NS-class"
+                in
+                Svg.svg
+                    [ SvgAttribs.class svgClass, SvgAttribs.class "another-NS-class" ]
+                    [ Svg.circle [ SvgAttribs.cx "50", SvgAttribs.cy "50", SvgAttribs.r "40" ] [] ]
+                    |> Query.fromHtml
+                    |> Query.has [ classNS svgClass ]
+        , test "classesNS selector finds all classes on svg" <|
+            \() ->
+                let
+                    svgClass =
+                        "some-NS-class"
+                in
+                Svg.svg
+                    [ SvgAttribs.class svgClass, SvgAttribs.class "another-NS-class" ]
+                    [ Svg.circle [ SvgAttribs.cx "50", SvgAttribs.cy "50", SvgAttribs.r "40" ] [] ]
+                    |> Query.fromHtml
+                    |> Query.has [ classesNS [ svgClass, "another-NS-class" ] ]
+        , test "classesNS selector finds single class on svg with multiple classes" <|
+            \() ->
+                let
+                    svgClass =
+                        "some-NS-class"
+                in
+                Svg.svg
+                    [ SvgAttribs.class svgClass, SvgAttribs.class "another-NS-class" ]
+                    [ Svg.circle [ SvgAttribs.cx "50", SvgAttribs.cy "50", SvgAttribs.r "40" ] [] ]
+                    |> Query.fromHtml
+                    |> Query.has [ classesNS [ svgClass ] ]
+        , test "exactClassNameNS selector finds the exact class value on svg" <|
+            \() ->
+                let
+                    svgClass =
+                        "some-NS-class another-NS-class"
+                in
+                Svg.svg
+                    [ SvgAttribs.class svgClass ]
+                    [ Svg.circle [ SvgAttribs.cx "50", SvgAttribs.cy "50", SvgAttribs.r "40" ] [] ]
+                    |> Query.fromHtml
+                    |> Query.has [ exactClassNameNS svgClass ]
+        ]
+
+
+attributeSelectors : Test
+attributeSelectors =
+    describe "attribute selectors"
+        [ test "attribute selector does not find class on svg elements" <|
+            \() ->
+                let
+                    svgClass =
+                        "some-NS-class"
+                in
+                Svg.svg
+                    [ SvgAttribs.class svgClass ]
+                    [ Svg.circle [ SvgAttribs.cx "50", SvgAttribs.cy "50", SvgAttribs.r "40" ] [] ]
+                    |> Query.fromHtml
+                    |> Query.hasNot [ attribute (SvgAttribs.class svgClass) ]
+        ]
+
+
+classSelectors : Test
+classSelectors =
+    describe "class selectors"
+        [ test "does not find class on svg elements" <|
+            \() ->
+                let
+                    svgClass =
+                        "some-NS-class"
+                in
+                Svg.svg
+                    [ SvgAttribs.class svgClass ]
+                    [ Svg.circle [ SvgAttribs.cx "50", SvgAttribs.cy "50", SvgAttribs.r "40" ] [] ]
+                    |> Query.fromHtml
+                    |> Query.hasNot [ class svgClass ]
         ]