Skip to content

Make clickLink look for links with aria-label and alt text #168

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Aug 4, 2022
Merged

Make clickLink look for links with aria-label and alt text #168

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
2b40fdd
Make clickLink look for links with aria-label and alt text
nunntom Jul 29, 2022
3ba2282
Add runComplexQuery and use in clickLink
nunntom Jul 30, 2022
1d0ce7c
Make Result.Extra and use Result.Extra.isOk in ComplexQuery and click…
nunntom Jul 31, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
164 changes: 92 additions & 72 deletions src/ProgramTest.elm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -210,6 +210,7 @@ import ProgramTest.ComplexQuery as ComplexQuery exposing (ComplexQuery)
import ProgramTest.EffectSimulation as EffectSimulation exposing (EffectSimulation)
import ProgramTest.Failure as Failure exposing (Failure(..))
import ProgramTest.Program as Program exposing (Program)
import Result.Extra
import SimulatedEffect exposing (SimulatedEffect, SimulatedSub, SimulatedTask)
import String.Extra
import Test.Html.Event
Expand Down Expand Up @@ -760,38 +761,42 @@ simulateLabeledInputHelper functionDescription fieldId label allowTextArea addit
)


{-| TODO: have other internal functions use this to have more consistent error message.
-}
simulateComplexQuery : String -> (ComplexQuery (Query.Single msg) -> ComplexQuery msg) -> ProgramTest model msg effect -> ProgramTest model msg effect
simulateComplexQuery functionName complexQuery =
runComplexQuery :
String
-> (ComplexQuery (Query.Single msg) -> ComplexQuery a)
->
(a
-> Program model msg effect (SimulatedSub msg)
-> TestState model msg effect
-> Result Failure (TestState model msg effect)
)
-> ProgramTest model msg effect
-> ProgramTest model msg effect
runComplexQuery functionName complexQuery fn =
andThen <|
\program state ->
let
view =
Program.renderView program state.currentModel
in
case ComplexQuery.run (complexQuery (ComplexQuery.succeed view)) of
( _, Ok msg ) ->
TestState.update msg program state
( _, Ok a ) ->
fn a program state

( highlight, Err queryFailure ) ->
Err (ViewAssertionFailed ("ProgramTest." ++ functionName) (Html.map (\_ -> ()) (program.view state.currentModel)) highlight queryFailure)


{-| TODO: have other internal functions use this to have more consistent error message.
-}
simulateComplexQuery : String -> (ComplexQuery (Query.Single msg) -> ComplexQuery msg) -> ProgramTest model msg effect -> ProgramTest model msg effect
simulateComplexQuery functionName complexQuery =
runComplexQuery functionName complexQuery TestState.update


assertComplexQuery : String -> (ComplexQuery (Query.Single msg) -> ComplexQuery ignored) -> ProgramTest model msg effect -> ProgramTest model msg effect
assertComplexQuery functionName complexQuery =
andThen <|
\program state ->
let
view =
Program.renderView program state.currentModel
in
case ComplexQuery.run (complexQuery (ComplexQuery.succeed view)) of
( _, Ok _ ) ->
Ok state

( highlight, Err queryFailure ) ->
Err (ViewAssertionFailed ("ProgramTest." ++ functionName) (Html.map (\_ -> ()) (program.view state.currentModel)) highlight queryFailure)
runComplexQuery functionName complexQuery (\_ _ state -> Ok state)


{-| Simulates a custom DOM event.
Expand Down Expand Up @@ -1004,16 +1009,41 @@ sets `preventDefault`, but this will be done in the future after

-}
clickLink : String -> String -> ProgramTest model msg effect -> ProgramTest model msg effect
clickLink linkText href programTest =
clickLink linkText href =
let
functionDescription =
"clickLink " ++ String.Extra.escape linkText

findLinkTag =
[ Selector.tag "a"
, Selector.attribute (Html.Attributes.href href)
, Selector.containing [ Selector.text linkText ]
]
findLink =
ComplexQuery.exactlyOneOf "Expected one of the following to exist"
[ ( "<a> with text"
, ComplexQuery.find (Just "find link")
[ "a" ]
[ Selector.tag "a"
, Selector.attribute (Html.Attributes.href href)
, Selector.containing [ Selector.text linkText ]
]
)
, ( "<a> with aria-label"
, ComplexQuery.find (Just "find link")
[ "a" ]
[ Selector.tag "a"
, Selector.attribute (Html.Attributes.href href)
, Selector.attribute (Html.Attributes.attribute "aria-label" linkText)
]
)
, ( "<a> with <img> with alt text"
, ComplexQuery.find (Just "find link")
[ "a" ]
[ Selector.tag "a"
, Selector.attribute (Html.Attributes.href href)
, Selector.containing
[ Selector.tag "img"
, Selector.attribute (Html.Attributes.alt linkText)
]
]
)
]

normalClick =
( "click"
Expand All @@ -1039,63 +1069,53 @@ clickLink linkText href programTest =
]
)

respondsTo event single =
single
|> Test.Html.Event.simulate event
|> Test.Html.Event.toResult
|> Result.Extra.isOk

tryClicking :
{ otherwise :
Program model msg effect (SimulatedSub msg)
-> TestState model msg effect
-> Result Failure (TestState model msg effect)
}
-> ProgramTest model msg effect
-> ProgramTest model msg effect
tryClicking { otherwise } =
andThen <|
\program state ->
let
link =
Program.renderView program state.currentModel
|> Query.find findLinkTag
in
if respondsTo normalClick link then
-- there is a click handler
-- first make sure the handler properly respects "Open in new tab", etc
if respondsTo ctrlClick link || respondsTo metaClick link then
Err
(CustomFailure functionDescription
(String.concat
[ "Found an `<a href=\"...\">` tag has an onClick handler, "
, "but the handler is overriding ctrl-click and meta-click.\n\n"
, "A properly behaved single-page app should not override ctrl- and meta-clicks on `<a>` tags "
, "because this prevents users from opening links in new tabs/windows.\n\n"
, "Use `onClickPreventDefaultForLinkWithHref` defined at <https://gist.github.com/avh4/712d43d649b7624fab59285a70610707> instead of `onClick` to fix this problem.\n\n"
, "See discussion of this issue at <https://github.com/elm-lang/navigation/issues/13>."
]
)
)

else
-- everything looks good, so simulate that event and ignore the `href`
simulateHelper functionDescription (Query.find findLinkTag) normalClick program state

else
-- the link doesn't have a click handler
otherwise program state
-> Query.Single msg
-> Program model msg effect (SimulatedSub msg)
-> TestState model msg effect
-> Result Failure (TestState model msg effect)
tryClicking { otherwise } single program state =
if respondsTo normalClick single then
-- there is a click handler
-- first make sure the handler properly respects "Open in new tab", etc
if respondsTo ctrlClick single || respondsTo metaClick single then
Err
(CustomFailure functionDescription
(String.concat
[ "Found an `<a href=\"...\">` tag has an onClick handler, "
, "but the handler is overriding ctrl-click and meta-click.\n\n"
, "A properly behaved single-page app should not override ctrl- and meta-clicks on `<a>` tags "
, "because this prevents users from opening links in new tabs/windows.\n\n"
, "Use `onClickPreventDefaultForLinkWithHref` defined at <https://gist.github.com/avh4/712d43d649b7624fab59285a70610707> instead of `onClick` to fix this problem.\n\n"
, "See discussion of this issue at <https://github.com/elm-lang/navigation/issues/13>."
]
)
)

respondsTo event single =
case
single
|> Test.Html.Event.simulate event
|> Test.Html.Event.toResult
of
Err _ ->
False
else
-- everything looks good, so simulate that event and ignore the `href`
single
|> Test.Html.Event.simulate normalClick
|> Test.Html.Event.toResult
|> Result.mapError (SimulateFailed functionDescription)
|> Result.andThen (\msg -> TestState.update msg program state)

Ok _ ->
True
else
-- the link doesn't have a click handler
otherwise program state
in
programTest
|> assertComplexQuery functionDescription
(ComplexQuery.find Nothing [ "a" ] findLinkTag)
|> tryClicking { otherwise = TestState.urlRequestHelper functionDescription href }
runComplexQuery functionDescription findLink (tryClicking { otherwise = TestState.urlRequestHelper functionDescription href })


{-| Simulates replacing the text in an input field labeled with the given label.
Expand Down
13 changes: 2 additions & 11 deletions src/ProgramTest/ComplexQuery.elm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@ module ProgramTest.ComplexQuery exposing (ComplexQuery, Failure(..), FailureCont
import Json.Encode as Json
import ProgramTest.TestHtmlHacks as TestHtmlHacks
import ProgramTest.TestHtmlParser as TestHtmlParser
import Result.Extra
import Set exposing (Set)
import Test.Html.Event
import Test.Html.Query as Query
Expand Down Expand Up @@ -356,14 +357,4 @@ firstErrorOf source choices =

countSuccesses : List (Result String String) -> Int
countSuccesses results =
List.length (List.filter isOk results)


isOk : Result x a -> Bool
isOk result =
case result of
Ok _ ->
True

Err _ ->
False
List.length (List.filter Result.Extra.isOk results)
11 changes: 11 additions & 0 deletions src/Result/Extra.elm
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
module Result.Extra exposing (isOk)


isOk : Result x a -> Bool
isOk result =
case result of
Ok _ ->
True

Err _ ->
False
16 changes: 16 additions & 0 deletions tests/ProgramTestTests/UserInput/ClickLinkTest.elm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -34,6 +34,12 @@ linkProgram =
Html.div []
[ Html.a [ href "https://example.com/link" ] [ Html.text "External" ]
, Html.a [ href "/settings" ] [ Html.text "Relative" ]
, Html.a
[ href "https://example.com/link"
, Html.Attributes.attribute "aria-label" "Aria"
]
[]
, Html.a [ href "https://example.com/link" ] [ Html.img [ Html.Attributes.alt "Alt Text" ] [] ]
]
}
|> ProgramTest.withBaseUrl "http://localhost:3000/Main.elm"
Expand All @@ -48,6 +54,16 @@ all =
linkProgram
|> ProgramTest.clickLink "External" "https://example.com/link"
|> ProgramTest.expectPageChange "https://example.com/link"
, test "can verify a link with aria-label" <|
\() ->
linkProgram
|> ProgramTest.clickLink "Aria" "https://example.com/link"
|> ProgramTest.expectPageChange "https://example.com/link"
, test "can verify a link with img and alt text" <|
\() ->
linkProgram
|> ProgramTest.clickLink "Alt Text" "https://example.com/link"
|> ProgramTest.expectPageChange "https://example.com/link"
Comment on lines +57 to +66
Copy link
Owner

@avh4 avh4 Jul 30, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

💯

, test "can verify a relative link" <|
\() ->
linkProgram
Expand Down