diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index c95ba6e1..aa045846 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -16,7 +16,7 @@ jobs: matrix: # Run on Mac and Linux, for multiple Node versions os: [macos-latest, ubuntu-latest] - node: ['8', '10', '12', '14'] + node: ['16', '18', '20', '22', '24'] env: ELM_HOME: '${{ github.workspace }}/elm-home' @@ -32,7 +32,7 @@ jobs: # Install elm and cache ELM_HOME - name: Install elm - uses: mpizenberg/elm-tooling-action@v1.2 + uses: mpizenberg/elm-tooling-action@v1.7 with: cache-key: tests-${{ matrix.os }}-node${{ matrix.node }}-0 cache-restore-key: tests-${{ matrix.os }}-node${{ matrix.node }} @@ -50,7 +50,7 @@ jobs: # Install elm-format - name: Install elm-format - uses: mpizenberg/elm-tooling-action@v1.2 + uses: mpizenberg/elm-tooling-action@v1.7 with: cache-key: format-${{ matrix.os }}-node${{ matrix.node }}-0 cache-restore-key: format-${{ matrix.os }}-node${{ matrix.node }} diff --git a/CHANGELOG.md b/CHANGELOG.md index bf62246d..1f708011 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,24 +1,25 @@ ## Releases -| Version | Notes | -| ------------------------------------------------------------------------------------ | -------------------------------------------------------------------------------------------------------------------------------------------------- | -| [**2.2.0**](https://github.com/elm-explorations/test/tree/2.2.0) | `Fuzz`: Add `Fuzz.filterMap` -| [**2.1.2**](https://github.com/elm-explorations/test/tree/2.1.2) | `Fuzz`: Remove arbitrary limit on amount of randomness drawn -| [**2.1.1**](https://github.com/elm-explorations/test/tree/2.1.1) | `Test.Html.Query`: Change how boolean attributes are rendered -| [**2.1.0**](https://github.com/elm-explorations/test/tree/2.1.0) | Add `Test.Html.Selector.exactText` | -| [**2.0.1**](https://github.com/elm-explorations/test/tree/2.0.1) | Documentation fixes | -| [**2.0.0**](https://github.com/elm-explorations/test/tree/2.0.0) | Reimplements fuzzing+shrinking, adds fuzzer distribution reporting. Most notably readds `Fuzz.andThen`. See ["Changes in 2.0.0"](#changes-in-200) | -| [**1.2.2**](https://github.com/elm-explorations/test/tree/1.2.2) | Fixes a crash in `Test.Html` when the HTML contains nested `Html.Lazy` nodes. [#78](https://github.com/elm-explorations/test/issues/78) | -| [**1.2.1**](https://github.com/elm-explorations/test/tree/1.2.1) | Many small documentation fixes. Improve error messages when failing to simulate an event. | -| [**1.2.0**](https://github.com/elm-explorations/test/tree/1.2.0) | Add HTML tests. [#41](https://github.com/elm-explorations/test/pull/41) | -| [**1.0.0**](https://github.com/elm-explorations/test/tree/1.0.0) | Update for Elm 0.19. Remove `Fuzz.andThen`, `Fuzz.conditional`, and `Test.Runner.getFailure`. Fail on equating floats to encourage checks with tolerance. `Test.Runner.fuzz` now returns a `Result`. | +| Version | Notes | +| ---------------------------------------------------------------- | -------------------------------------------------------------------------------------------------------------------------------------------------- | +| [**2.2.1**](https://github.com/elm-explorations/test/tree/2.2.1) | `Test.Html.Query`: Support classes set using the `class` attribute | +| [**2.2.0**](https://github.com/elm-explorations/test/tree/2.2.0) | `Fuzz`: Add `Fuzz.filterMap` | +| [**2.1.2**](https://github.com/elm-explorations/test/tree/2.1.2) | `Fuzz`: Remove arbitrary limit on amount of randomness drawn | +| [**2.1.1**](https://github.com/elm-explorations/test/tree/2.1.1) | `Test.Html.Query`: Change how boolean attributes are rendered | +| [**2.1.0**](https://github.com/elm-explorations/test/tree/2.1.0) | Add `Test.Html.Selector.exactText` | +| [**2.0.1**](https://github.com/elm-explorations/test/tree/2.0.1) | Documentation fixes | +| [**2.0.0**](https://github.com/elm-explorations/test/tree/2.0.0) | Reimplements fuzzing+shrinking, adds fuzzer distribution reporting. Most notably readds `Fuzz.andThen`. See ["Changes in 2.0.0"](#changes-in-200) | +| [**1.2.2**](https://github.com/elm-explorations/test/tree/1.2.2) | Fixes a crash in `Test.Html` when the HTML contains nested `Html.Lazy` nodes. [#78](https://github.com/elm-explorations/test/issues/78) | +| [**1.2.1**](https://github.com/elm-explorations/test/tree/1.2.1) | Many small documentation fixes. Improve error messages when failing to simulate an event. | +| [**1.2.0**](https://github.com/elm-explorations/test/tree/1.2.0) | Add HTML tests. [#41](https://github.com/elm-explorations/test/pull/41) | +| [**1.0.0**](https://github.com/elm-explorations/test/tree/1.0.0) | Update for Elm 0.19. Remove `Fuzz.andThen`, `Fuzz.conditional`, and `Test.Runner.getFailure`. Fail on equating floats to encourage checks with tolerance. `Test.Runner.fuzz` now returns a `Result`. | | renamed from **elm-community/elm-test** (below) to **elm-explorations/test** (above) | | -| [**4.0.0**](https://github.com/elm-community/elm-test/tree/4.0.0) | Add `only`, `skip`, `todo`; change `Fuzz.frequency` to fail rather than crash on bad input, disallow tests with blank or duplicate descriptions. | -| [**3.1.0**](https://github.com/elm-community/elm-test/tree/3.1.0) | Add `Expect.all` | -| [**3.0.0**](https://github.com/elm-community/elm-test/tree/3.0.0) | Update for Elm 0.18; switch the argument order of `Fuzz.andMap`. | -| [**2.1.0**](https://github.com/elm-community/elm-test/tree/2.1.0) | Switch to rose trees for `Fuzz.andThen`, other API additions. | -| [**2.0.0**](https://github.com/elm-community/elm-test/tree/2.0.0) | Scratch-rewrite to project-fuzzball | -| [**1.0.0**](https://github.com/elm-community/elm-test/tree/1.0.0) | ElmTest initial release | +| [**4.0.0**](https://github.com/elm-community/elm-test/tree/4.0.0) | Add `only`, `skip`, `todo`; change `Fuzz.frequency` to fail rather than crash on bad input, disallow tests with blank or duplicate descriptions. | +| [**3.1.0**](https://github.com/elm-community/elm-test/tree/3.1.0) | Add `Expect.all` | +| [**3.0.0**](https://github.com/elm-community/elm-test/tree/3.0.0) | Update for Elm 0.18; switch the argument order of `Fuzz.andMap`. | +| [**2.1.0**](https://github.com/elm-community/elm-test/tree/2.1.0) | Switch to rose trees for `Fuzz.andThen`, other API additions. | +| [**2.0.0**](https://github.com/elm-community/elm-test/tree/2.0.0) | Scratch-rewrite to project-fuzzball | +| [**1.0.0**](https://github.com/elm-community/elm-test/tree/1.0.0) | ElmTest initial release | ## Changes in 2.0.0 diff --git a/elm.json b/elm.json index eae49155..68b845ca 100644 --- a/elm.json +++ b/elm.json @@ -3,7 +3,7 @@ "name": "elm-explorations/test", "summary": "Write unit and fuzz tests for Elm code.", "license": "BSD-3-Clause", - "version": "2.2.0", + "version": "2.2.1", "exposed-modules": [ "Test", "Test.Runner", diff --git a/src/MicroListExtra.elm b/src/MicroListExtra.elm index 3a60c9f8..dfb3a331 100644 --- a/src/MicroListExtra.elm +++ b/src/MicroListExtra.elm @@ -6,6 +6,7 @@ module MicroListExtra exposing , setAt , splitWhen , transpose + , unique ) @@ -98,3 +99,26 @@ rowsLength listOfLists = x :: _ -> List.length x + + +unique : List a -> List a +unique list = + uniqueHelp identity [] list [] + + +uniqueHelp : (a -> b) -> List b -> List a -> List a -> List a +uniqueHelp f existing remaining accumulator = + case remaining of + [] -> + List.reverse accumulator + + first :: rest -> + let + computedFirst = + f first + in + if List.member computedFirst existing then + uniqueHelp f existing rest accumulator + + else + uniqueHelp f (computedFirst :: existing) rest (first :: accumulator) diff --git a/src/Test/Html/Internal/ElmHtml/InternalTypes.elm b/src/Test/Html/Internal/ElmHtml/InternalTypes.elm index f2a6bc73..35c80fe6 100644 --- a/src/Test/Html/Internal/ElmHtml/InternalTypes.elm +++ b/src/Test/Html/Internal/ElmHtml/InternalTypes.elm @@ -2,6 +2,7 @@ module Test.Html.Internal.ElmHtml.InternalTypes exposing ( ElmHtml(..), TextTagRecord, NodeRecord, CustomNodeRecord, MarkdownNodeRecord , Facts, Tagger, EventHandler, ElementKind(..) , Attribute(..), AttributeRecord, NamespacedAttributeRecord, PropertyRecord, EventRecord + , Validation(..), validationMessage, validationFromMessage , decodeElmHtml, emptyFacts, toElementKind, decodeAttribute ) @@ -13,6 +14,8 @@ module Test.Html.Internal.ElmHtml.InternalTypes exposing @docs Attribute, AttributeRecord, NamespacedAttributeRecord, PropertyRecord, EventRecord +@docs Validation, validationMessage, validationFromMessage + @docs decodeElmHtml, emptyFacts, toElementKind, decodeAttribute -} @@ -317,16 +320,56 @@ decodeStyles = ] +type Validation + = ClassVsClassNameValidation + + +classVsClassNameValidationMessage : String +classVsClassNameValidationMessage = + "Found the `class` attribute and the `className` property used in the same HTML node. This would result in unspecified behaviour, and elm-test wouldn't be able to reliably query for classnames. Please only use one of the two." + + +validationMessage : Validation -> String +validationMessage validation = + case validation of + ClassVsClassNameValidation -> + classVsClassNameValidationMessage + + +validationFromMessage : String -> Maybe Validation +validationFromMessage message = + if message == classVsClassNameValidationMessage then + Just ClassVsClassNameValidation + + else + Nothing + + {-| grab things from attributes via a decoder, then anything that isn't filtered on the object -} -decodeOthers : Json.Decode.Decoder a -> Json.Decode.Decoder (Dict String a) -decodeOthers otherDecoder = +decodeOthers : Json.Decode.Decoder a -> Maybe Validation -> Json.Decode.Decoder (Dict String a) +decodeOthers otherDecoder validation = decodeAttributes otherDecoder |> Json.Decode.andThen (\attributes -> decodeDictFilterMap otherDecoder |> Json.Decode.map (filterKnownKeys >> Dict.union attributes) + |> (case validation of + Nothing -> + identity + + Just ClassVsClassNameValidation -> + Json.Decode.andThen + (\dict -> + if Dict.member "class" dict && Dict.member "className" dict then + -- Due to Json.Decode.Error API we need to drop down to strings. + Json.Decode.fail classVsClassNameValidationMessage + + else + Json.Decode.succeed dict + ) + ) ) @@ -374,8 +417,8 @@ decodeFacts (HtmlContext taggers eventDecoder) = decodeStyles (decodeEvents (eventDecoder taggers)) (Json.Decode.maybe (Json.Decode.field attributeNamespaceKey Json.Decode.value)) - (decodeOthers Json.Decode.string) - (decodeOthers Json.Decode.bool) + (decodeOthers Json.Decode.string (Just ClassVsClassNameValidation)) + (decodeOthers Json.Decode.bool Nothing) {-| Just empty facts diff --git a/src/Test/Html/Internal/ElmHtml/Query.elm b/src/Test/Html/Internal/ElmHtml/Query.elm index 64b1c36c..a1d519c4 100644 --- a/src/Test/Html/Internal/ElmHtml/Query.elm +++ b/src/Test/Html/Internal/ElmHtml/Query.elm @@ -262,8 +262,33 @@ hasStyle style facts = classnames : Facts msg -> List String classnames facts = - Dict.get "className" facts.stringAttributes - |> Maybe.withDefault "" + (case + ( Dict.get "class" facts.stringAttributes + , Dict.get "className" facts.stringAttributes + ) + of + ( Just _, Just _ ) -> + -- If you use both the `class` attribute and the `className` property at the same time, + -- it’s undefined which classes you end up with. It depends on which order they are specified, + -- which order elm/virtual-dom happens to apply them, and which of them changed most recently. + -- Mixing both is not a good idea. + -- + -- This code should be impossible to reach because of the validation in + -- Test.Html.Internal.ElmHtml.InternalTypes.decodeOthers. + -- + -- If we ever reach this code, silently claim that there are no classes (that no classes match + -- the node). + "" + + ( Just class, Nothing ) -> + class + + ( Nothing, Just className ) -> + className + + ( Nothing, Nothing ) -> + "" + ) |> String.split " " diff --git a/src/Test/Html/Internal/Inert.elm b/src/Test/Html/Internal/Inert.elm index fae19242..4af4f867 100644 --- a/src/Test/Html/Internal/Inert.elm +++ b/src/Test/Html/Internal/Inert.elm @@ -1,14 +1,15 @@ -module Test.Html.Internal.Inert exposing (Node, fromElmHtml, fromHtml, parseAttribute, toElmHtml) +module Test.Html.Internal.Inert exposing (Node, Error(..), fromElmHtml, fromHtml, parseAttribute, toElmHtml) {-| Inert Html - that is, can't do anything with events. -@docs Node, fromElmHtml, fromHtml, parseAttribute, toElmHtml +@docs Node, Error, fromElmHtml, fromHtml, parseAttribute, toElmHtml -} import Elm.Kernel.HtmlAsJson import Html exposing (Html) import Json.Decode +import MicroListExtra as List import Test.Html.Internal.ElmHtml.InternalTypes as InternalTypes exposing (ElmHtml, EventHandler, Tagger, decodeAttribute, decodeElmHtml) import VirtualDom @@ -17,14 +18,45 @@ type Node msg = Node (ElmHtml msg) -fromHtml : Html msg -> Result String (Node msg) +type Error + = DecodeError Json.Decode.Error + | ValidationErrors { deduped : List InternalTypes.Validation } + + +fromHtml : Html msg -> Result Error (Node msg) fromHtml html = case Json.Decode.decodeValue (decodeElmHtml taggedEventDecoder) (toJson html) of Ok elmHtml -> Ok (Node elmHtml) Err jsonError -> - Err (Json.Decode.errorToString jsonError) + case findValidationErrors jsonError of + [] -> + Err (DecodeError jsonError) + + failedValidations -> + Err (ValidationErrors { deduped = List.unique failedValidations }) + + +findValidationErrors : Json.Decode.Error -> List InternalTypes.Validation +findValidationErrors error = + case error of + Json.Decode.Field _ e -> + findValidationErrors e + + Json.Decode.Index _ e -> + findValidationErrors e + + Json.Decode.OneOf es -> + List.concatMap findValidationErrors es + + Json.Decode.Failure stringError _ -> + case InternalTypes.validationFromMessage stringError of + Nothing -> + [] + + Just validation -> + [ validation ] fromElmHtml : ElmHtml msg -> Node msg diff --git a/src/Test/Html/Query.elm b/src/Test/Html/Query.elm index 562d40af..5a171c7d 100644 --- a/src/Test/Html/Query.elm +++ b/src/Test/Html/Query.elm @@ -27,6 +27,8 @@ module Test.Html.Query exposing import Expect exposing (Expectation) import Html exposing (Html) +import Json.Decode +import Test.Html.Internal.ElmHtml.InternalTypes as InternalTypes import Test.Html.Internal.Inert as Inert import Test.Html.Query.Internal as Internal exposing (failWithQuery) import Test.Html.Selector exposing (Selector) @@ -95,8 +97,11 @@ fromHtml html = Ok node -> Internal.Query node [] - Err message -> - Internal.InternalError message + Err (Inert.DecodeError decodeError) -> + Internal.InternalError (Json.Decode.errorToString decodeError) + + Err (Inert.ValidationErrors validations) -> + Internal.ValidationErrors validations @@ -377,12 +382,23 @@ contains expectedHtml (Internal.Single showTrace query) = |> failWithQuery showTrace "Query.contains" query Err errors -> - Expect.fail <| - String.join "\n" <| - List.concat - [ [ "Internal Error: failed to decode the virtual dom. Please report this at ." ] - , errors - ] + errors + |> List.map + (\error -> + (case error of + Inert.DecodeError decodeError -> + [ "Internal Error: failed to decode the virtual dom. Please report this at ." + , Json.Decode.errorToString decodeError + ] + + Inert.ValidationErrors { deduped } -> + deduped + |> List.map InternalTypes.validationMessage + ) + |> String.join "\n" + ) + |> String.join "\n\n" + |> Expect.fail collectResults : List (Result x a) -> Result (List x) (List a) diff --git a/src/Test/Html/Query/Internal.elm b/src/Test/Html/Query/Internal.elm index 27e8374c..0cacd3d3 100644 --- a/src/Test/Html/Query/Internal.elm +++ b/src/Test/Html/Query/Internal.elm @@ -2,7 +2,7 @@ module Test.Html.Query.Internal exposing (Multiple(..), Query(..), QueryError(.. import Expect exposing (Expectation) import Test.Html.Descendant as Descendant -import Test.Html.Internal.ElmHtml.InternalTypes exposing (ElmHtml(..)) +import Test.Html.Internal.ElmHtml.InternalTypes as InternalTypes exposing (ElmHtml(..)) import Test.Html.Internal.ElmHtml.ToString exposing (nodeToStringWithOptions) import Test.Html.Internal.Inert as Inert import Test.Html.Selector.Internal as InternalSelector exposing (Selector, selectorToString) @@ -14,6 +14,7 @@ import Test.Runner type Query msg = Query (Inert.Node msg) (List SelectorQuery) | InternalError String + | ValidationErrors { deduped : List InternalTypes.Validation } type SelectorQuery @@ -47,19 +48,32 @@ type QueryError = NoResultsForSingle String | MultipleResultsForSingle String Int | OtherInternalError String + | QueryValidationErrors { deduped : List InternalTypes.Validation } -toLines : String -> Query msg -> String -> List String -toLines expectationFailure query queryName = +toLines : { showQueryError : Bool } -> String -> Query msg -> String -> List String +toLines { showQueryError } expectationFailure query queryName = case query of Query node selectors -> toLinesHelp expectationFailure [ Inert.toElmHtml node ] (List.reverse selectors) queryName [] |> List.reverse InternalError message -> - [ "Internal Error: failed to decode the virtual dom. Please report this at " - , message - ] + if showQueryError then + [ "Internal Error: failed to decode the virtual dom. Please report this at . " + , message + ] + + else + [] + + ValidationErrors { deduped } -> + if showQueryError then + deduped + |> List.map InternalTypes.validationMessage + + else + [] prettyPrint : ElmHtml msg -> String @@ -77,6 +91,11 @@ toOutputLine query = "Internal Error: failed to decode the virtual dom. Please report this at . " ++ message + ValidationErrors { deduped } -> + deduped + |> List.map InternalTypes.validationMessage + |> String.join "\n\n" + toLinesHelp : String -> List (ElmHtml msg) -> List SelectorQuery -> String -> List String -> List String toLinesHelp expectationFailure elmHtmlList selectorQueries queryName results = @@ -243,6 +262,9 @@ prependSelector query selector = InternalError message -> InternalError message + ValidationErrors validations -> + ValidationErrors validations + {-| This is a more efficient implementation of the following: @@ -300,6 +322,9 @@ traverse query = InternalError message -> Err (OtherInternalError message) + ValidationErrors validations -> + Err (QueryValidationErrors validations) + traverseSelectors : List SelectorQuery -> List (ElmHtml msg) -> Result QueryError (List (ElmHtml msg)) traverseSelectors selectorQueries elmHtmlList = @@ -452,6 +477,11 @@ queryErrorToString error = "Internal Error: failed to decode the virtual dom. Please report this at . " ++ message + QueryValidationErrors { deduped } -> + deduped + |> List.map InternalTypes.validationMessage + |> String.join "\n\n" + contains : List (ElmHtml msg) -> Query msg -> Expectation contains expectedDescendants query = @@ -572,7 +602,7 @@ failWithQuery showTrace queryName query expectation = Just { description } -> let lines = - toLines description query queryName + toLines { showQueryError = not showTrace } description query queryName |> List.map prefixOutputLine tracedLines = diff --git a/tests/src/Test/Html/QueryTests.elm b/tests/src/Test/Html/QueryTests.elm index 134ff5c2..198d7b01 100644 --- a/tests/src/Test/Html/QueryTests.elm +++ b/tests/src/Test/Html/QueryTests.elm @@ -113,6 +113,27 @@ all = [ Query.has [ attribute (Attr.property "className" (Encode.string "hello world")) ] , Query.has [ attribute (Attr.property "className" (Encode.string "world hello")) ] ] + , test "matches a class added using Attr.attribute" <| + \() -> + divWithAttribute (Attr.attribute "class" "hello") + |> Query.fromHtml + |> Query.has [ class "hello" ] + , test "matches a class added using Attr.property" <| + \() -> + divWithAttribute (Attr.property "className" (Encode.string "hello")) + |> Query.fromHtml + |> Query.has [ class "hello" ] + , test "matches nothing if classes are added both using Attr.attribute and Attr.property" <| + \() -> + Html.div + [ Attr.attribute "class" "hello" + , Attr.property "className" (Encode.string "world") + ] + [] + |> Query.fromHtml + |> Query.has [ class "hello" ] + |> expectationToIsPassing + |> Expect.equal False ] ] , describe "Query.contains" <|