Skip to content

Commit 7c8e682

Browse files
JaniczekJaniczek
authored
Merge pull request #247 from lydell/class-attribute
Support classes set using the `class` attribute
2 parents eef7f1a + a5b34be commit 7c8e682

7 files changed

Lines changed: 216 additions & 25 deletions

File tree

‎src/MicroListExtra.elm‎

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@ module MicroListExtra exposing
66
, setAt
77
, splitWhen
88
, transpose
9+
, unique
910
)
1011

1112

@@ -98,3 +99,26 @@ rowsLength listOfLists =
9899

99100
x :: _ ->
100101
List.length x
102+
103+
104+
unique : List a -> List a
105+
unique list =
106+
uniqueHelp identity [] list []
107+
108+
109+
uniqueHelp : (a -> b) -> List b -> List a -> List a -> List a
110+
uniqueHelp f existing remaining accumulator =
111+
case remaining of
112+
[] ->
113+
List.reverse accumulator
114+
115+
first :: rest ->
116+
let
117+
computedFirst =
118+
f first
119+
in
120+
if List.member computedFirst existing then
121+
uniqueHelp f existing rest accumulator
122+
123+
else
124+
uniqueHelp f (computedFirst :: existing) rest (first :: accumulator)

‎src/Test/Html/Internal/ElmHtml/InternalTypes.elm‎

Lines changed: 47 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@ module Test.Html.Internal.ElmHtml.InternalTypes exposing
22
( ElmHtml(..), TextTagRecord, NodeRecord, CustomNodeRecord, MarkdownNodeRecord
33
, Facts, Tagger, EventHandler, ElementKind(..)
44
, Attribute(..), AttributeRecord, NamespacedAttributeRecord, PropertyRecord, EventRecord
5+
, Validation(..), validationMessage, validationFromMessage
56
, decodeElmHtml, emptyFacts, toElementKind, decodeAttribute
67
)
78

@@ -13,6 +14,8 @@ module Test.Html.Internal.ElmHtml.InternalTypes exposing
1314
1415
@docs Attribute, AttributeRecord, NamespacedAttributeRecord, PropertyRecord, EventRecord
1516
17+
@docs Validation, validationMessage, validationFromMessage
18+
1619
@docs decodeElmHtml, emptyFacts, toElementKind, decodeAttribute
1720
1821
-}
@@ -317,16 +320,56 @@ decodeStyles =
317320
]
318321

319322

323+
type Validation
324+
= ClassVsClassNameValidation
325+
326+
327+
classVsClassNameValidationMessage : String
328+
classVsClassNameValidationMessage =
329+
"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."
330+
331+
332+
validationMessage : Validation -> String
333+
validationMessage validation =
334+
case validation of
335+
ClassVsClassNameValidation ->
336+
classVsClassNameValidationMessage
337+
338+
339+
validationFromMessage : String -> Maybe Validation
340+
validationFromMessage message =
341+
if message == classVsClassNameValidationMessage then
342+
Just ClassVsClassNameValidation
343+
344+
else
345+
Nothing
346+
347+
320348
{-| grab things from attributes via a decoder, then anything that isn't filtered on
321349
the object
322350
-}
323-
decodeOthers : Json.Decode.Decoder a -> Json.Decode.Decoder (Dict String a)
324-
decodeOthers otherDecoder =
351+
decodeOthers : Json.Decode.Decoder a -> Maybe Validation -> Json.Decode.Decoder (Dict String a)
352+
decodeOthers otherDecoder validation =
325353
decodeAttributes otherDecoder
326354
|> Json.Decode.andThen
327355
(\attributes ->
328356
decodeDictFilterMap otherDecoder
329357
|> Json.Decode.map (filterKnownKeys >> Dict.union attributes)
358+
|> (case validation of
359+
Nothing ->
360+
identity
361+
362+
Just ClassVsClassNameValidation ->
363+
Json.Decode.andThen
364+
(\dict ->
365+
if Dict.member "class" dict && Dict.member "className" dict then
366+
-- Due to Json.Decode.Error API we need to drop down to strings.
367+
Json.Decode.fail classVsClassNameValidationMessage
368+
369+
else
370+
Json.Decode.succeed dict
371+
)
372+
)
330373
)
331374

332375

@@ -374,8 +417,8 @@ decodeFacts (HtmlContext taggers eventDecoder) =
374417
decodeStyles
375418
(decodeEvents (eventDecoder taggers))
376419
(Json.Decode.maybe (Json.Decode.field attributeNamespaceKey Json.Decode.value))
377-
(decodeOthers Json.Decode.string)
378-
(decodeOthers Json.Decode.bool)
420+
(decodeOthers Json.Decode.string (Just ClassVsClassNameValidation))
421+
(decodeOthers Json.Decode.bool Nothing)
379422

380423

381424
{-| Just empty facts

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

Lines changed: 27 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -262,8 +262,33 @@ hasStyle style facts =
262262

263263
classnames : Facts msg -> List String
264264
classnames facts =
265-
Dict.get "className" facts.stringAttributes
266-
|> Maybe.withDefault ""
265+
(case
266+
( Dict.get "class" facts.stringAttributes
267+
, Dict.get "className" facts.stringAttributes
268+
)
269+
of
270+
( Just _, Just _ ) ->
271+
-- If you use both the `class` attribute and the `className` property at the same time,
272+
-- it’s undefined which classes you end up with. It depends on which order they are specified,
273+
-- which order elm/virtual-dom happens to apply them, and which of them changed most recently.
274+
-- Mixing both is not a good idea.
275+
--
276+
-- This code should be impossible to reach because of the validation in
277+
-- Test.Html.Internal.ElmHtml.InternalTypes.decodeOthers.
278+
--
279+
-- If we ever reach this code, silently claim that there are no classes (that no classes match
280+
-- the node).
281+
""
282+
283+
( Just class, Nothing ) ->
284+
class
285+
286+
( Nothing, Just className ) ->
287+
className
288+
289+
( Nothing, Nothing ) ->
290+
""
291+
)
267292
|> String.split " "
268293

269294

‎src/Test/Html/Internal/Inert.elm‎

Lines changed: 36 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,15 @@
1-
module Test.Html.Internal.Inert exposing (Node, fromElmHtml, fromHtml, parseAttribute, toElmHtml)
1+
module Test.Html.Internal.Inert exposing (Node, Error(..), fromElmHtml, fromHtml, parseAttribute, toElmHtml)
22

33
{-| Inert Html - that is, can't do anything with events.
44
5-
@docs Node, fromElmHtml, fromHtml, parseAttribute, toElmHtml
5+
@docs Node, Error, fromElmHtml, fromHtml, parseAttribute, toElmHtml
66
77
-}
88

99
import Elm.Kernel.HtmlAsJson
1010
import Html exposing (Html)
1111
import Json.Decode
12+
import MicroListExtra as List
1213
import Test.Html.Internal.ElmHtml.InternalTypes as InternalTypes exposing (ElmHtml, EventHandler, Tagger, decodeAttribute, decodeElmHtml)
1314
import VirtualDom
1415

@@ -17,14 +18,45 @@ type Node msg
1718
= Node (ElmHtml msg)
1819

1920

20-
fromHtml : Html msg -> Result String (Node msg)
21+
type Error
22+
= DecodeError Json.Decode.Error
23+
| ValidationErrors { deduped : List InternalTypes.Validation }
24+
25+
26+
fromHtml : Html msg -> Result Error (Node msg)
2127
fromHtml html =
2228
case Json.Decode.decodeValue (decodeElmHtml taggedEventDecoder) (toJson html) of
2329
Ok elmHtml ->
2430
Ok (Node elmHtml)
2531

2632
Err jsonError ->
27-
Err (Json.Decode.errorToString jsonError)
33+
case findValidationErrors jsonError of
34+
[] ->
35+
Err (DecodeError jsonError)
36+
37+
failedValidations ->
38+
Err (ValidationErrors { deduped = List.unique failedValidations })
39+
40+
41+
findValidationErrors : Json.Decode.Error -> List InternalTypes.Validation
42+
findValidationErrors error =
43+
case error of
44+
Json.Decode.Field _ e ->
45+
findValidationErrors e
46+
47+
Json.Decode.Index _ e ->
48+
findValidationErrors e
49+
50+
Json.Decode.OneOf es ->
51+
List.concatMap findValidationErrors es
52+
53+
Json.Decode.Failure stringError _ ->
54+
case InternalTypes.validationFromMessage stringError of
55+
Nothing ->
56+
[]
57+
58+
Just validation ->
59+
[ validation ]
2860

2961

3062
fromElmHtml : ElmHtml msg -> Node msg

‎src/Test/Html/Query.elm‎

Lines changed: 24 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,8 @@ module Test.Html.Query exposing
2222

2323
import Expect exposing (Expectation)
2424
import Html exposing (Html)
25+
import Json.Decode
26+
import Test.Html.Internal.ElmHtml.InternalTypes as InternalTypes
2527
import Test.Html.Internal.Inert as Inert
2628
import Test.Html.Query.Internal as Internal exposing (failWithQuery)
2729
import Test.Html.Selector exposing (Selector)
@@ -90,8 +92,11 @@ fromHtml html =
9092
Ok node ->
9193
Internal.Query node []
9294

93-
Err message ->
94-
Internal.InternalError message
95+
Err (Inert.DecodeError decodeError) ->
96+
Internal.InternalError (Json.Decode.errorToString decodeError)
97+
98+
Err (Inert.ValidationErrors validations) ->
99+
Internal.ValidationErrors validations
95100

96101

97102

@@ -372,12 +377,23 @@ contains expectedHtml (Internal.Single showTrace query) =
372377
|> failWithQuery showTrace "Query.contains" query
373378

374379
Err errors ->
375-
Expect.fail <|
376-
String.join "\n" <|
377-
List.concat
378-
[ [ "Internal Error: failed to decode the virtual dom. Please report this at <https://github.com/elm-explorations/test/issues>." ]
379-
, errors
380-
]
380+
errors
381+
|> List.map
382+
(\error ->
383+
(case error of
384+
Inert.DecodeError decodeError ->
385+
[ "Internal Error: failed to decode the virtual dom. Please report this at <https://github.com/elm-explorations/test/issues>."
386+
, Json.Decode.errorToString decodeError
387+
]
388+
389+
Inert.ValidationErrors { deduped } ->
390+
deduped
391+
|> List.map InternalTypes.validationMessage
392+
)
393+
|> String.join "\n"
394+
)
395+
|> String.join "\n\n"
396+
|> Expect.fail
381397

382398

383399
collectResults : List (Result x a) -> Result (List x) (List a)

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

Lines changed: 37 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@ module Test.Html.Query.Internal exposing (Multiple(..), Query(..), QueryError(..
22

33
import Expect exposing (Expectation)
44
import Test.Html.Descendant as Descendant
5-
import Test.Html.Internal.ElmHtml.InternalTypes exposing (ElmHtml(..))
5+
import Test.Html.Internal.ElmHtml.InternalTypes as InternalTypes exposing (ElmHtml(..))
66
import Test.Html.Internal.ElmHtml.ToString exposing (nodeToStringWithOptions)
77
import Test.Html.Internal.Inert as Inert
88
import Test.Html.Selector.Internal as InternalSelector exposing (Selector, selectorToString)
@@ -14,6 +14,7 @@ import Test.Runner
1414
type Query msg
1515
= Query (Inert.Node msg) (List SelectorQuery)
1616
| InternalError String
17+
| ValidationErrors { deduped : List InternalTypes.Validation }
1718

1819

1920
type SelectorQuery
@@ -47,19 +48,32 @@ type QueryError
4748
= NoResultsForSingle String
4849
| MultipleResultsForSingle String Int
4950
| OtherInternalError String
51+
| QueryValidationErrors { deduped : List InternalTypes.Validation }
5052

5153

52-
toLines : String -> Query msg -> String -> List String
53-
toLines expectationFailure query queryName =
54+
toLines : { showQueryError : Bool } -> String -> Query msg -> String -> List String
55+
toLines { showQueryError } expectationFailure query queryName =
5456
case query of
5557
Query node selectors ->
5658
toLinesHelp expectationFailure [ Inert.toElmHtml node ] (List.reverse selectors) queryName []
5759
|> List.reverse
5860

5961
InternalError message ->
60-
[ "Internal Error: failed to decode the virtual dom. Please report this at <https://github.com/elm-explorations/test/issues>"
61-
, message
62-
]
62+
if showQueryError then
63+
[ "Internal Error: failed to decode the virtual dom. Please report this at <https://github.com/elm-explorations/test/issues>. "
64+
, message
65+
]
66+
67+
else
68+
[]
69+
70+
ValidationErrors { deduped } ->
71+
if showQueryError then
72+
deduped
73+
|> List.map InternalTypes.validationMessage
74+
75+
else
76+
[]
6377

6478

6579
prettyPrint : ElmHtml msg -> String
@@ -77,6 +91,11 @@ toOutputLine query =
7791
"Internal Error: failed to decode the virtual dom. Please report this at <https://github.com/elm-explorations/test/issues>. "
7892
++ message
7993

94+
ValidationErrors { deduped } ->
95+
deduped
96+
|> List.map InternalTypes.validationMessage
97+
|> String.join "\n\n"
98+
8099

81100
toLinesHelp : String -> List (ElmHtml msg) -> List SelectorQuery -> String -> List String -> List String
82101
toLinesHelp expectationFailure elmHtmlList selectorQueries queryName results =
@@ -243,6 +262,9 @@ prependSelector query selector =
243262
InternalError message ->
244263
InternalError message
245264

265+
ValidationErrors validations ->
266+
ValidationErrors validations
267+
246268

247269
{-| This is a more efficient implementation of the following:
248270
@@ -300,6 +322,9 @@ traverse query =
300322
InternalError message ->
301323
Err (OtherInternalError message)
302324

325+
ValidationErrors validations ->
326+
Err (QueryValidationErrors validations)
327+
303328

304329
traverseSelectors : List SelectorQuery -> List (ElmHtml msg) -> Result QueryError (List (ElmHtml msg))
305330
traverseSelectors selectorQueries elmHtmlList =
@@ -452,6 +477,11 @@ queryErrorToString error =
452477
"Internal Error: failed to decode the virtual dom. Please report this at <https://github.com/elm-explorations/test/issues>. "
453478
++ message
454479

480+
QueryValidationErrors { deduped } ->
481+
deduped
482+
|> List.map InternalTypes.validationMessage
483+
|> String.join "\n\n"
484+
455485

456486
contains : List (ElmHtml msg) -> Query msg -> Expectation
457487
contains expectedDescendants query =
@@ -572,7 +602,7 @@ failWithQuery showTrace queryName query expectation =
572602
Just { description } ->
573603
let
574604
lines =
575-
toLines description query queryName
605+
toLines { showQueryError = not showTrace } description query queryName
576606
|> List.map prefixOutputLine
577607

578608
tracedLines =

0 commit comments

Comments
 (0)