1module Dashboard.Dashboard exposing 2 ( documentTitle 3 , handleCallback 4 , handleDelivery 5 , init 6 , subscriptions 7 , tooltip 8 , update 9 , view 10 ) 11 12import Application.Models exposing (Session) 13import Concourse 14import Concourse.Cli as Cli 15import Dashboard.DashboardPreview as DashboardPreview 16import Dashboard.Drag as Drag 17import Dashboard.Filter as Filter 18import Dashboard.Footer as Footer 19import Dashboard.Group as Group 20import Dashboard.Group.Models exposing (Pipeline) 21import Dashboard.Models as Models 22 exposing 23 ( DragState(..) 24 , DropState(..) 25 , Dropdown(..) 26 , FetchError(..) 27 , Model 28 ) 29import Dashboard.PipelineGrid as PipelineGrid 30import Dashboard.PipelineGrid.Constants as PipelineGridConstants 31import Dashboard.RequestBuffer as RequestBuffer exposing (Buffer(..)) 32import Dashboard.SearchBar as SearchBar 33import Dashboard.Styles as Styles 34import Dashboard.Text as Text 35import Dict exposing (Dict) 36import EffectTransformer exposing (ET) 37import FetchResult exposing (FetchResult(..), changedFrom) 38import HoverState 39import Html exposing (Html) 40import Html.Attributes 41 exposing 42 ( attribute 43 , class 44 , download 45 , href 46 , id 47 , src 48 , style 49 ) 50import Html.Events 51 exposing 52 ( onMouseEnter 53 , onMouseLeave 54 ) 55import Http 56import List.Extra 57import Login.Login as Login 58import Message.Callback exposing (Callback(..)) 59import Message.Effects exposing (Effect(..), toHtmlID) 60import Message.Message as Message 61 exposing 62 ( DomID(..) 63 , Message(..) 64 , VisibilityAction(..) 65 ) 66import Message.Subscription 67 exposing 68 ( Delivery(..) 69 , Interval(..) 70 , Subscription(..) 71 ) 72import Routes 73import ScreenSize exposing (ScreenSize(..)) 74import Set exposing (Set) 75import SideBar.SideBar as SideBar 76import StrictEvents exposing (onScroll) 77import Time 78import Tooltip 79import UserState 80import Views.Spinner as Spinner 81import Views.Styles 82import Views.Toggle as Toggle 83 84 85type alias Flags = 86 { searchType : Routes.SearchType 87 , dashboardView : Routes.DashboardView 88 } 89 90 91init : Flags -> ( Model, List Effect ) 92init f = 93 ( { now = Nothing 94 , hideFooter = False 95 , hideFooterCounter = 0 96 , showHelp = False 97 , highDensity = f.searchType == Routes.HighDensity 98 , query = Routes.extractQuery f.searchType 99 , dashboardView = f.dashboardView 100 , pipelinesWithResourceErrors = Set.empty 101 , jobs = None 102 , pipelines = Nothing 103 , pipelineLayers = Dict.empty 104 , teams = None 105 , isUserMenuExpanded = False 106 , dropdown = Hidden 107 , dragState = Models.NotDragging 108 , dropState = Models.NotDropping 109 , isJobsRequestFinished = False 110 , isTeamsRequestFinished = False 111 , isResourcesRequestFinished = False 112 , isPipelinesRequestFinished = False 113 , jobsError = Nothing 114 , teamsError = Nothing 115 , resourcesError = Nothing 116 , pipelinesError = Nothing 117 , viewportWidth = 0 118 , viewportHeight = 0 119 , scrollTop = 0 120 , pipelineJobs = Dict.empty 121 , effectsToRetry = [] 122 } 123 , [ FetchAllTeams 124 , PinTeamNames Message.Effects.stickyHeaderConfig 125 , GetScreenSize 126 , FetchAllResources 127 , FetchAllJobs 128 , FetchAllPipelines 129 , LoadCachedJobs 130 , LoadCachedPipelines 131 , LoadCachedTeams 132 , GetViewportOf Dashboard 133 ] 134 ) 135 136 137buffers : List (Buffer Model) 138buffers = 139 [ Buffer FetchAllTeams 140 (\c -> 141 case c of 142 AllTeamsFetched _ -> 143 True 144 145 _ -> 146 False 147 ) 148 (.dragState >> (/=) NotDragging) 149 { get = \m -> m.isTeamsRequestFinished 150 , set = \f m -> { m | isTeamsRequestFinished = f } 151 } 152 , Buffer FetchAllResources 153 (\c -> 154 case c of 155 AllResourcesFetched _ -> 156 True 157 158 _ -> 159 False 160 ) 161 (.dragState >> (/=) NotDragging) 162 { get = \m -> m.isResourcesRequestFinished 163 , set = \f m -> { m | isResourcesRequestFinished = f } 164 } 165 , Buffer FetchAllJobs 166 (\c -> 167 case c of 168 AllJobsFetched _ -> 169 True 170 171 _ -> 172 False 173 ) 174 (\model -> model.dragState /= NotDragging || model.jobsError == Just Disabled) 175 { get = \m -> m.isJobsRequestFinished 176 , set = \f m -> { m | isJobsRequestFinished = f } 177 } 178 , Buffer FetchAllPipelines 179 (\c -> 180 case c of 181 AllPipelinesFetched _ -> 182 True 183 184 _ -> 185 False 186 ) 187 (.dragState >> (/=) NotDragging) 188 { get = \m -> m.isPipelinesRequestFinished 189 , set = \f m -> { m | isPipelinesRequestFinished = f } 190 } 191 ] 192 193 194handleCallback : Callback -> ET Model 195handleCallback callback ( model, effects ) = 196 (case callback of 197 AllTeamsFetched (Err _) -> 198 ( { model | teamsError = Just Failed } 199 , effects 200 ) 201 202 AllTeamsFetched (Ok teams) -> 203 let 204 newTeams = 205 Fetched teams 206 in 207 ( { model 208 | teams = newTeams 209 , teamsError = Nothing 210 } 211 , effects 212 ++ (if newTeams |> changedFrom model.teams then 213 [ SaveCachedTeams teams ] 214 215 else 216 [] 217 ) 218 ) 219 220 AllJobsFetched (Ok allJobsInEntireCluster) -> 221 let 222 removeBuild job = 223 { job 224 | finishedBuild = Nothing 225 , transitionBuild = Nothing 226 , nextBuild = Nothing 227 } 228 229 newJobs = 230 allJobsInEntireCluster 231 |> List.map 232 (\job -> 233 ( ( job.teamName 234 , job.pipelineName 235 , job.name 236 ) 237 , job 238 ) 239 ) 240 |> Dict.fromList 241 |> Fetched 242 243 maxJobsInCache = 244 1000 245 246 mapToJobIds jobsResult = 247 jobsResult 248 |> FetchResult.map (Dict.toList >> List.map Tuple.first) 249 250 newModel = 251 { model 252 | jobs = newJobs 253 , jobsError = Nothing 254 } 255 in 256 if mapToJobIds newJobs |> changedFrom (mapToJobIds model.jobs) then 257 ( newModel |> precomputeJobMetadata 258 , effects 259 ++ [ allJobsInEntireCluster 260 |> List.take maxJobsInCache 261 |> List.map removeBuild 262 |> SaveCachedJobs 263 ] 264 ) 265 266 else 267 ( newModel, effects ) 268 269 AllJobsFetched (Err err) -> 270 case err of 271 Http.BadStatus { status } -> 272 case status.code of 273 501 -> 274 ( { model 275 | jobsError = Just Disabled 276 , jobs = Fetched Dict.empty 277 , pipelines = 278 model.pipelines 279 |> Maybe.map 280 (Dict.map 281 (\_ l -> 282 List.map 283 (\p -> 284 { p | jobsDisabled = True } 285 ) 286 l 287 ) 288 ) 289 } 290 , effects ++ [ DeleteCachedJobs ] 291 ) 292 293 503 -> 294 ( { model 295 | effectsToRetry = 296 model.effectsToRetry 297 ++ (if List.member FetchAllJobs model.effectsToRetry then 298 [] 299 300 else 301 [ FetchAllJobs ] 302 ) 303 } 304 , effects 305 ) 306 307 _ -> 308 ( { model | jobsError = Just Failed }, effects ) 309 310 _ -> 311 ( { model | jobsError = Just Failed }, effects ) 312 313 AllResourcesFetched (Ok resources) -> 314 ( { model 315 | pipelinesWithResourceErrors = 316 resources 317 |> List.filter .failingToCheck 318 |> List.map (\r -> ( r.teamName, r.pipelineName )) 319 |> Set.fromList 320 , resourcesError = Nothing 321 } 322 , effects 323 ) 324 325 AllResourcesFetched (Err _) -> 326 ( { model | resourcesError = Just Failed }, effects ) 327 328 AllPipelinesFetched (Ok allPipelinesInEntireCluster) -> 329 let 330 newPipelines = 331 allPipelinesInEntireCluster 332 |> List.map (toDashboardPipeline False (model.jobsError == Just Disabled)) 333 |> groupBy .teamName 334 |> Just 335 in 336 ( { model 337 | pipelines = newPipelines 338 , pipelinesError = Nothing 339 } 340 , effects 341 ++ (if List.isEmpty allPipelinesInEntireCluster then 342 [ ModifyUrl "/" ] 343 344 else 345 [] 346 ) 347 ++ (if newPipelines |> pipelinesChangedFrom model.pipelines then 348 [ SaveCachedPipelines allPipelinesInEntireCluster ] 349 350 else 351 [] 352 ) 353 ) 354 355 AllPipelinesFetched (Err _) -> 356 ( { model | pipelinesError = Just Failed }, effects ) 357 358 PipelinesOrdered teamName _ -> 359 ( model, effects ++ [ FetchPipelines teamName ] ) 360 361 PipelinesFetched _ -> 362 ( { model | dropState = NotDropping } 363 , effects 364 ) 365 366 LoggedOut (Ok ()) -> 367 ( model 368 , effects 369 ++ [ NavigateTo <| 370 Routes.toString <| 371 Routes.Dashboard 372 { searchType = 373 if model.highDensity then 374 Routes.HighDensity 375 376 else 377 Routes.Normal model.query 378 , dashboardView = model.dashboardView 379 } 380 , FetchAllTeams 381 , FetchAllResources 382 , FetchAllJobs 383 , FetchAllPipelines 384 , DeleteCachedPipelines 385 , DeleteCachedJobs 386 , DeleteCachedTeams 387 ] 388 ) 389 390 PipelineToggled _ (Ok ()) -> 391 ( model, effects ++ [ FetchAllPipelines ] ) 392 393 VisibilityChanged Hide pipelineId (Ok ()) -> 394 ( updatePipeline 395 (\p -> { p | public = False, isVisibilityLoading = False }) 396 pipelineId 397 model 398 , effects 399 ) 400 401 VisibilityChanged Hide pipelineId (Err _) -> 402 ( updatePipeline 403 (\p -> { p | public = True, isVisibilityLoading = False }) 404 pipelineId 405 model 406 , effects 407 ) 408 409 VisibilityChanged Expose pipelineId (Ok ()) -> 410 ( updatePipeline 411 (\p -> { p | public = True, isVisibilityLoading = False }) 412 pipelineId 413 model 414 , effects 415 ) 416 417 VisibilityChanged Expose pipelineId (Err _) -> 418 ( updatePipeline 419 (\p -> { p | public = False, isVisibilityLoading = False }) 420 pipelineId 421 model 422 , effects 423 ) 424 425 GotViewport Dashboard (Ok viewport) -> 426 ( { model 427 | viewportWidth = viewport.viewport.width 428 , viewportHeight = viewport.viewport.height 429 , scrollTop = viewport.viewport.y 430 } 431 , effects 432 ) 433 434 _ -> 435 ( model, effects ) 436 ) 437 |> RequestBuffer.handleCallback callback buffers 438 439 440updatePipeline : 441 (Pipeline -> Pipeline) 442 -> Concourse.PipelineIdentifier 443 -> Model 444 -> Model 445updatePipeline updater pipelineId model = 446 { model 447 | pipelines = 448 model.pipelines 449 |> Maybe.map 450 (Dict.update pipelineId.teamName 451 (Maybe.map 452 (List.Extra.updateIf 453 (\p -> p.name == pipelineId.pipelineName) 454 updater 455 ) 456 ) 457 ) 458 } 459 460 461findPipeline : Concourse.PipelineIdentifier -> Maybe (Dict String (List Pipeline)) -> Maybe Pipeline 462findPipeline pipelineId pipelines = 463 pipelines 464 |> Maybe.andThen (Dict.get pipelineId.teamName) 465 |> Maybe.andThen (List.Extra.find (.name >> (==) pipelineId.pipelineName)) 466 467 468handleDelivery : Delivery -> ET Model 469handleDelivery delivery = 470 SearchBar.handleDelivery delivery 471 >> Footer.handleDelivery delivery 472 >> RequestBuffer.handleDelivery delivery buffers 473 >> handleDeliveryBody delivery 474 475 476handleDeliveryBody : Delivery -> ET Model 477handleDeliveryBody delivery ( model, effects ) = 478 case delivery of 479 ClockTicked OneSecond time -> 480 ( { model | now = Just time, effectsToRetry = [] }, model.effectsToRetry ) 481 482 WindowResized _ _ -> 483 ( model, effects ++ [ GetViewportOf Dashboard ] ) 484 485 SideBarStateReceived _ -> 486 ( model, effects ++ [ GetViewportOf Dashboard ] ) 487 488 CachedPipelinesReceived (Ok pipelines) -> 489 if model.pipelines == Nothing then 490 ( { model 491 | pipelines = 492 pipelines 493 |> List.map 494 (toDashboardPipeline 495 True 496 (model.jobsError == Just Disabled) 497 ) 498 |> groupBy .teamName 499 |> Just 500 } 501 , effects 502 ) 503 504 else 505 ( model, effects ) 506 507 CachedJobsReceived (Ok jobs) -> 508 let 509 newJobs = 510 jobs 511 |> List.map 512 (\job -> 513 ( ( job.teamName 514 , job.pipelineName 515 , job.name 516 ) 517 , job 518 ) 519 ) 520 |> Dict.fromList 521 |> Cached 522 523 mapToJobIds jobsResult = 524 jobsResult 525 |> FetchResult.map (Dict.toList >> List.map Tuple.first) 526 in 527 if mapToJobIds newJobs |> changedFrom (mapToJobIds model.jobs) then 528 ( { model | jobs = newJobs } |> precomputeJobMetadata 529 , effects 530 ) 531 532 else 533 ( model, effects ) 534 535 CachedTeamsReceived (Ok teams) -> 536 let 537 newTeams = 538 Cached teams 539 in 540 if newTeams |> changedFrom model.teams then 541 ( { model | teams = newTeams }, effects ) 542 543 else 544 ( model, effects ) 545 546 _ -> 547 ( model, effects ) 548 549 550toDashboardPipeline : Bool -> Bool -> Concourse.Pipeline -> Pipeline 551toDashboardPipeline isStale jobsDisabled p = 552 { id = p.id 553 , name = p.name 554 , teamName = p.teamName 555 , public = p.public 556 , isToggleLoading = False 557 , isVisibilityLoading = False 558 , paused = p.paused 559 , archived = p.archived 560 , stale = isStale 561 , jobsDisabled = jobsDisabled 562 } 563 564 565toConcoursePipeline : Pipeline -> Concourse.Pipeline 566toConcoursePipeline p = 567 { id = p.id 568 , name = p.name 569 , teamName = p.teamName 570 , public = p.public 571 , paused = p.paused 572 , archived = p.archived 573 , groups = [] 574 , backgroundImage = Maybe.Nothing 575 } 576 577 578pipelinesChangedFrom : 579 Maybe (Dict String (List Pipeline)) 580 -> Maybe (Dict String (List Pipeline)) 581 -> Bool 582pipelinesChangedFrom ps qs = 583 let 584 project = 585 Maybe.map <| 586 Dict.values 587 >> List.concat 588 >> List.map (\x -> { x | stale = True }) 589 in 590 project ps /= project qs 591 592 593groupBy : (a -> comparable) -> List a -> Dict comparable (List a) 594groupBy keyfn list = 595 -- From https://github.com/elm-community/dict-extra/blob/2.3.0/src/Dict/Extra.elm 596 List.foldr 597 (\x acc -> 598 Dict.update (keyfn x) (Maybe.map ((::) x) >> Maybe.withDefault [ x ] >> Just) acc 599 ) 600 Dict.empty 601 list 602 603 604precomputeJobMetadata : Model -> Model 605precomputeJobMetadata model = 606 let 607 allJobs = 608 model.jobs 609 |> FetchResult.withDefault Dict.empty 610 |> Dict.values 611 612 pipelineJobs = 613 allJobs |> groupBy (\j -> ( j.teamName, j.pipelineName )) 614 615 jobToId job = 616 { teamName = job.teamName 617 , pipelineName = job.pipelineName 618 , jobName = job.name 619 } 620 in 621 { model 622 | pipelineLayers = 623 pipelineJobs 624 |> Dict.map 625 (\_ jobs -> 626 jobs 627 |> DashboardPreview.groupByRank 628 |> List.map (List.map jobToId) 629 ) 630 , pipelineJobs = 631 pipelineJobs 632 |> Dict.map (\_ jobs -> jobs |> List.map jobToId) 633 } 634 635 636update : Session -> Message -> ET Model 637update session msg = 638 SearchBar.update session msg >> updateBody msg 639 640 641updateBody : Message -> ET Model 642updateBody msg ( model, effects ) = 643 case msg of 644 DragStart teamName pipelineName -> 645 ( { model | dragState = Models.Dragging teamName pipelineName }, effects ) 646 647 DragOver target -> 648 ( { model | dropState = Models.Dropping target }, effects ) 649 650 TooltipHd pipelineName teamName -> 651 ( model, effects ++ [ ShowTooltipHd ( pipelineName, teamName ) ] ) 652 653 Tooltip pipelineName teamName -> 654 ( model, effects ++ [ ShowTooltip ( pipelineName, teamName ) ] ) 655 656 DragEnd -> 657 case ( model.dragState, model.dropState ) of 658 ( Dragging teamName pipelineName, Dropping target ) -> 659 let 660 teamPipelines = 661 model.pipelines 662 |> Maybe.andThen (Dict.get teamName) 663 |> Maybe.withDefault [] 664 |> Drag.dragPipeline pipelineName target 665 666 pipelines = 667 model.pipelines 668 |> Maybe.withDefault Dict.empty 669 |> Dict.update teamName (always <| Just teamPipelines) 670 in 671 ( { model 672 | pipelines = Just pipelines 673 , dragState = NotDragging 674 , dropState = DroppingWhileApiRequestInFlight teamName 675 } 676 , effects 677 ++ [ teamPipelines 678 |> List.map .name 679 |> SendOrderPipelinesRequest teamName 680 , pipelines 681 |> Dict.values 682 |> List.concat 683 |> List.map toConcoursePipeline 684 |> SaveCachedPipelines 685 ] 686 ) 687 688 _ -> 689 ( { model 690 | dragState = NotDragging 691 , dropState = NotDropping 692 } 693 , effects 694 ) 695 696 Hover (Just domID) -> 697 ( model, effects ++ [ GetViewportOf domID ] ) 698 699 Click LogoutButton -> 700 ( { model 701 | teams = None 702 , pipelines = Nothing 703 , jobs = None 704 } 705 , effects 706 ) 707 708 Click (PipelineCardPauseToggle _ pipelineId) -> 709 let 710 isPaused = 711 model.pipelines 712 |> findPipeline pipelineId 713 |> Maybe.map .paused 714 in 715 case isPaused of 716 Just ip -> 717 ( updatePipeline 718 (\p -> { p | isToggleLoading = True }) 719 pipelineId 720 model 721 , effects 722 ++ [ SendTogglePipelineRequest pipelineId ip ] 723 ) 724 725 Nothing -> 726 ( model, effects ) 727 728 Click (VisibilityButton _ pipelineId) -> 729 let 730 isPublic = 731 model.pipelines 732 |> findPipeline pipelineId 733 |> Maybe.map .public 734 in 735 case isPublic of 736 Just public -> 737 ( updatePipeline 738 (\p -> { p | isVisibilityLoading = True }) 739 pipelineId 740 model 741 , effects 742 ++ [ if public then 743 ChangeVisibility Hide pipelineId 744 745 else 746 ChangeVisibility Expose pipelineId 747 ] 748 ) 749 750 Nothing -> 751 ( model, effects ) 752 753 Click HamburgerMenu -> 754 ( model, effects ++ [ GetViewportOf Dashboard ] ) 755 756 Scrolled scrollState -> 757 ( { model | scrollTop = scrollState.scrollTop }, effects ) 758 759 _ -> 760 ( model, effects ) 761 762 763subscriptions : List Subscription 764subscriptions = 765 [ OnClockTick OneSecond 766 , OnClockTick FiveSeconds 767 , OnMouse 768 , OnKeyDown 769 , OnKeyUp 770 , OnWindowResize 771 , OnCachedJobsReceived 772 , OnCachedPipelinesReceived 773 , OnCachedTeamsReceived 774 ] 775 776 777documentTitle : String 778documentTitle = 779 "Dashboard" 780 781 782view : Session -> Model -> Html Message 783view session model = 784 Html.div 785 (id "page-including-top-bar" :: Views.Styles.pageIncludingTopBar) 786 [ topBar session model 787 , Html.div 788 [ id "page-below-top-bar" 789 , style "padding-top" "54px" 790 , style "box-sizing" "border-box" 791 , style "display" "flex" 792 , style "height" "100%" 793 , style "padding-bottom" <| 794 if model.showHelp || model.hideFooter then 795 "0" 796 797 else 798 "50px" 799 ] 800 <| 801 [ SideBar.view session Nothing 802 , dashboardView session model 803 ] 804 , Footer.view session model 805 ] 806 807 808tooltip : { a | pipelines : Maybe (Dict String (List Pipeline)) } -> { b | hovered : HoverState.HoverState } -> Maybe Tooltip.Tooltip 809tooltip model { hovered } = 810 case hovered of 811 HoverState.Tooltip (Message.PipelineStatusIcon _ _) _ -> 812 Just 813 { body = 814 Html.div 815 Styles.jobsDisabledTooltip 816 [ Html.text "automatic job monitoring disabled" ] 817 , attachPosition = { direction = Tooltip.Top, alignment = Tooltip.Start } 818 , arrow = Nothing 819 } 820 821 HoverState.Tooltip (Message.VisibilityButton _ pipelineId) _ -> 822 model.pipelines 823 |> findPipeline pipelineId 824 |> Maybe.map 825 (\p -> 826 { body = 827 Html.div 828 Styles.visibilityTooltip 829 [ Html.text <| 830 if p.public then 831 "hide pipeline" 832 833 else 834 "expose pipeline" 835 ] 836 , attachPosition = 837 { direction = Tooltip.Top 838 , alignment = Tooltip.End 839 } 840 , arrow = Nothing 841 } 842 ) 843 844 _ -> 845 Nothing 846 847 848topBar : Session -> Model -> Html Message 849topBar session model = 850 Html.div 851 (id "top-bar-app" :: Views.Styles.topBar False) 852 <| 853 [ Html.div [ style "display" "flex", style "align-items" "center" ] 854 [ SideBar.hamburgerMenu session 855 , Html.a (href "/" :: Views.Styles.concourseLogo) [] 856 , clusterNameView session 857 ] 858 ] 859 ++ (let 860 isDropDownHidden = 861 model.dropdown == Hidden 862 863 isMobile = 864 session.screenSize == ScreenSize.Mobile 865 in 866 if 867 not model.highDensity 868 && isMobile 869 && (not isDropDownHidden || model.query /= "") 870 then 871 [ SearchBar.view session model ] 872 873 else if not model.highDensity then 874 [ topBarContent [ SearchBar.view session model ] 875 , showArchivedToggleView model 876 , Login.view session.userState model 877 ] 878 879 else 880 [ topBarContent [] 881 , showArchivedToggleView model 882 , Login.view session.userState model 883 ] 884 ) 885 886 887topBarContent : List (Html Message) -> Html Message 888topBarContent content = 889 Html.div 890 (id "top-bar-content" :: Styles.topBarContent) 891 content 892 893 894clusterNameView : Session -> Html Message 895clusterNameView session = 896 Html.div 897 Styles.clusterName 898 [ Html.text session.clusterName ] 899 900 901showArchivedToggleView : 902 { a 903 | pipelines : Maybe (Dict String (List Pipeline)) 904 , query : String 905 , highDensity : Bool 906 , dashboardView : Routes.DashboardView 907 } 908 -> Html Message 909showArchivedToggleView model = 910 let 911 noPipelines = 912 model.pipelines 913 |> Maybe.withDefault Dict.empty 914 |> Dict.values 915 |> List.all List.isEmpty 916 917 on = 918 model.dashboardView == Routes.ViewAllPipelines 919 in 920 if noPipelines then 921 Html.text "" 922 923 else 924 Toggle.toggleSwitch 925 { ariaLabel = "Toggle whether archived pipelines are displayed" 926 , hrefRoute = 927 Routes.Dashboard 928 { searchType = 929 if model.highDensity then 930 Routes.HighDensity 931 932 else 933 Routes.Normal model.query 934 , dashboardView = 935 if on then 936 Routes.ViewNonArchivedPipelines 937 938 else 939 Routes.ViewAllPipelines 940 } 941 , text = "show archived" 942 , textDirection = Toggle.Left 943 , on = on 944 , styles = Styles.showArchivedToggle 945 } 946 947 948showTurbulence : 949 { a 950 | jobsError : Maybe FetchError 951 , teamsError : Maybe FetchError 952 , resourcesError : Maybe FetchError 953 , pipelinesError : Maybe FetchError 954 } 955 -> Bool 956showTurbulence model = 957 (model.jobsError == Just Failed) 958 || (model.teamsError == Just Failed) 959 || (model.resourcesError == Just Failed) 960 || (model.pipelinesError == Just Failed) 961 962 963dashboardView : 964 { a 965 | hovered : HoverState.HoverState 966 , screenSize : ScreenSize 967 , userState : UserState.UserState 968 , turbulenceImgSrc : String 969 , pipelineRunningKeyframes : String 970 , favoritedPipelines : Set Concourse.DatabaseID 971 } 972 -> Model 973 -> Html Message 974dashboardView session model = 975 if showTurbulence model then 976 turbulenceView session.turbulenceImgSrc 977 978 else 979 Html.div 980 (class (.pageBodyClass Message.Effects.stickyHeaderConfig) 981 :: id (toHtmlID Dashboard) 982 :: onScroll Scrolled 983 :: Styles.content model.highDensity 984 ) 985 (case model.pipelines of 986 Nothing -> 987 [ loadingView ] 988 989 Just pipelines -> 990 if pipelines |> Dict.values |> List.all List.isEmpty then 991 welcomeCard session :: pipelinesView session model 992 993 else 994 Html.text "" :: pipelinesView session model 995 ) 996 997 998loadingView : Html Message 999loadingView = 1000 Html.div 1001 (class "loading" :: Styles.loadingView) 1002 [ Spinner.spinner { sizePx = 36, margin = "0" } ] 1003 1004 1005welcomeCard : 1006 { a | hovered : HoverState.HoverState, userState : UserState.UserState } 1007 -> Html Message 1008welcomeCard session = 1009 let 1010 cliIcon : HoverState.HoverState -> Cli.Cli -> Html Message 1011 cliIcon hoverable cli = 1012 Html.a 1013 ([ href <| Cli.downloadUrl cli 1014 , attribute "aria-label" <| Cli.label cli 1015 , id <| "top-cli-" ++ Cli.id cli 1016 , onMouseEnter <| Hover <| Just <| Message.WelcomeCardCliIcon cli 1017 , onMouseLeave <| Hover Nothing 1018 , download "" 1019 ] 1020 ++ Styles.topCliIcon 1021 { hovered = 1022 HoverState.isHovered 1023 (Message.WelcomeCardCliIcon cli) 1024 hoverable 1025 , cli = cli 1026 } 1027 ) 1028 [] 1029 in 1030 Html.div 1031 (id "welcome-card" :: Styles.welcomeCard) 1032 [ Html.div 1033 Styles.welcomeCardTitle 1034 [ Html.text Text.welcome ] 1035 , Html.div 1036 Styles.welcomeCardBody 1037 <| 1038 [ Html.div 1039 [ style "display" "flex" 1040 , style "align-items" "center" 1041 ] 1042 <| 1043 [ Html.div 1044 [ style "margin-right" "10px" ] 1045 [ Html.text Text.cliInstructions ] 1046 ] 1047 ++ List.map (cliIcon session.hovered) Cli.clis 1048 , Html.div 1049 [] 1050 [ Html.text Text.setPipelineInstructions ] 1051 ] 1052 ++ loginInstruction session.userState 1053 , Html.pre 1054 Styles.asciiArt 1055 [ Html.text Text.asciiArt ] 1056 ] 1057 1058 1059loginInstruction : UserState.UserState -> List (Html Message) 1060loginInstruction userState = 1061 case userState of 1062 UserState.UserStateLoggedIn _ -> 1063 [] 1064 1065 _ -> 1066 [ Html.div 1067 [ id "login-instruction" 1068 , style "line-height" "42px" 1069 ] 1070 [ Html.text "login " 1071 , Html.a 1072 [ href "/login" 1073 , style "text-decoration" "underline" 1074 ] 1075 [ Html.text "here" ] 1076 ] 1077 ] 1078 1079 1080noResultsView : String -> Html Message 1081noResultsView query = 1082 let 1083 boldedQuery = 1084 Html.span [ class "monospace-bold" ] [ Html.text query ] 1085 in 1086 Html.div 1087 (class "no-results" :: Styles.noResults) 1088 [ Html.text "No results for " 1089 , boldedQuery 1090 , Html.text " matched your search." 1091 ] 1092 1093 1094turbulenceView : String -> Html Message 1095turbulenceView path = 1096 Html.div 1097 [ class "error-message" ] 1098 [ Html.div [ class "message" ] 1099 [ Html.img [ src path, class "seatbelt" ] [] 1100 , Html.p [] [ Html.text "experiencing turbulence" ] 1101 , Html.p [ class "explanation" ] [] 1102 ] 1103 ] 1104 1105 1106pipelinesView : 1107 { a 1108 | userState : UserState.UserState 1109 , hovered : HoverState.HoverState 1110 , pipelineRunningKeyframes : String 1111 , favoritedPipelines : Set Concourse.DatabaseID 1112 } 1113 -> 1114 { b 1115 | teams : FetchResult (List Concourse.Team) 1116 , query : String 1117 , highDensity : Bool 1118 , dashboardView : Routes.DashboardView 1119 , pipelinesWithResourceErrors : Set ( String, String ) 1120 , pipelineLayers : Dict ( String, String ) (List (List Concourse.JobIdentifier)) 1121 , pipelines : Maybe (Dict String (List Pipeline)) 1122 , jobs : FetchResult (Dict ( String, String, String ) Concourse.Job) 1123 , dragState : DragState 1124 , dropState : DropState 1125 , now : Maybe Time.Posix 1126 , viewportWidth : Float 1127 , viewportHeight : Float 1128 , scrollTop : Float 1129 , pipelineJobs : Dict ( String, String ) (List Concourse.JobIdentifier) 1130 } 1131 -> List (Html Message) 1132pipelinesView session params = 1133 let 1134 pipelines = 1135 params.pipelines 1136 |> Maybe.withDefault Dict.empty 1137 1138 jobs = 1139 params.jobs 1140 |> FetchResult.withDefault Dict.empty 1141 1142 teams = 1143 params.teams 1144 |> FetchResult.withDefault [] 1145 1146 filteredGroups = 1147 Filter.filterGroups 1148 { pipelineJobs = params.pipelineJobs 1149 , jobs = jobs 1150 , query = params.query 1151 , teams = teams 1152 , pipelines = pipelines 1153 , dashboardView = params.dashboardView 1154 , favoritedPipelines = session.favoritedPipelines 1155 } 1156 |> List.sortWith (Group.ordering session) 1157 1158 ( headerView, offsetHeight ) = 1159 if params.highDensity then 1160 ( [], 0 ) 1161 1162 else 1163 let 1164 favoritedPipelines = 1165 filteredGroups 1166 |> List.concatMap .pipelines 1167 |> List.filter 1168 (\fp -> 1169 Set.member fp.id session.favoritedPipelines 1170 ) 1171 1172 allPipelinesHeader = 1173 Html.div Styles.pipelineSectionHeader [ Html.text "all pipelines" ] 1174 in 1175 if List.isEmpty filteredGroups then 1176 ( [], 0 ) 1177 1178 else if List.isEmpty favoritedPipelines then 1179 ( [ allPipelinesHeader ], PipelineGridConstants.sectionHeaderHeight ) 1180 1181 else 1182 let 1183 offset = 1184 PipelineGridConstants.sectionHeaderHeight 1185 1186 layout = 1187 PipelineGrid.computeFavoritePipelinesLayout 1188 { pipelineLayers = params.pipelineLayers 1189 , viewportWidth = params.viewportWidth 1190 , viewportHeight = params.viewportHeight 1191 , scrollTop = params.scrollTop - offset 1192 } 1193 favoritedPipelines 1194 in 1195 [ Html.div Styles.pipelineSectionHeader [ Html.text "favorite pipelines" ] 1196 , Group.viewFavoritePipelines 1197 session 1198 { dragState = NotDragging 1199 , dropState = NotDropping 1200 , now = params.now 1201 , hovered = session.hovered 1202 , pipelineRunningKeyframes = session.pipelineRunningKeyframes 1203 , pipelinesWithResourceErrors = params.pipelinesWithResourceErrors 1204 , pipelineLayers = params.pipelineLayers 1205 , pipelineCards = layout.pipelineCards 1206 , headers = layout.headers 1207 , groupCardsHeight = layout.height 1208 , pipelineJobs = params.pipelineJobs 1209 , jobs = jobs 1210 } 1211 , Views.Styles.separator PipelineGridConstants.sectionSpacerHeight 1212 , allPipelinesHeader 1213 ] 1214 |> (\html -> 1215 ( html 1216 , layout.height 1217 + (2 * PipelineGridConstants.sectionHeaderHeight) 1218 + PipelineGridConstants.sectionSpacerHeight 1219 ) 1220 ) 1221 1222 groupViews = 1223 filteredGroups 1224 |> (if params.highDensity then 1225 List.concatMap 1226 (Group.hdView 1227 { pipelineRunningKeyframes = session.pipelineRunningKeyframes 1228 , pipelinesWithResourceErrors = params.pipelinesWithResourceErrors 1229 , pipelineJobs = params.pipelineJobs 1230 , jobs = jobs 1231 } 1232 session 1233 ) 1234 1235 else 1236 List.foldl 1237 (\g ( htmlList, totalOffset ) -> 1238 let 1239 layout = 1240 PipelineGrid.computeLayout 1241 { dragState = params.dragState 1242 , dropState = params.dropState 1243 , pipelineLayers = params.pipelineLayers 1244 , viewportWidth = params.viewportWidth 1245 , viewportHeight = params.viewportHeight 1246 , scrollTop = params.scrollTop - totalOffset 1247 } 1248 g 1249 in 1250 Group.view 1251 session 1252 { dragState = params.dragState 1253 , dropState = params.dropState 1254 , now = params.now 1255 , hovered = session.hovered 1256 , pipelineRunningKeyframes = session.pipelineRunningKeyframes 1257 , pipelinesWithResourceErrors = params.pipelinesWithResourceErrors 1258 , pipelineLayers = params.pipelineLayers 1259 , pipelineCards = layout.pipelineCards 1260 , dropAreas = layout.dropAreas 1261 , groupCardsHeight = layout.height 1262 , pipelineJobs = params.pipelineJobs 1263 , jobs = jobs 1264 } 1265 g 1266 |> (\html -> 1267 ( html :: htmlList 1268 , totalOffset 1269 + layout.height 1270 + PipelineGridConstants.headerHeight 1271 + PipelineGridConstants.padding 1272 ) 1273 ) 1274 ) 1275 ( [], offsetHeight ) 1276 >> Tuple.first 1277 >> List.reverse 1278 ) 1279 in 1280 if 1281 (params.pipelines /= Nothing) 1282 && List.isEmpty groupViews 1283 && not (String.isEmpty params.query) 1284 then 1285 [ noResultsView params.query ] 1286 1287 else 1288 headerView ++ groupViews 1289