github.com/pf-qiu/concourse/v6@v6.7.3-0.20201207032516-1f455d73275f/web/elm/tests/DragAndDropTests.elm (about) 1 module DragAndDropTests exposing (all) 2 3 import Application.Application as Application 4 import Common exposing (given, then_, when) 5 import DashboardTests exposing (whenOnDashboard) 6 import Data 7 import Dict exposing (Dict) 8 import Expect exposing (Expectation) 9 import Http 10 import Json.Encode as Encode 11 import Message.Callback as Callback 12 import Message.Effects as Effects 13 import Message.Message as Message exposing (DropTarget(..)) 14 import Message.Subscription exposing (Delivery(..), Interval(..)) 15 import Message.TopLevelMessage as TopLevelMessage exposing (TopLevelMessage) 16 import Test exposing (Test, describe, test) 17 import Test.Html.Event as Event 18 import Test.Html.Query as Query 19 import Test.Html.Selector exposing (class, id, style, text) 20 import Time 21 import Url 22 23 24 all : Test 25 all = 26 describe "dragging and dropping pipeline cards" 27 [ test "pipeline card has dragstart listener" <| 28 given iVisitedTheDashboard 29 >> given myBrowserFetchedOnePipeline 30 >> when iAmLookingAtTheFirstPipelineCard 31 >> then_ itListensForDragStart 32 , test "pipeline card disappears when dragging starts" <| 33 given iVisitedTheDashboard 34 >> given myBrowserFetchedOnePipeline 35 >> given iAmDraggingTheFirstPipelineCard 36 >> when iAmLookingAtTheFirstPipelineCard 37 >> then_ itIsInvisible 38 , test "pipeline cards wrappers transition their transform when dragging" <| 39 given iVisitedTheDashboard 40 >> given myBrowserFetchedOnePipeline 41 >> given iAmDraggingTheFirstPipelineCard 42 >> when iAmLookingAtTheFirstPipelineCardWrapper 43 >> then_ itHasTransformTransition 44 , test "final drop area has dragenter listener" <| 45 given iVisitedTheDashboard 46 >> given myBrowserFetchedOnePipeline 47 >> when iAmLookingAtTheFinalDropArea 48 >> then_ itListensForDragEnter 49 , test "final drop area has dragover listener (should prevent default)" <| 50 given iVisitedTheDashboard 51 >> given myBrowserFetchedOnePipeline 52 >> when iAmLookingAtTheFinalDropArea 53 >> then_ itListensForDragOverPreventingDefault 54 , test "pipeline card has dragend listener" <| 55 given iVisitedTheDashboard 56 >> given myBrowserFetchedOnePipeline 57 >> given iAmDraggingTheFirstPipelineCard 58 >> when iAmLookingAtTheFirstPipelineCard 59 >> then_ itListensForDragEnd 60 , test "pipeline card becomes visible when it is dropped" <| 61 given iVisitedTheDashboard 62 >> given myBrowserFetchedOnePipeline 63 >> given iAmDraggingTheFirstPipelineCard 64 >> given iDropThePipelineCard 65 >> when iAmLookingAtTheFirstPipelineCard 66 >> then_ itIsVisible 67 , test "dropping first pipeline card on final drop area rearranges cards" <| 68 given iVisitedTheDashboard 69 >> given myBrowserFetchedTwoPipelines 70 >> given iAmDraggingTheFirstPipelineCard 71 >> given iAmDraggingOverTheThirdDropArea 72 >> given iDropThePipelineCard 73 >> when iAmLookingAtTheFirstPipelineCard 74 >> then_ itIsTheOtherPipelineCard 75 , test "dropping first pipeline card on final drop area makes API call" <| 76 given iVisitedTheDashboard 77 >> given myBrowserFetchedTwoPipelines 78 >> given iAmDraggingTheFirstPipelineCard 79 >> given iAmDraggingOverTheThirdDropArea 80 >> when iDropThePipelineCard 81 >> then_ myBrowserMakesTheOrderPipelinesAPICall 82 , test "API call only orders pipelines on a single team" <| 83 given iVisitedTheDashboard 84 >> given myBrowserFetchedPipelinesFromMultipleTeams 85 >> given iAmDraggingTheFirstPipelineCard 86 >> given iAmDraggingOverTheThirdDropArea 87 >> when iDropThePipelineCard 88 >> then_ myBrowserMakesTheOrderPipelinesAPICall 89 , test "dashboard does not auto-refresh during dragging" <| 90 given iVisitedTheDashboard 91 >> given myBrowserFetchedPipelinesFromMultipleTeams 92 >> given iAmDraggingTheFirstPipelineCard 93 >> when fiveSecondsPasses 94 >> then_ myBrowserDoesNotRequestPipelineData 95 , test "dropping a card displays a spinner near the pipeline team name" <| 96 given iVisitedTheDashboard 97 >> given myBrowserFetchedTwoPipelines 98 >> given iAmDraggingTheFirstPipelineCard 99 >> given iAmDraggingOverTheThirdDropArea 100 >> given iDropThePipelineCard 101 >> when iAmLookingAtTheTeamHeader 102 >> then_ iSeeASpinner 103 , test "dropping a card does not display a spinner near other team names" <| 104 given iVisitedTheDashboard 105 >> given myBrowserFetchedPipelinesFromMultipleTeams 106 >> given iAmDraggingTheFirstPipelineCard 107 >> given iAmDraggingOverTheThirdDropArea 108 >> given iDropThePipelineCard 109 >> when iAmLookingAtTheOtherTeamHeader 110 >> then_ iDoNotSeeASpinner 111 , test "after dropping a card, every pipeline card of that team has opacity 0.5" <| 112 given iVisitedTheDashboard 113 >> given myBrowserFetchedTwoPipelines 114 >> given iAmDraggingTheFirstPipelineCard 115 >> given iAmDraggingOverTheThirdDropArea 116 >> given iDropThePipelineCard 117 >> when iAmLookingAtAllPipelineCardsOfThatTeam 118 >> then_ iSeeAllCardsHaveOpacity 119 , test "after dropping a card, every pipeline card of that team is disabled" <| 120 given iVisitedTheDashboard 121 >> given myBrowserFetchedTwoPipelines 122 >> given iAmDraggingTheFirstPipelineCard 123 >> given iAmDraggingOverTheThirdDropArea 124 >> given iDropThePipelineCard 125 >> when iAmLookingAtAllPipelineCardsOfThatTeam 126 >> then_ theyAreNotClickable 127 , test "fetches team's pipelines when order pipelines call succeeds" <| 128 given iVisitedTheDashboard 129 >> given myBrowserFetchedTwoPipelines 130 >> given iAmDraggingTheFirstPipelineCard 131 >> given iAmDraggingOverTheThirdDropArea 132 >> given iDropThePipelineCard 133 >> when orderPipelinesSucceeds 134 >> then_ myBrowserMakesTheFetchPipelinesAPICall 135 , test "when dropping succeeds the spinner disappears" <| 136 given iVisitedTheDashboard 137 >> given myBrowserFetchedTwoPipelines 138 >> given iAmDraggingTheFirstPipelineCard 139 >> given iAmDraggingOverTheThirdDropArea 140 >> given iDropThePipelineCard 141 >> given dashboardRefreshPipelines 142 >> when iAmLookingAtTheTeamHeader 143 >> then_ iDoNotSeeASpinner 144 , test "when dropping succeeds all pipeline cards of that team have opacity of 1" <| 145 given iVisitedTheDashboard 146 >> given myBrowserFetchedTwoPipelines 147 >> given iAmDraggingTheFirstPipelineCard 148 >> given iAmDraggingOverTheThirdDropArea 149 >> given iDropThePipelineCard 150 >> given dashboardRefreshPipelines 151 >> when iAmLookingAtAllPipelineCardsOfThatTeam 152 >> then_ iSeeAllCardsDontHaveOpacity 153 , test "when dropping succeeds, every pipeline card of that team is enabled" <| 154 given iVisitedTheDashboard 155 >> given myBrowserFetchedTwoPipelines 156 >> given iAmDraggingTheFirstPipelineCard 157 >> given iAmDraggingOverTheThirdDropArea 158 >> given iDropThePipelineCard 159 >> given dashboardRefreshPipelines 160 >> when iAmLookingAtAllPipelineCardsOfThatTeam 161 >> then_ theyAreClickable 162 , test "fetches team's pipelines when order pipelines call fails" <| 163 given iVisitedTheDashboard 164 >> given myBrowserFetchedTwoPipelines 165 >> given iAmDraggingTheFirstPipelineCard 166 >> given iAmDraggingOverTheThirdDropArea 167 >> given iDropThePipelineCard 168 >> when orderPipelinesFails 169 >> then_ myBrowserMakesTheFetchPipelinesAPICall 170 ] 171 172 173 iVisitedTheDashboard _ = 174 whenOnDashboard { highDensity = False } 175 176 177 myBrowserFetchedOnePipeline = 178 Application.handleCallback 179 (Callback.AllPipelinesFetched <| 180 Ok 181 [ Data.pipeline "team" 0 |> Data.withName "pipeline" ] 182 ) 183 184 185 myBrowserFetchedTwoPipelines = 186 Application.handleCallback 187 (Callback.AllPipelinesFetched <| 188 Ok 189 [ Data.pipeline "team" 0 |> Data.withName "pipeline" 190 , Data.pipeline "team" 1 |> Data.withName "other-pipeline" 191 ] 192 ) 193 194 195 myBrowserFetchedPipelinesFromMultipleTeams = 196 Application.handleCallback 197 (Callback.AllPipelinesFetched <| 198 Ok 199 [ Data.pipeline "team" 0 |> Data.withName "pipeline" 200 , Data.pipeline "team" 1 |> Data.withName "other-pipeline" 201 , Data.pipeline "other-team" 2 |> Data.withName "third-pipeline" 202 ] 203 ) 204 205 206 iAmLookingAtTheFirstPipelineCard = 207 Tuple.first 208 >> Common.queryView 209 >> Query.findAll [ class "card" ] 210 >> Query.first 211 212 213 iAmLookingAtTheFirstPipelineCardWrapper = 214 Tuple.first 215 >> Common.queryView 216 >> Query.findAll [ class "pipeline-wrapper" ] 217 >> Query.first 218 219 220 iAmLookingAtTheInitialDropArea = 221 Tuple.first 222 >> Common.queryView 223 >> Query.findAll [ class "drop-area" ] 224 >> Query.first 225 226 227 iAmLookingAtAllPipelineCardsOfThatTeam = 228 Tuple.first 229 >> Common.queryView 230 >> Query.find [ id "team" ] 231 >> Query.findAll [ class "card" ] 232 233 234 itListensForDragStart : Query.Single TopLevelMessage -> Expectation 235 itListensForDragStart = 236 Event.simulate (Event.custom "dragstart" (Encode.object [])) 237 >> Event.expect 238 (TopLevelMessage.Update <| Message.DragStart "team" "pipeline") 239 240 241 iAmDraggingTheFirstPipelineCard = 242 Tuple.first 243 >> Application.update 244 (TopLevelMessage.Update <| Message.DragStart "team" "pipeline") 245 246 247 itIsInvisible = 248 Query.has 249 [ style "width" "0" 250 , style "margin" "0 12.5px" 251 , style "overflow" "hidden" 252 ] 253 254 255 itIsVisible = 256 Query.hasNot 257 [ style "width" "0" 258 , style "margin" "0 12.5px" 259 , style "overflow" "hidden" 260 ] 261 262 263 itHasTransformTransition = 264 Query.has [ style "transition" "transform 0.2s ease-in-out" ] 265 266 267 theyAreClickable = 268 Query.each (Query.hasNot [ style "pointer-events" "none" ]) 269 270 271 theyAreNotClickable = 272 Query.each (Query.has [ style "pointer-events" "none" ]) 273 274 275 iAmLookingAtTheFinalDropArea = 276 Tuple.first 277 >> Common.queryView 278 >> Query.findAll [ class "drop-area" ] 279 >> Query.index -1 280 281 282 itListensForDragEnter = 283 Event.simulate (Event.custom "dragenter" (Encode.object [])) 284 >> Event.expect 285 (TopLevelMessage.Update <| Message.DragOver <| After "pipeline") 286 287 288 289 -- https://github.com/elm-explorations/test/pull/80 has been merged, but has 290 -- not yet been released. Until then we can only test that a dragover listener 291 -- is registered, but not that it actually has preventDefault: true. 292 -- TODO: once a new minor version of elm-exploration/test is released, change 293 -- `expect` to `expectPreventDefault` below. 294 295 296 itListensForDragOverPreventingDefault = 297 Event.simulate (Event.custom "dragover" (Encode.object [])) 298 >> Event.expect 299 (TopLevelMessage.Update <| Message.DragOver <| After "pipeline") 300 301 302 iAmDraggingOverTheThirdDropArea = 303 Tuple.first 304 >> Application.update 305 (TopLevelMessage.Update <| Message.DragOver <| After "other-pipeline") 306 307 308 iAmLookingAtTheTeamHeader = 309 Tuple.first 310 >> Common.queryView 311 >> Query.find [ class "dashboard-team-header" ] 312 313 314 iAmLookingAtTheOtherTeamHeader = 315 Tuple.first 316 >> Common.queryView 317 >> Query.find [ id "other-team" ] 318 >> Query.find [ class "dashboard-team-header" ] 319 320 321 iSeeASpinner = 322 Query.has 323 [ style "animation" 324 "container-rotate 1568ms linear infinite" 325 ] 326 327 328 iSeeAllCardsHaveOpacity = 329 Query.each (Query.has [ style "opacity" "0.5" ]) 330 331 332 iDoNotSeeASpinner = 333 Query.hasNot 334 [ style "animation" 335 "container-rotate 1568ms linear infinite" 336 ] 337 338 339 iSeeAllCardsDontHaveOpacity = 340 Query.each (Query.has [ style "opacity" "1" ]) 341 342 343 itListensForDragEnd = 344 Event.simulate (Event.custom "dragend" (Encode.object [])) 345 >> Event.expect 346 (TopLevelMessage.Update <| Message.DragEnd) 347 348 349 iDropThePipelineCard = 350 Tuple.first 351 >> Application.update 352 (TopLevelMessage.Update <| Message.DragEnd) 353 354 355 itIsTheOtherPipelineCard = 356 Query.has [ text "other-pipeline" ] 357 358 359 myBrowserMakesTheOrderPipelinesAPICall = 360 Tuple.second 361 >> Common.contains 362 (Effects.SendOrderPipelinesRequest "team" 363 [ "other-pipeline", "pipeline" ] 364 ) 365 366 367 myBrowserMakesTheFetchPipelinesAPICall = 368 Tuple.second 369 >> Common.contains 370 (Effects.FetchPipelines "team") 371 372 373 orderPipelinesSucceeds = 374 Tuple.first 375 >> Application.handleCallback 376 (Callback.PipelinesOrdered "team" <| Ok ()) 377 378 379 orderPipelinesFails = 380 Tuple.first 381 >> Application.handleCallback 382 (Callback.PipelinesOrdered "team" <| Data.httpInternalServerError) 383 384 385 dashboardRefreshPipelines = 386 Tuple.first 387 >> Application.handleCallback 388 (Callback.PipelinesFetched <| 389 Ok 390 [ Data.pipeline "team" 0 |> Data.withName "pipeline" 391 , Data.pipeline "team" 1 |> Data.withName "other-pipeline" 392 ] 393 ) 394 395 396 dashboardFailsToRefreshPipelines = 397 Tuple.first 398 >> Application.handleCallback 399 (Callback.PipelinesFetched <| Data.httpInternalServerError) 400 401 402 fiveSecondsPasses = 403 Tuple.first 404 >> Application.handleDelivery 405 (ClockTicked FiveSeconds <| Time.millisToPosix 0) 406 407 408 myBrowserDoesNotRequestPipelineData = 409 Tuple.second >> Common.notContains Effects.FetchAllPipelines