diff --git a/src/ProgramTest.elm b/src/ProgramTest.elm
index bea2279..69ae2c8 100644
--- a/src/ProgramTest.elm
+++ b/src/ProgramTest.elm
@@ -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
@@ -760,10 +761,18 @@ 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
@@ -771,27 +780,23 @@ simulateComplexQuery functionName complexQuery =
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.
@@ -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"
+ [ ( " with text"
+ , ComplexQuery.find (Just "find link")
+ [ "a" ]
+ [ Selector.tag "a"
+ , Selector.attribute (Html.Attributes.href href)
+ , Selector.containing [ Selector.text linkText ]
+ ]
+ )
+ , ( " 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)
+ ]
+ )
+ , ( " with ![]()
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"
@@ -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 `` 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 `` tags "
- , "because this prevents users from opening links in new tabs/windows.\n\n"
- , "Use `onClickPreventDefaultForLinkWithHref` defined at instead of `onClick` to fix this problem.\n\n"
- , "See discussion of this issue at ."
- ]
- )
- )
-
- 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 `` 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 `` tags "
+ , "because this prevents users from opening links in new tabs/windows.\n\n"
+ , "Use `onClickPreventDefaultForLinkWithHref` defined at instead of `onClick` to fix this problem.\n\n"
+ , "See discussion of this issue at ."
+ ]
+ )
+ )
- 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.
diff --git a/src/ProgramTest/ComplexQuery.elm b/src/ProgramTest/ComplexQuery.elm
index fed8d67..8defc05 100644
--- a/src/ProgramTest/ComplexQuery.elm
+++ b/src/ProgramTest/ComplexQuery.elm
@@ -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
@@ -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)
diff --git a/src/Result/Extra.elm b/src/Result/Extra.elm
new file mode 100644
index 0000000..d36599c
--- /dev/null
+++ b/src/Result/Extra.elm
@@ -0,0 +1,11 @@
+module Result.Extra exposing (isOk)
+
+
+isOk : Result x a -> Bool
+isOk result =
+ case result of
+ Ok _ ->
+ True
+
+ Err _ ->
+ False
diff --git a/tests/ProgramTestTests/UserInput/ClickLinkTest.elm b/tests/ProgramTestTests/UserInput/ClickLinkTest.elm
index 52bcd11..93e4a46 100644
--- a/tests/ProgramTestTests/UserInput/ClickLinkTest.elm
+++ b/tests/ProgramTestTests/UserInput/ClickLinkTest.elm
@@ -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"
@@ -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"
, test "can verify a relative link" <|
\() ->
linkProgram