github.com/pf-qiu/concourse/v6@v6.7.3-0.20201207032516-1f455d73275f/web/elm/src/Message/Effects.elm (about) 1 port module Message.Effects exposing 2 ( Effect(..) 3 , pipelinesSectionName 4 , renderPipeline 5 , renderSvgIcon 6 , runEffect 7 , stickyHeaderConfig 8 , toHtmlID 9 ) 10 11 import Api 12 import Api.Endpoints as Endpoints 13 import Assets 14 import Base64 15 import Browser.Dom exposing (Viewport, getElement, getViewport, getViewportOf, setViewportOf) 16 import Browser.Navigation as Navigation 17 import Concourse exposing (DatabaseID, encodeJob, encodePipeline, encodeTeam) 18 import Concourse.BuildStatus exposing (BuildStatus) 19 import Concourse.Pagination exposing (Page) 20 import Json.Decode 21 import Json.Encode 22 import Maybe exposing (Maybe) 23 import Message.Callback exposing (Callback(..)) 24 import Message.Message 25 exposing 26 ( DomID(..) 27 , PipelinesSection(..) 28 , VersionToggleAction(..) 29 , VisibilityAction(..) 30 ) 31 import Message.ScrollDirection exposing (ScrollDirection(..)) 32 import Message.Storage 33 exposing 34 ( deleteFromLocalStorage 35 , favoritedPipelinesKey 36 , jobsKey 37 , loadFromLocalStorage 38 , loadFromSessionStorage 39 , pipelinesKey 40 , saveToLocalStorage 41 , saveToSessionStorage 42 , sideBarStateKey 43 , teamsKey 44 , tokenKey 45 ) 46 import Process 47 import Routes 48 import Set exposing (Set) 49 import SideBar.State exposing (SideBarState, encodeSideBarState) 50 import Task 51 import Time 52 import Views.Styles 53 54 55 port renderPipeline : ( Json.Encode.Value, Json.Encode.Value ) -> Cmd msg 56 57 58 port pinTeamNames : StickyHeaderConfig -> Cmd msg 59 60 61 port tooltip : ( String, String ) -> Cmd msg 62 63 64 port tooltipHd : ( String, String ) -> Cmd msg 65 66 67 port resetPipelineFocus : () -> Cmd msg 68 69 70 port requestLoginRedirect : String -> Cmd msg 71 72 73 port openEventStream : { url : String, eventTypes : List String } -> Cmd msg 74 75 76 port closeEventStream : () -> Cmd msg 77 78 79 port checkIsVisible : String -> Cmd msg 80 81 82 port setFavicon : String -> Cmd msg 83 84 85 port rawHttpRequest : String -> Cmd msg 86 87 88 port renderSvgIcon : String -> Cmd msg 89 90 91 port syncTextareaHeight : String -> Cmd msg 92 93 94 port syncStickyBuildLogHeaders : () -> Cmd msg 95 96 97 port scrollToId : ( String, String ) -> Cmd msg 98 99 100 type alias StickyHeaderConfig = 101 { pageHeaderHeight : Float 102 , pageBodyClass : String 103 , sectionHeaderClass : String 104 , sectionClass : String 105 , sectionBodyClass : String 106 } 107 108 109 type alias DatabaseID = 110 Int 111 112 113 stickyHeaderConfig : StickyHeaderConfig 114 stickyHeaderConfig = 115 { pageHeaderHeight = Views.Styles.pageHeaderHeight 116 , pageBodyClass = "dashboard" 117 , sectionClass = "dashboard-team-group" 118 , sectionHeaderClass = "dashboard-team-header" 119 , sectionBodyClass = "dashboard-team-pipelines" 120 } 121 122 123 type Effect 124 = FetchJob Concourse.JobIdentifier 125 | FetchJobs Concourse.PipelineIdentifier 126 | FetchJobBuilds Concourse.JobIdentifier Page 127 | FetchResource Concourse.ResourceIdentifier 128 | FetchCheck Int 129 | FetchVersionedResources Concourse.ResourceIdentifier Page 130 | FetchResources Concourse.PipelineIdentifier 131 | FetchBuildResources Concourse.BuildId 132 | FetchPipeline Concourse.PipelineIdentifier 133 | FetchPipelines String 134 | FetchClusterInfo 135 | FetchInputTo Concourse.VersionedResourceIdentifier 136 | FetchOutputOf Concourse.VersionedResourceIdentifier 137 | FetchAllTeams 138 | FetchUser 139 | FetchBuild Float Int 140 | FetchJobBuild Concourse.JobBuildIdentifier 141 | FetchBuildJobDetails Concourse.JobIdentifier 142 | FetchBuildHistory Concourse.JobIdentifier (Maybe Page) 143 | FetchBuildPrep Float Int 144 | FetchBuildPlan Concourse.BuildId 145 | FetchBuildPlanAndResources Concourse.BuildId 146 | FetchAllPipelines 147 | FetchAllResources 148 | FetchAllJobs 149 | GetCurrentTime 150 | GetCurrentTimeZone 151 | DoTriggerBuild Concourse.JobIdentifier 152 | RerunJobBuild Concourse.JobBuildIdentifier 153 | DoAbortBuild Int 154 | PauseJob Concourse.JobIdentifier 155 | UnpauseJob Concourse.JobIdentifier 156 | ResetPipelineFocus 157 | RenderPipeline (List Concourse.Job) (List Concourse.Resource) 158 | RedirectToLogin 159 | LoadExternal String 160 | NavigateTo String 161 | ModifyUrl String 162 | DoPinVersion Concourse.VersionedResourceIdentifier 163 | DoUnpinVersion Concourse.ResourceIdentifier 164 | DoToggleVersion VersionToggleAction VersionId 165 | DoCheck Concourse.ResourceIdentifier 166 | SetPinComment Concourse.ResourceIdentifier String 167 | SendTokenToFly String Int 168 | SendTogglePipelineRequest Concourse.PipelineIdentifier Bool 169 | ShowTooltip ( String, String ) 170 | ShowTooltipHd ( String, String ) 171 | SendOrderPipelinesRequest String (List String) 172 | SendLogOutRequest 173 | GetScreenSize 174 | PinTeamNames StickyHeaderConfig 175 | Scroll ScrollDirection String 176 | SetFavIcon (Maybe BuildStatus) 177 | OpenBuildEventStream { url : String, eventTypes : List String } 178 | CloseBuildEventStream 179 | CheckIsVisible String 180 | Focus String 181 | Blur String 182 | RenderSvgIcon String 183 | ChangeVisibility VisibilityAction Concourse.PipelineIdentifier 184 | SaveToken String 185 | LoadToken 186 | SaveSideBarState SideBarState 187 | LoadSideBarState 188 | SaveCachedJobs (List Concourse.Job) 189 | LoadCachedJobs 190 | DeleteCachedJobs 191 | SaveCachedPipelines (List Concourse.Pipeline) 192 | LoadCachedPipelines 193 | DeleteCachedPipelines 194 | SaveCachedTeams (List Concourse.Team) 195 | LoadCachedTeams 196 | DeleteCachedTeams 197 | GetViewportOf DomID 198 | GetElement DomID 199 | SyncTextareaHeight DomID 200 | SyncStickyBuildLogHeaders 201 | SaveFavoritedPipelines (Set DatabaseID) 202 | LoadFavoritedPipelines 203 204 205 type alias VersionId = 206 Concourse.VersionedResourceIdentifier 207 208 209 runEffect : Effect -> Navigation.Key -> Concourse.CSRFToken -> Cmd Callback 210 runEffect effect key csrfToken = 211 case effect of 212 FetchJob id -> 213 Api.get (Endpoints.BaseJob |> Endpoints.Job id) 214 |> Api.expectJson Concourse.decodeJob 215 |> Api.request 216 |> Task.attempt JobFetched 217 218 FetchJobs id -> 219 Api.get 220 (Endpoints.PipelineJobsList |> Endpoints.Pipeline id) 221 |> Api.expectJson (Json.Decode.list Concourse.decodeJob) 222 |> Api.request 223 |> Task.attempt JobsFetched 224 225 FetchJobBuilds id page -> 226 Api.paginatedGet 227 (Endpoints.JobBuildsList |> Endpoints.Job id) 228 (Just page) 229 Concourse.decodeBuild 230 |> Api.request 231 |> Task.map (\b -> ( page, b )) 232 |> Task.attempt JobBuildsFetched 233 234 FetchResource id -> 235 Api.get (Endpoints.BaseResource |> Endpoints.Resource id) 236 |> Api.expectJson Concourse.decodeResource 237 |> Api.request 238 |> Task.attempt ResourceFetched 239 240 FetchCheck id -> 241 Api.get (Endpoints.Build id Endpoints.BaseBuild) 242 |> Api.expectJson Concourse.decodeBuild 243 |> Api.request 244 |> Task.attempt Checked 245 246 FetchVersionedResources id page -> 247 Api.paginatedGet 248 (Endpoints.ResourceVersionsList |> Endpoints.Resource id) 249 (Just page) 250 Concourse.decodeVersionedResource 251 |> Api.request 252 |> Task.map (\b -> ( page, b )) 253 |> Task.attempt VersionedResourcesFetched 254 255 FetchResources id -> 256 Api.get 257 (Endpoints.PipelineResourcesList |> Endpoints.Pipeline id) 258 |> Api.expectJson (Json.Decode.list Concourse.decodeResource) 259 |> Api.request 260 |> Task.attempt ResourcesFetched 261 262 FetchBuildResources id -> 263 Api.get 264 (Endpoints.BuildResourcesList |> Endpoints.Build id) 265 |> Api.expectJson Concourse.decodeBuildResources 266 |> Api.request 267 |> Task.map (\b -> ( id, b )) 268 |> Task.attempt BuildResourcesFetched 269 270 FetchPipeline id -> 271 Api.get (Endpoints.BasePipeline |> Endpoints.Pipeline id) 272 |> Api.expectJson Concourse.decodePipeline 273 |> Api.request 274 |> Task.attempt PipelineFetched 275 276 FetchPipelines team -> 277 Api.get (Endpoints.TeamPipelinesList |> Endpoints.Team team) 278 |> Api.expectJson (Json.Decode.list Concourse.decodePipeline) 279 |> Api.request 280 |> Task.attempt PipelinesFetched 281 282 FetchAllResources -> 283 Api.get Endpoints.ResourcesList 284 |> Api.expectJson 285 (Json.Decode.nullable <| 286 Json.Decode.list Concourse.decodeResource 287 ) 288 |> Api.request 289 |> Task.map (Maybe.withDefault []) 290 |> Task.attempt AllResourcesFetched 291 292 FetchAllJobs -> 293 Api.get Endpoints.JobsList 294 |> Api.expectJson 295 (Json.Decode.nullable <| 296 Json.Decode.list Concourse.decodeJob 297 ) 298 |> Api.request 299 |> Task.map (Maybe.withDefault []) 300 |> Task.attempt AllJobsFetched 301 302 FetchClusterInfo -> 303 Api.get Endpoints.ClusterInfo 304 |> Api.expectJson Concourse.decodeInfo 305 |> Api.request 306 |> Task.attempt ClusterInfoFetched 307 308 FetchInputTo id -> 309 Api.get 310 (Endpoints.ResourceVersionInputTo |> Endpoints.ResourceVersion id) 311 |> Api.expectJson (Json.Decode.list Concourse.decodeBuild) 312 |> Api.request 313 |> Task.map (\b -> ( id, b )) 314 |> Task.attempt InputToFetched 315 316 FetchOutputOf id -> 317 Api.get 318 (Endpoints.ResourceVersionOutputOf |> Endpoints.ResourceVersion id) 319 |> Api.expectJson (Json.Decode.list Concourse.decodeBuild) 320 |> Api.request 321 |> Task.map (\b -> ( id, b )) 322 |> Task.attempt OutputOfFetched 323 324 FetchAllTeams -> 325 Api.get Endpoints.TeamsList 326 |> Api.expectJson (Json.Decode.list Concourse.decodeTeam) 327 |> Api.request 328 |> Task.attempt AllTeamsFetched 329 330 FetchAllPipelines -> 331 Api.get Endpoints.PipelinesList 332 |> Api.expectJson (Json.Decode.list Concourse.decodePipeline) 333 |> Api.request 334 |> Task.attempt AllPipelinesFetched 335 336 GetCurrentTime -> 337 Task.perform GotCurrentTime Time.now 338 339 GetCurrentTimeZone -> 340 Task.perform GotCurrentTimeZone Time.here 341 342 DoTriggerBuild id -> 343 Api.post 344 (Endpoints.JobBuildsList |> Endpoints.Job id) 345 csrfToken 346 |> Api.expectJson Concourse.decodeBuild 347 |> Api.request 348 |> Task.attempt BuildTriggered 349 350 RerunJobBuild id -> 351 Api.post (Endpoints.JobBuild id) csrfToken 352 |> Api.expectJson Concourse.decodeBuild 353 |> Api.request 354 |> Task.attempt BuildTriggered 355 356 PauseJob id -> 357 Api.put 358 (Endpoints.PauseJob |> Endpoints.Job id) 359 csrfToken 360 |> Api.request 361 |> Task.attempt PausedToggled 362 363 UnpauseJob id -> 364 Api.put 365 (Endpoints.UnpauseJob |> Endpoints.Job id) 366 csrfToken 367 |> Api.request 368 |> Task.attempt PausedToggled 369 370 RedirectToLogin -> 371 requestLoginRedirect "" 372 373 LoadExternal url -> 374 Navigation.load url 375 376 NavigateTo url -> 377 Navigation.pushUrl key url 378 379 ModifyUrl url -> 380 Navigation.replaceUrl key url 381 382 ResetPipelineFocus -> 383 resetPipelineFocus () 384 385 RenderPipeline jobs resources -> 386 renderPipeline 387 ( Json.Encode.list Concourse.encodeJob jobs 388 , Json.Encode.list Concourse.encodeResource resources 389 ) 390 391 DoPinVersion id -> 392 Api.put 393 (Endpoints.PinResourceVersion |> Endpoints.ResourceVersion id) 394 csrfToken 395 |> Api.request 396 |> Task.attempt VersionPinned 397 398 DoUnpinVersion id -> 399 Api.put 400 (Endpoints.UnpinResource |> Endpoints.Resource id) 401 csrfToken 402 |> Api.request 403 |> Task.attempt VersionUnpinned 404 405 DoToggleVersion action id -> 406 let 407 endpoint = 408 Endpoints.ResourceVersion id <| 409 case action of 410 Enable -> 411 Endpoints.EnableResourceVersion 412 413 Disable -> 414 Endpoints.DisableResourceVersion 415 in 416 Api.put endpoint csrfToken 417 |> Api.request 418 |> Task.attempt (VersionToggled action id) 419 420 DoCheck rid -> 421 Api.post 422 (Endpoints.CheckResource |> Endpoints.Resource rid) 423 csrfToken 424 |> Api.withJsonBody 425 (Json.Encode.object [ ( "from", Json.Encode.null ) ]) 426 |> Api.expectJson Concourse.decodeBuild 427 |> Api.request 428 |> Task.attempt Checked 429 430 SetPinComment rid comment -> 431 Api.put 432 (Endpoints.PinResourceComment |> Endpoints.Resource rid) 433 csrfToken 434 |> Api.withJsonBody 435 (Json.Encode.object 436 [ ( "pin_comment" 437 , Json.Encode.string comment 438 ) 439 ] 440 ) 441 |> Api.request 442 |> Task.attempt CommentSet 443 444 SendTokenToFly authToken flyPort -> 445 rawHttpRequest <| Routes.tokenToFlyRoute authToken flyPort 446 447 SendTogglePipelineRequest id isPaused -> 448 let 449 endpoint = 450 Endpoints.Pipeline id <| 451 if isPaused then 452 Endpoints.UnpausePipeline 453 454 else 455 Endpoints.PausePipeline 456 in 457 Api.put endpoint csrfToken 458 |> Api.request 459 |> Task.attempt (PipelineToggled id) 460 461 ShowTooltip ( teamName, pipelineName ) -> 462 tooltip ( teamName, pipelineName ) 463 464 ShowTooltipHd ( teamName, pipelineName ) -> 465 tooltipHd ( teamName, pipelineName ) 466 467 SendOrderPipelinesRequest teamName pipelineNames -> 468 Api.put 469 (Endpoints.OrderTeamPipelines |> Endpoints.Team teamName) 470 csrfToken 471 |> Api.withJsonBody 472 (Json.Encode.list Json.Encode.string pipelineNames) 473 |> Api.request 474 |> Task.attempt (PipelinesOrdered teamName) 475 476 SendLogOutRequest -> 477 Api.get Endpoints.Logout 478 |> Api.request 479 |> Task.attempt LoggedOut 480 481 GetScreenSize -> 482 Task.perform ScreenResized getViewport 483 484 PinTeamNames shc -> 485 pinTeamNames shc 486 487 FetchBuild delay buildId -> 488 Process.sleep delay 489 |> Task.andThen 490 (always 491 (Api.get (Endpoints.BaseBuild |> Endpoints.Build buildId) 492 |> Api.expectJson Concourse.decodeBuild 493 |> Api.request 494 ) 495 ) 496 |> Task.attempt BuildFetched 497 498 FetchJobBuild jbi -> 499 Api.get (Endpoints.JobBuild jbi) 500 |> Api.expectJson Concourse.decodeBuild 501 |> Api.request 502 |> Task.attempt BuildFetched 503 504 FetchBuildJobDetails buildJob -> 505 Api.get (Endpoints.BaseJob |> Endpoints.Job buildJob) 506 |> Api.expectJson Concourse.decodeJob 507 |> Api.request 508 |> Task.attempt BuildJobDetailsFetched 509 510 FetchBuildHistory job page -> 511 Api.paginatedGet 512 (Endpoints.JobBuildsList |> Endpoints.Job job) 513 page 514 Concourse.decodeBuild 515 |> Api.request 516 |> Task.attempt BuildHistoryFetched 517 518 FetchBuildPrep delay buildId -> 519 Process.sleep delay 520 |> Task.andThen 521 (always 522 (Api.get 523 (Endpoints.BuildPrep |> Endpoints.Build buildId) 524 |> Api.expectJson Concourse.decodeBuildPrep 525 |> Api.request 526 ) 527 ) 528 |> Task.attempt (BuildPrepFetched buildId) 529 530 FetchBuildPlanAndResources buildId -> 531 Task.map2 (\a b -> ( a, b )) 532 (Api.get (Endpoints.BuildPlan |> Endpoints.Build buildId) 533 |> Api.expectJson Concourse.decodeBuildPlanResponse 534 |> Api.request 535 ) 536 (Api.get (Endpoints.BuildResourcesList |> Endpoints.Build buildId) 537 |> Api.expectJson Concourse.decodeBuildResources 538 |> Api.request 539 ) 540 |> Task.attempt (PlanAndResourcesFetched buildId) 541 542 FetchBuildPlan buildId -> 543 Api.get (Endpoints.BuildPlan |> Endpoints.Build buildId) 544 |> Api.expectJson Concourse.decodeBuildPlanResponse 545 |> Api.request 546 |> Task.map (\p -> ( p, Concourse.emptyBuildResources )) 547 |> Task.attempt (PlanAndResourcesFetched buildId) 548 549 FetchUser -> 550 Api.get Endpoints.UserInfo 551 |> Api.expectJson Concourse.decodeUser 552 |> Api.request 553 |> Task.attempt UserFetched 554 555 SetFavIcon status -> 556 status 557 |> Assets.BuildFavicon 558 |> Assets.toString 559 |> setFavicon 560 561 DoAbortBuild buildId -> 562 Api.put (Endpoints.AbortBuild |> Endpoints.Build buildId) csrfToken 563 |> Api.request 564 |> Task.attempt BuildAborted 565 566 Scroll direction id -> 567 scroll direction id 568 569 Focus id -> 570 Browser.Dom.focus id 571 |> Task.attempt (always EmptyCallback) 572 573 Blur id -> 574 Browser.Dom.blur id 575 |> Task.attempt (always EmptyCallback) 576 577 OpenBuildEventStream config -> 578 openEventStream config 579 580 CloseBuildEventStream -> 581 closeEventStream () 582 583 CheckIsVisible id -> 584 checkIsVisible id 585 586 RenderSvgIcon icon -> 587 renderSvgIcon icon 588 589 ChangeVisibility action pipelineId -> 590 let 591 endpoint = 592 Endpoints.Pipeline pipelineId <| 593 case action of 594 Hide -> 595 Endpoints.HidePipeline 596 597 Expose -> 598 Endpoints.ExposePipeline 599 in 600 Api.put endpoint csrfToken 601 |> Api.request 602 |> Task.attempt (VisibilityChanged action pipelineId) 603 604 SaveToken token -> 605 saveToLocalStorage ( tokenKey, Json.Encode.string token ) 606 607 LoadToken -> 608 loadFromLocalStorage tokenKey 609 610 SaveSideBarState state -> 611 saveToSessionStorage ( sideBarStateKey, encodeSideBarState state ) 612 613 LoadSideBarState -> 614 loadFromSessionStorage sideBarStateKey 615 616 SaveCachedJobs jobs -> 617 saveToLocalStorage ( jobsKey, jobs |> Json.Encode.list encodeJob ) 618 619 LoadCachedJobs -> 620 loadFromLocalStorage jobsKey 621 622 DeleteCachedJobs -> 623 deleteFromLocalStorage jobsKey 624 625 SaveCachedPipelines pipelines -> 626 saveToLocalStorage ( pipelinesKey, pipelines |> Json.Encode.list encodePipeline ) 627 628 LoadCachedPipelines -> 629 loadFromLocalStorage pipelinesKey 630 631 DeleteCachedPipelines -> 632 deleteFromLocalStorage pipelinesKey 633 634 SaveFavoritedPipelines pipelineIDs -> 635 saveToLocalStorage 636 ( favoritedPipelinesKey 637 , pipelineIDs |> Json.Encode.set Json.Encode.int 638 ) 639 640 LoadFavoritedPipelines -> 641 loadFromLocalStorage favoritedPipelinesKey 642 643 SaveCachedTeams teams -> 644 saveToLocalStorage ( teamsKey, teams |> Json.Encode.list encodeTeam ) 645 646 LoadCachedTeams -> 647 loadFromLocalStorage teamsKey 648 649 DeleteCachedTeams -> 650 deleteFromLocalStorage teamsKey 651 652 GetViewportOf domID -> 653 Browser.Dom.getViewportOf (toHtmlID domID) 654 |> Task.attempt (GotViewport domID) 655 656 GetElement domID -> 657 Browser.Dom.getElement (toHtmlID domID) 658 |> Task.attempt GotElement 659 660 SyncTextareaHeight domID -> 661 syncTextareaHeight (toHtmlID domID) 662 663 SyncStickyBuildLogHeaders -> 664 syncStickyBuildLogHeaders () 665 666 667 pipelinesSectionName : PipelinesSection -> String 668 pipelinesSectionName section = 669 case section of 670 FavoritesSection -> 671 "Favorites" 672 673 AllPipelinesSection -> 674 "AllPipelines" 675 676 677 toHtmlID : DomID -> String 678 toHtmlID domId = 679 case domId of 680 SideBarTeam section t -> 681 pipelinesSectionName section ++ "_" ++ Base64.encode t 682 683 SideBarPipeline section p -> 684 pipelinesSectionName section ++ "_" ++ Base64.encode p.teamName ++ "_" ++ Base64.encode p.pipelineName 685 686 PipelineStatusIcon section p -> 687 pipelinesSectionName section 688 ++ "_" 689 ++ Base64.encode p.teamName 690 ++ "_" 691 ++ Base64.encode p.pipelineName 692 ++ "_status" 693 694 VisibilityButton section p -> 695 pipelinesSectionName section 696 ++ "_" 697 ++ Base64.encode p.teamName 698 ++ "_" 699 ++ Base64.encode p.pipelineName 700 ++ "_visibility" 701 702 ChangedStepLabel stepID _ -> 703 stepID ++ "_changed" 704 705 StepState stepID -> 706 stepID ++ "_state" 707 708 StepInitialization stepID -> 709 stepID ++ "_image" 710 711 Dashboard -> 712 "dashboard" 713 714 DashboardGroup teamName -> 715 teamName 716 717 ResourceCommentTextarea -> 718 "resource_comment" 719 720 TopBarFavoritedIcon _ -> 721 "top-bar-favorited-icon" 722 723 _ -> 724 "" 725 726 727 scroll : ScrollDirection -> String -> Cmd Callback 728 scroll direction id = 729 case direction of 730 ToTop -> 731 scrollCoords id (always 0) (always 0) 732 |> Task.attempt (\_ -> EmptyCallback) 733 734 Down -> 735 scrollCoords id (always 0) (.viewport >> .y >> (+) 60) 736 |> Task.attempt (\_ -> EmptyCallback) 737 738 Up -> 739 scrollCoords id (always 0) (.viewport >> .y >> (+) -60) 740 |> Task.attempt (\_ -> EmptyCallback) 741 742 ToBottom -> 743 scrollCoords id (always 0) (.scene >> .height) 744 |> Task.attempt (\_ -> EmptyCallback) 745 746 Sideways delta -> 747 scrollCoords id (.viewport >> .x >> (+) -delta) (always 0) 748 |> Task.attempt (\_ -> EmptyCallback) 749 750 ToId toId -> 751 scrollToId ( id, toId ) 752 753 754 scrollCoords : 755 String 756 -> (Viewport -> Float) 757 -> (Viewport -> Float) 758 -> Task.Task Browser.Dom.Error () 759 scrollCoords id getX getY = 760 getViewportOf id 761 |> Task.andThen 762 (\viewport -> 763 setViewportOf 764 id 765 (getX viewport) 766 (getY viewport) 767 )