1module Job.Job exposing 2 ( Flags 3 , Model 4 , changeToJob 5 , documentTitle 6 , getUpdateMessage 7 , handleCallback 8 , handleDelivery 9 , init 10 , startingPage 11 , subscriptions 12 , tooltip 13 , update 14 , view 15 ) 16 17import Application.Models exposing (Session) 18import Assets 19import Colors 20import Concourse 21import Concourse.BuildStatus exposing (BuildStatus(..)) 22import Concourse.Pagination 23 exposing 24 ( Page 25 , Paginated 26 , chevronContainer 27 , chevronLeft 28 , chevronRight 29 ) 30import Dict 31import EffectTransformer exposing (ET) 32import HoverState 33import Html exposing (Html) 34import Html.Attributes 35 exposing 36 ( attribute 37 , class 38 , href 39 , id 40 , style 41 ) 42import Html.Events 43 exposing 44 ( onClick 45 , onMouseEnter 46 , onMouseLeave 47 ) 48import Http 49import Job.Styles as Styles 50import List.Extra 51import Login.Login as Login 52import Message.Callback exposing (Callback(..)) 53import Message.Effects exposing (Effect(..)) 54import Message.Message exposing (DomID(..), Message(..)) 55import Message.Subscription exposing (Delivery(..), Interval(..), Subscription(..)) 56import Message.TopLevelMessage exposing (TopLevelMessage(..)) 57import RemoteData exposing (WebData) 58import Routes 59import SideBar.SideBar as SideBar 60import StrictEvents exposing (onLeftClick) 61import Time 62import Tooltip 63import UpdateMsg exposing (UpdateMsg) 64import Views.BuildDuration as BuildDuration 65import Views.DictView as DictView 66import Views.Icon as Icon 67import Views.LoadingIndicator as LoadingIndicator 68import Views.Styles 69import Views.TopBar as TopBar 70 71 72type alias Model = 73 Login.Model 74 { jobIdentifier : Concourse.JobIdentifier 75 , job : WebData Concourse.Job 76 , pausedChanging : Bool 77 , buildsWithResources : WebData (Paginated BuildWithResources) 78 , currentPage : Page 79 , now : Time.Posix 80 } 81 82 83type alias BuildWithResources = 84 { build : Concourse.Build 85 , resources : Maybe Concourse.BuildResources 86 } 87 88 89pageLimit : Int 90pageLimit = 91 100 92 93 94type alias Flags = 95 { jobId : Concourse.JobIdentifier 96 , paging : Maybe Page 97 } 98 99 100startingPage : Page 101startingPage = 102 { limit = pageLimit 103 , direction = Concourse.Pagination.ToMostRecent 104 } 105 106 107init : Flags -> ( Model, List Effect ) 108init flags = 109 let 110 page = 111 flags.paging |> Maybe.withDefault startingPage 112 113 model = 114 { jobIdentifier = flags.jobId 115 , job = RemoteData.NotAsked 116 , pausedChanging = False 117 , buildsWithResources = RemoteData.Loading 118 , now = Time.millisToPosix 0 119 , currentPage = page 120 , isUserMenuExpanded = False 121 } 122 in 123 ( model 124 , [ FetchJob flags.jobId 125 , FetchJobBuilds flags.jobId page 126 , GetCurrentTime 127 , GetCurrentTimeZone 128 , FetchAllPipelines 129 ] 130 ) 131 132 133changeToJob : Flags -> ET Model 134changeToJob flags ( model, effects ) = 135 let 136 page = 137 flags.paging |> Maybe.withDefault startingPage 138 in 139 ( { model 140 | currentPage = page 141 , buildsWithResources = RemoteData.Loading 142 } 143 , effects ++ [ FetchJobBuilds model.jobIdentifier page ] 144 ) 145 146 147subscriptions : List Subscription 148subscriptions = 149 [ OnClockTick FiveSeconds 150 , OnClockTick OneSecond 151 ] 152 153 154getUpdateMessage : Model -> UpdateMsg 155getUpdateMessage model = 156 case model.job of 157 RemoteData.Failure _ -> 158 UpdateMsg.NotFound 159 160 _ -> 161 UpdateMsg.AOK 162 163 164handleCallback : Callback -> ET Model 165handleCallback callback ( model, effects ) = 166 case callback of 167 BuildTriggered (Ok build) -> 168 ( model 169 , case build.job of 170 Nothing -> 171 effects 172 173 Just job -> 174 effects 175 ++ [ NavigateTo <| 176 Routes.toString <| 177 Routes.Build 178 { id = 179 { teamName = job.teamName 180 , pipelineName = job.pipelineName 181 , jobName = job.jobName 182 , buildName = build.name 183 } 184 , highlight = Routes.HighlightNothing 185 } 186 ] 187 ) 188 189 JobBuildsFetched (Ok ( requestedPage, builds )) -> 190 handleJobBuildsFetched requestedPage builds ( model, effects ) 191 192 JobFetched (Ok job) -> 193 ( { model | job = RemoteData.Success job } 194 , effects 195 ) 196 197 JobFetched (Err err) -> 198 case err of 199 Http.BadStatus { status } -> 200 if status.code == 404 then 201 ( { model | job = RemoteData.Failure err }, effects ) 202 203 else 204 ( model, effects ++ redirectToLoginIfNecessary err ) 205 206 _ -> 207 ( model, effects ) 208 209 BuildResourcesFetched (Ok ( id, buildResources )) -> 210 case model.buildsWithResources of 211 RemoteData.Success { content, pagination } -> 212 ( { model 213 | buildsWithResources = 214 RemoteData.Success 215 { content = 216 List.Extra.updateIf 217 (\bwr -> bwr.build.id == id) 218 (\bwr -> { bwr | resources = Just buildResources }) 219 content 220 , pagination = pagination 221 } 222 } 223 , effects 224 ) 225 226 _ -> 227 ( model, effects ) 228 229 BuildResourcesFetched (Err _) -> 230 ( model, effects ) 231 232 PausedToggled (Ok ()) -> 233 ( { model | pausedChanging = False }, effects ) 234 235 GotCurrentTime now -> 236 ( { model | now = now }, effects ) 237 238 _ -> 239 ( model, effects ) 240 241 242handleDelivery : Delivery -> ET Model 243handleDelivery delivery ( model, effects ) = 244 case delivery of 245 ClockTicked OneSecond time -> 246 ( { model | now = time }, effects ) 247 248 ClockTicked FiveSeconds _ -> 249 ( model 250 , effects 251 ++ [ FetchJobBuilds model.jobIdentifier model.currentPage 252 , FetchJob model.jobIdentifier 253 , FetchAllPipelines 254 ] 255 ) 256 257 _ -> 258 ( model, effects ) 259 260 261update : Message -> ET Model 262update action ( model, effects ) = 263 case action of 264 Click TriggerBuildButton -> 265 ( model, effects ++ [ DoTriggerBuild model.jobIdentifier ] ) 266 267 Click ToggleJobButton -> 268 case model.job |> RemoteData.toMaybe of 269 Nothing -> 270 ( model, effects ) 271 272 Just j -> 273 ( { model 274 | pausedChanging = True 275 , job = RemoteData.Success { j | paused = not j.paused } 276 } 277 , if j.paused then 278 effects ++ [ UnpauseJob model.jobIdentifier ] 279 280 else 281 effects ++ [ PauseJob model.jobIdentifier ] 282 ) 283 284 _ -> 285 ( model, effects ) 286 287 288redirectToLoginIfNecessary : Http.Error -> List Effect 289redirectToLoginIfNecessary err = 290 case err of 291 Http.BadStatus { status } -> 292 if status.code == 401 then 293 [ RedirectToLogin ] 294 295 else 296 [] 297 298 _ -> 299 [] 300 301 302permalink : List Concourse.Build -> Page 303permalink builds = 304 case List.head builds of 305 Nothing -> 306 { direction = Concourse.Pagination.ToMostRecent 307 , limit = pageLimit 308 } 309 310 Just build -> 311 { direction = Concourse.Pagination.To build.id 312 , limit = List.length builds 313 } 314 315 316paginatedMap : (a -> b) -> Paginated a -> Paginated b 317paginatedMap promoter pagA = 318 { content = 319 List.map promoter pagA.content 320 , pagination = pagA.pagination 321 } 322 323 324setResourcesToOld : Maybe BuildWithResources -> BuildWithResources -> BuildWithResources 325setResourcesToOld existingBuildWithResource newBwr = 326 case existingBuildWithResource of 327 Nothing -> 328 newBwr 329 330 Just buildWithResources -> 331 { newBwr 332 | resources = buildWithResources.resources 333 } 334 335 336existingBuild : Concourse.Build -> BuildWithResources -> Bool 337existingBuild build buildWithResources = 338 build == buildWithResources.build 339 340 341promoteBuild : Model -> Concourse.Build -> BuildWithResources 342promoteBuild model build = 343 let 344 newBwr = 345 { build = build 346 , resources = Nothing 347 } 348 349 existingBuildWithResource = 350 case model.buildsWithResources of 351 RemoteData.Success bwrs -> 352 List.Extra.find (existingBuild build) bwrs.content 353 354 _ -> 355 Nothing 356 in 357 setResourcesToOld existingBuildWithResource newBwr 358 359 360setExistingResources : Paginated Concourse.Build -> Model -> Paginated BuildWithResources 361setExistingResources paginatedBuilds model = 362 paginatedMap (promoteBuild model) paginatedBuilds 363 364 365updateResourcesIfNeeded : BuildWithResources -> Maybe Effect 366updateResourcesIfNeeded bwr = 367 case ( bwr.resources, isRunning bwr.build ) of 368 ( Just _, False ) -> 369 Nothing 370 371 _ -> 372 Just <| FetchBuildResources bwr.build.id 373 374 375handleJobBuildsFetched : Page -> Paginated Concourse.Build -> ET Model 376handleJobBuildsFetched requestedPage paginatedBuilds ( model, effects ) = 377 let 378 newPage = 379 permalink paginatedBuilds.content 380 381 newBWRs = 382 setExistingResources paginatedBuilds model 383 in 384 if 385 Concourse.Pagination.isPreviousPage requestedPage 386 && (List.length paginatedBuilds.content < pageLimit) 387 then 388 ( model 389 , effects 390 ++ [ FetchJobBuilds model.jobIdentifier startingPage 391 , NavigateTo <| 392 Routes.toString <| 393 Routes.Job 394 { id = model.jobIdentifier 395 , page = Just startingPage 396 } 397 ] 398 ) 399 400 else 401 ( { model 402 | buildsWithResources = RemoteData.Success newBWRs 403 , currentPage = newPage 404 } 405 , effects ++ List.filterMap updateResourcesIfNeeded newBWRs.content 406 ) 407 408 409isRunning : Concourse.Build -> Bool 410isRunning build = 411 Concourse.BuildStatus.isRunning build.status 412 413 414documentTitle : Model -> String 415documentTitle model = 416 model.jobIdentifier.jobName 417 418 419view : Session -> Model -> Html Message 420view session model = 421 let 422 route = 423 Routes.Job 424 { id = model.jobIdentifier 425 , page = Just model.currentPage 426 } 427 in 428 Html.div 429 (id "page-including-top-bar" :: Views.Styles.pageIncludingTopBar) 430 [ Html.div 431 (id "top-bar-app" :: Views.Styles.topBar False) 432 [ SideBar.hamburgerMenu session 433 , TopBar.concourseLogo 434 , TopBar.breadcrumbs route 435 , Login.view session.userState model 436 ] 437 , Html.div 438 (id "page-below-top-bar" :: Views.Styles.pageBelowTopBar route) 439 [ SideBar.view session 440 (Just 441 { pipelineName = model.jobIdentifier.pipelineName 442 , teamName = model.jobIdentifier.teamName 443 } 444 ) 445 , viewMainJobsSection session model 446 ] 447 ] 448 449 450tooltip : Model -> a -> Maybe Tooltip.Tooltip 451tooltip _ _ = 452 Nothing 453 454 455viewMainJobsSection : Session -> Model -> Html Message 456viewMainJobsSection session model = 457 let 458 archived = 459 isPipelineArchived 460 session.pipelines 461 model.jobIdentifier 462 in 463 Html.div 464 [ class "with-fixed-header" 465 , style "flex-grow" "1" 466 , style "display" "flex" 467 , style "flex-direction" "column" 468 ] 469 [ case model.job |> RemoteData.toMaybe of 470 Nothing -> 471 LoadingIndicator.view 472 473 Just job -> 474 let 475 toggleHovered = 476 HoverState.isHovered ToggleJobButton session.hovered 477 478 triggerHovered = 479 HoverState.isHovered TriggerBuildButton session.hovered 480 in 481 Html.div [ class "fixed-header" ] 482 [ Html.div 483 [ class "build-header" 484 , style "display" "flex" 485 , style "justify-content" "space-between" 486 , style "background" <| 487 Colors.buildStatusColor True <| 488 headerBuildStatus job.finishedBuild 489 ] 490 [ Html.div 491 [ style "display" "flex" ] 492 [ if archived then 493 Html.text "" 494 495 else 496 Html.button 497 ([ id "pause-toggle" 498 , onMouseEnter <| Hover <| Just ToggleJobButton 499 , onMouseLeave <| Hover Nothing 500 , onClick <| Click ToggleJobButton 501 ] 502 ++ (Styles.triggerButton False toggleHovered <| 503 headerBuildStatus job.finishedBuild 504 ) 505 ) 506 [ Icon.icon 507 { sizePx = 40 508 , image = 509 Assets.CircleOutlineIcon <| 510 if job.paused then 511 Assets.PlayCircleIcon 512 513 else 514 Assets.PauseCircleIcon 515 } 516 (Styles.icon toggleHovered) 517 ] 518 , Html.h1 [] 519 [ Html.span 520 [ class "build-name" ] 521 [ Html.text job.name ] 522 ] 523 ] 524 , if archived then 525 Html.text "" 526 527 else 528 Html.button 529 ([ class "trigger-build" 530 , onLeftClick <| Click TriggerBuildButton 531 , attribute "aria-label" "Trigger Build" 532 , attribute "title" "Trigger Build" 533 , onMouseEnter <| Hover <| Just TriggerBuildButton 534 , onMouseLeave <| Hover Nothing 535 ] 536 ++ (Styles.triggerButton job.disableManualTrigger triggerHovered <| 537 headerBuildStatus job.finishedBuild 538 ) 539 ) 540 <| 541 [ Icon.icon 542 { sizePx = 40 543 , image = Assets.AddCircleIcon |> Assets.CircleOutlineIcon 544 } 545 (Styles.icon <| 546 triggerHovered 547 && not job.disableManualTrigger 548 ) 549 ] 550 ++ (if job.disableManualTrigger && triggerHovered then 551 [ Html.div 552 Styles.triggerTooltip 553 [ Html.text <| 554 "manual triggering disabled " 555 ++ "in job config" 556 ] 557 ] 558 559 else 560 [] 561 ) 562 ] 563 , Html.div 564 [ id "pagination-header" 565 , style "display" "flex" 566 , style "justify-content" "space-between" 567 , style "align-items" "stretch" 568 , style "height" "60px" 569 , style "background-color" Colors.secondaryTopBar 570 ] 571 [ Html.h1 572 [ style "margin" "0 18px" ] 573 [ Html.text "builds" ] 574 , viewPaginationBar session model 575 ] 576 ] 577 , case model.buildsWithResources of 578 RemoteData.Success { content } -> 579 if List.isEmpty content then 580 Html.div Styles.noBuildsMessage 581 [ Html.text <| 582 "no builds for job “" 583 ++ model.jobIdentifier.jobName 584 ++ "”" 585 ] 586 587 else 588 Html.div 589 [ class "scrollable-body job-body" 590 , style "overflow-y" "auto" 591 ] 592 [ Html.ul [ class "jobs-builds-list builds-list" ] <| 593 List.map (viewBuildWithResources session model) content 594 ] 595 596 _ -> 597 LoadingIndicator.view 598 ] 599 600 601isPipelineArchived : 602 WebData (List Concourse.Pipeline) 603 -> Concourse.JobIdentifier 604 -> Bool 605isPipelineArchived pipelines { pipelineName, teamName } = 606 pipelines 607 |> RemoteData.withDefault [] 608 |> List.Extra.find (\p -> p.name == pipelineName && p.teamName == teamName) 609 |> Maybe.map .archived 610 |> Maybe.withDefault False 611 612 613headerBuildStatus : Maybe Concourse.Build -> BuildStatus 614headerBuildStatus finishedBuild = 615 case finishedBuild of 616 Nothing -> 617 BuildStatusPending 618 619 Just build -> 620 build.status 621 622 623viewPaginationBar : { a | hovered : HoverState.HoverState } -> Model -> Html Message 624viewPaginationBar session model = 625 Html.div 626 [ id "pagination" 627 , style "display" "flex" 628 , style "align-items" "stretch" 629 ] 630 (case model.buildsWithResources of 631 RemoteData.Success { pagination } -> 632 [ case pagination.previousPage of 633 Nothing -> 634 Html.div 635 chevronContainer 636 [ Html.div 637 (chevronLeft 638 { enabled = False 639 , hovered = False 640 } 641 ) 642 [] 643 ] 644 645 Just page -> 646 let 647 jobRoute = 648 Routes.Job { id = model.jobIdentifier, page = Just page } 649 in 650 Html.div 651 ([ onMouseEnter <| Hover <| Just PreviousPageButton 652 , onMouseLeave <| Hover Nothing 653 ] 654 ++ chevronContainer 655 ) 656 [ Html.a 657 ([ StrictEvents.onLeftClick <| GoToRoute jobRoute 658 , href <| Routes.toString <| jobRoute 659 , attribute "aria-label" "Previous Page" 660 ] 661 ++ chevronLeft 662 { enabled = True 663 , hovered = 664 HoverState.isHovered 665 PreviousPageButton 666 session.hovered 667 } 668 ) 669 [] 670 ] 671 , case pagination.nextPage of 672 Nothing -> 673 Html.div 674 chevronContainer 675 [ Html.div 676 (chevronRight 677 { enabled = False 678 , hovered = False 679 } 680 ) 681 [] 682 ] 683 684 Just page -> 685 let 686 jobRoute = 687 Routes.Job { id = model.jobIdentifier, page = Just page } 688 in 689 Html.div 690 ([ onMouseEnter <| Hover <| Just NextPageButton 691 , onMouseLeave <| Hover Nothing 692 ] 693 ++ chevronContainer 694 ) 695 [ Html.a 696 ([ StrictEvents.onLeftClick <| GoToRoute jobRoute 697 , href <| Routes.toString jobRoute 698 , attribute "aria-label" "Next Page" 699 ] 700 ++ chevronRight 701 { enabled = True 702 , hovered = 703 HoverState.isHovered 704 NextPageButton 705 session.hovered 706 } 707 ) 708 [] 709 ] 710 ] 711 712 _ -> 713 [ Html.div 714 chevronContainer 715 [ Html.div 716 (chevronLeft 717 { enabled = False 718 , hovered = False 719 } 720 ) 721 [] 722 ] 723 , Html.div 724 chevronContainer 725 [ Html.div 726 (chevronRight 727 { enabled = False 728 , hovered = False 729 } 730 ) 731 [] 732 ] 733 ] 734 ) 735 736 737viewBuildWithResources : 738 Session 739 -> Model 740 -> BuildWithResources 741 -> Html Message 742viewBuildWithResources session model bwr = 743 Html.li [ class "js-build" ] <| 744 let 745 buildResourcesView = 746 viewBuildResources bwr 747 in 748 [ viewBuildHeader bwr.build 749 , Html.div [ class "pam clearfix" ] <| 750 BuildDuration.view session.timeZone bwr.build.duration model.now 751 :: buildResourcesView 752 ] 753 754 755viewBuildHeader : Concourse.Build -> Html Message 756viewBuildHeader b = 757 Html.a 758 [ class <| Concourse.BuildStatus.show b.status 759 , StrictEvents.onLeftClick <| 760 GoToRoute <| 761 Routes.buildRoute b.id b.name b.job 762 , href <| 763 Routes.toString <| 764 Routes.buildRoute b.id b.name b.job 765 ] 766 [ Html.text ("#" ++ b.name) 767 ] 768 769 770viewBuildResources : BuildWithResources -> List (Html Message) 771viewBuildResources buildWithResources = 772 let 773 inputsTable = 774 case buildWithResources.resources of 775 Nothing -> 776 LoadingIndicator.view 777 778 Just resources -> 779 Html.table [ class "build-resources" ] <| 780 List.map viewBuildInputs resources.inputs 781 782 outputsTable = 783 case buildWithResources.resources of 784 Nothing -> 785 LoadingIndicator.view 786 787 Just resources -> 788 Html.table [ class "build-resources" ] <| 789 List.map viewBuildOutputs resources.outputs 790 in 791 [ Html.div [ class "inputs mrl" ] 792 [ Html.div 793 Styles.buildResourceHeader 794 [ Icon.icon 795 { sizePx = 12 796 , image = Assets.DownArrow 797 } 798 Styles.buildResourceIcon 799 , Html.text "inputs" 800 ] 801 , inputsTable 802 ] 803 , Html.div [ class "outputs mrl" ] 804 [ Html.div 805 Styles.buildResourceHeader 806 [ Icon.icon 807 { sizePx = 12 808 , image = Assets.UpArrow 809 } 810 Styles.buildResourceIcon 811 , Html.text "outputs" 812 ] 813 , outputsTable 814 ] 815 ] 816 817 818viewBuildInputs : Concourse.BuildResourcesInput -> Html Message 819viewBuildInputs bi = 820 Html.tr [ class "mbs pas resource fl clearfix" ] 821 [ Html.td [ class "resource-name mrm" ] 822 [ Html.text bi.name 823 ] 824 , Html.td [ class "resource-version" ] 825 [ viewVersion bi.version 826 ] 827 ] 828 829 830viewBuildOutputs : Concourse.BuildResourcesOutput -> Html Message 831viewBuildOutputs bo = 832 Html.tr [ class "mbs pas resource fl clearfix" ] 833 [ Html.td [ class "resource-name mrm" ] 834 [ Html.text bo.name 835 ] 836 , Html.td [ class "resource-version" ] 837 [ viewVersion bo.version 838 ] 839 ] 840 841 842viewVersion : Concourse.Version -> Html Message 843viewVersion version = 844 version 845 |> Dict.map (always Html.text) 846 |> DictView.view [] 847