github.com/pf-qiu/concourse/v6@v6.7.3-0.20201207032516-1f455d73275f/web/elm/src/Resource/Resource.elm (about) 1 module Resource.Resource exposing 2 ( Flags 3 , changeToResource 4 , documentTitle 5 , getUpdateMessage 6 , handleCallback 7 , handleDelivery 8 , init 9 , startingPage 10 , subscriptions 11 , tooltip 12 , update 13 , versions 14 , view 15 , viewPinButton 16 , viewVersionBody 17 , viewVersionHeader 18 ) 19 20 import Api.Endpoints as Endpoints 21 import Application.Models exposing (Session) 22 import Assets 23 import Build.Output.Models exposing (OutputModel) 24 import Build.Output.Output 25 import Build.StepTree.Models as STModels 26 import Build.StepTree.StepTree as StepTree 27 import Concourse 28 import Concourse.BuildStatus 29 import Concourse.Pagination 30 exposing 31 ( Direction(..) 32 , Page 33 , Paginated 34 , chevronContainer 35 , chevronLeft 36 , chevronRight 37 , equal 38 ) 39 import DateFormat 40 import Dict 41 import Duration 42 import EffectTransformer exposing (ET) 43 import HoverState 44 import Html exposing (Html) 45 import Html.Attributes 46 exposing 47 ( attribute 48 , class 49 , href 50 , id 51 , readonly 52 , style 53 , title 54 , value 55 ) 56 import Html.Events 57 exposing 58 ( onBlur 59 , onClick 60 , onFocus 61 , onInput 62 , onMouseEnter 63 , onMouseLeave 64 , onMouseOut 65 , onMouseOver 66 ) 67 import Html.Lazy 68 import Http 69 import Keyboard 70 import List.Extra 71 import Login.Login as Login 72 import Maybe.Extra as ME 73 import Message.Callback exposing (Callback(..)) 74 import Message.Effects as Effects exposing (Effect(..), toHtmlID) 75 import Message.Message as Message 76 exposing 77 ( DomID(..) 78 , Message(..) 79 ) 80 import Message.Subscription as Subscription 81 exposing 82 ( Delivery(..) 83 , Interval(..) 84 , Subscription(..) 85 ) 86 import Message.TopLevelMessage exposing (TopLevelMessage(..)) 87 import Pinned exposing (ResourcePinState(..), VersionPinState(..)) 88 import RemoteData exposing (WebData) 89 import Resource.Models as Models exposing (Model) 90 import Resource.Styles 91 import Routes 92 import SideBar.SideBar as SideBar 93 import StrictEvents 94 import Svg 95 import Svg.Attributes as SvgAttributes 96 import Time 97 import Tooltip 98 import UpdateMsg exposing (UpdateMsg) 99 import UserState exposing (UserState(..)) 100 import Views.DictView as DictView 101 import Views.Icon as Icon 102 import Views.Spinner as Spinner 103 import Views.Styles 104 import Views.TopBar as TopBar 105 106 107 type alias Flags = 108 { resourceId : Concourse.ResourceIdentifier 109 , paging : Maybe Concourse.Pagination.Page 110 } 111 112 113 pageLimit : Int 114 pageLimit = 115 100 116 117 118 startingPage : Page 119 startingPage = 120 { direction = ToMostRecent, limit = pageLimit } 121 122 123 init : Flags -> ( Model, List Effect ) 124 init flags = 125 let 126 page = 127 flags.paging |> Maybe.withDefault startingPage 128 129 model = 130 { resourceIdentifier = flags.resourceId 131 , pageStatus = Err Models.Empty 132 , checkStatus = Models.NotChecking 133 , lastChecked = Nothing 134 , pinnedVersion = NotPinned 135 , currentPage = page 136 , versions = 137 { content = [] 138 , pagination = { previousPage = Nothing, nextPage = Nothing } 139 } 140 , now = Nothing 141 , pinCommentLoading = False 142 , textAreaFocused = False 143 , isUserMenuExpanded = False 144 , icon = Nothing 145 , isEditing = False 146 , build = Nothing 147 , authorized = True 148 , output = Nothing 149 , highlight = Routes.HighlightNothing 150 } 151 in 152 ( model 153 , [ FetchResource flags.resourceId 154 , FetchVersionedResources flags.resourceId page 155 , GetCurrentTimeZone 156 , FetchAllPipelines 157 , SyncTextareaHeight ResourceCommentTextarea 158 ] 159 ) 160 161 162 changeToResource : Flags -> ET Model 163 changeToResource flags ( model, effects ) = 164 let 165 page = 166 flags.paging |> Maybe.withDefault startingPage 167 in 168 ( { model 169 | currentPage = page 170 , versions = 171 { content = [] 172 , pagination = { previousPage = Nothing, nextPage = Nothing } 173 } 174 } 175 , effects 176 ++ [ FetchVersionedResources model.resourceIdentifier page 177 , SyncTextareaHeight ResourceCommentTextarea 178 ] 179 ) 180 181 182 initBuild : Maybe Concourse.Build -> ET Model 183 initBuild mbuild ( model, effects ) = 184 case mbuild of 185 Nothing -> 186 ( model, effects ) 187 188 Just build -> 189 if Maybe.map .id model.build == Just build.id then 190 ( { model | build = Just build }, effects ) 191 192 else 193 let 194 ( output, outputCmd ) = 195 Build.Output.Output.init model.highlight build 196 in 197 ( { model | build = Just build, output = Just output } 198 , effects ++ outputCmd 199 ) 200 201 202 updatePinnedVersion : Concourse.Resource -> Model -> Model 203 updatePinnedVersion resource model = 204 case ( resource.pinnedVersion, resource.pinnedInConfig ) of 205 ( Nothing, _ ) -> 206 case model.pinnedVersion of 207 PinningTo _ -> 208 model 209 210 _ -> 211 { model | pinnedVersion = NotPinned } 212 213 ( Just v, True ) -> 214 { model | pinnedVersion = PinnedStaticallyTo v } 215 216 ( Just newVersion, False ) -> 217 let 218 pristineComment = 219 resource.pinComment |> Maybe.withDefault "" 220 in 221 case model.pinnedVersion of 222 UnpinningFrom c _ -> 223 { model | pinnedVersion = UnpinningFrom c newVersion } 224 225 PinnedDynamicallyTo { comment } _ -> 226 { model 227 | pinnedVersion = 228 PinnedDynamicallyTo 229 { comment = comment 230 , pristineComment = pristineComment 231 } 232 newVersion 233 } 234 235 Switching _ v _ -> 236 if v == newVersion then 237 model 238 239 else 240 { model 241 | pinnedVersion = 242 PinnedDynamicallyTo 243 { comment = pristineComment 244 , pristineComment = pristineComment 245 } 246 newVersion 247 } 248 249 _ -> 250 { model 251 | pinnedVersion = 252 PinnedDynamicallyTo 253 { comment = pristineComment 254 , pristineComment = pristineComment 255 } 256 newVersion 257 } 258 259 260 getUpdateMessage : Model -> UpdateMsg 261 getUpdateMessage model = 262 if model.pageStatus == Err Models.NotFound then 263 UpdateMsg.NotFound 264 265 else 266 UpdateMsg.AOK 267 268 269 subscriptions : Model -> List Subscription 270 subscriptions model = 271 let 272 buildEventsUrl = 273 model.output 274 |> Maybe.andThen .eventStreamUrlPath 275 in 276 [ OnClockTick Subscription.FiveSeconds 277 , OnClockTick Subscription.OneSecond 278 , OnKeyDown 279 , OnKeyUp 280 , OnWindowResize 281 ] 282 ++ (case buildEventsUrl of 283 Nothing -> 284 [] 285 286 Just url -> 287 [ Subscription.FromEventSource ( url, [ "end", "event" ] ) ] 288 ) 289 290 291 handleCallback : Callback -> Session -> ET Model 292 handleCallback callback session ( model, effects ) = 293 case callback of 294 ResourceFetched (Ok resource) -> 295 ( { model 296 | pageStatus = Ok () 297 , resourceIdentifier = 298 { teamName = resource.teamName 299 , pipelineName = resource.pipelineName 300 , resourceName = resource.name 301 } 302 , checkStatus = 303 case resource.build of 304 Nothing -> 305 Models.NotChecking 306 307 Just { id, status } -> 308 case status of 309 Concourse.BuildStatus.BuildStatusSucceeded -> 310 Models.NotChecking 311 312 Concourse.BuildStatus.BuildStatusStarted -> 313 Models.CurrentlyChecking id 314 315 _ -> 316 Models.NotChecking 317 , lastChecked = resource.lastChecked 318 , icon = resource.icon 319 } 320 |> updatePinnedVersion resource 321 , effects 322 ++ (case resource.icon of 323 Just icon -> 324 [ RenderSvgIcon <| icon ] 325 326 Nothing -> 327 [] 328 ) 329 ++ [ SyncTextareaHeight ResourceCommentTextarea ] 330 ) 331 |> initBuild resource.build 332 333 ResourceFetched (Err err) -> 334 case err of 335 Http.BadStatus { status } -> 336 if status.code == 401 then 337 ( model, effects ++ [ RedirectToLogin ] ) 338 339 else if status.code == 404 then 340 ( { model | pageStatus = Err Models.NotFound }, effects ) 341 342 else 343 ( model, effects ) 344 345 _ -> 346 ( model, effects ) 347 348 VersionedResourcesFetched (Ok ( requestedPage, paginated )) -> 349 let 350 resourceVersions = 351 { pagination = paginated.pagination 352 , content = 353 paginated.content 354 |> List.map 355 (\vr -> 356 let 357 existingVersion : Maybe Models.Version 358 existingVersion = 359 model.versions.content 360 |> List.Extra.find 361 (\v -> 362 v.id.versionID == vr.id 363 ) 364 365 enabledStateAccordingToServer : Models.VersionEnabledState 366 enabledStateAccordingToServer = 367 if vr.enabled then 368 Models.Enabled 369 370 else 371 Models.Disabled 372 in 373 case existingVersion of 374 Just ev -> 375 { ev 376 | enabled = 377 if ev.enabled == Models.Changing then 378 Models.Changing 379 380 else 381 enabledStateAccordingToServer 382 } 383 384 Nothing -> 385 { id = 386 { teamName = model.resourceIdentifier.teamName 387 , pipelineName = model.resourceIdentifier.pipelineName 388 , resourceName = model.resourceIdentifier.resourceName 389 , versionID = vr.id 390 } 391 , version = vr.version 392 , metadata = vr.metadata 393 , enabled = enabledStateAccordingToServer 394 , expanded = False 395 , inputTo = [] 396 , outputOf = [] 397 , showTooltip = False 398 } 399 ) 400 } 401 402 newModel = 403 \newPage newEffects -> 404 ( { model 405 | versions = resourceVersions 406 , currentPage = newPage 407 } 408 , newEffects 409 ) 410 in 411 if 412 Concourse.Pagination.isPreviousPage requestedPage 413 && (List.length resourceVersions.content < pageLimit) 414 then 415 -- otherwise a new version would show up as a single element page 416 newModel startingPage <| 417 effects 418 ++ [ FetchVersionedResources model.resourceIdentifier startingPage 419 , NavigateTo <| 420 Routes.toString <| 421 Routes.Resource 422 { id = model.resourceIdentifier 423 , page = Just startingPage 424 } 425 ] 426 427 else if Concourse.Pagination.equal model.currentPage requestedPage then 428 newModel requestedPage effects 429 430 else 431 ( model, effects ) 432 433 InputToFetched (Ok ( versionID, builds )) -> 434 ( updateVersion versionID (\v -> { v | inputTo = builds }) model 435 , effects 436 ) 437 438 OutputOfFetched (Ok ( versionID, builds )) -> 439 ( updateVersion versionID (\v -> { v | outputOf = builds }) model 440 , effects 441 ) 442 443 VersionPinned (Ok ()) -> 444 case ( session.userState, model.now ) of 445 ( UserStateLoggedIn user, Just time ) -> 446 let 447 pinningTo = 448 case model.pinnedVersion of 449 PinningTo pt -> 450 Just pt 451 452 Switching _ _ pt -> 453 Just pt 454 455 _ -> 456 Nothing 457 458 commentText = 459 "pinned by " 460 ++ Login.userDisplayName user 461 ++ " at " 462 ++ formatDate session.timeZone time 463 in 464 ( { model 465 | pinnedVersion = 466 model.versions.content 467 |> List.Extra.find (\v -> Just v.id == pinningTo) 468 |> Maybe.map .version 469 |> Maybe.map 470 (PinnedDynamicallyTo 471 { comment = commentText 472 , pristineComment = "" 473 } 474 ) 475 |> Maybe.withDefault NotPinned 476 } 477 , effects 478 ++ [ SetPinComment 479 model.resourceIdentifier 480 commentText 481 ] 482 ) 483 484 _ -> 485 ( model, effects ) 486 487 VersionPinned (Err _) -> 488 ( { model | pinnedVersion = NotPinned } 489 , effects 490 ) 491 492 VersionUnpinned (Ok ()) -> 493 ( { model | pinnedVersion = NotPinned } 494 , effects ++ [ FetchResource model.resourceIdentifier ] 495 ) 496 497 VersionUnpinned (Err _) -> 498 ( { model | pinnedVersion = Pinned.quitUnpinning model.pinnedVersion } 499 , effects 500 ) 501 502 VersionToggled action versionID result -> 503 let 504 newEnabledState : Models.VersionEnabledState 505 newEnabledState = 506 case ( result, action ) of 507 ( Ok (), Message.Enable ) -> 508 Models.Enabled 509 510 ( Ok (), Message.Disable ) -> 511 Models.Disabled 512 513 ( Err _, Message.Enable ) -> 514 Models.Disabled 515 516 ( Err _, Message.Disable ) -> 517 Models.Enabled 518 in 519 ( updateVersion versionID (\v -> { v | enabled = newEnabledState }) model 520 , effects 521 ) 522 523 Checked (Ok _) -> 524 ( model, effects ++ [ FetchResource model.resourceIdentifier ] ) 525 526 Checked (Err (Http.BadStatus { status })) -> 527 ( model 528 , if status.code == 401 then 529 effects ++ [ RedirectToLogin ] 530 531 else 532 effects 533 ) 534 535 CommentSet result -> 536 ( { model 537 | pinCommentLoading = False 538 , pinnedVersion = 539 case ( result, model.pinnedVersion ) of 540 ( Ok (), PinnedDynamicallyTo { comment } v ) -> 541 PinnedDynamicallyTo 542 { comment = comment 543 , pristineComment = comment 544 } 545 v 546 547 ( _, pv ) -> 548 pv 549 , isEditing = result /= Ok () 550 } 551 , effects 552 ++ [ FetchResource model.resourceIdentifier 553 , SyncTextareaHeight ResourceCommentTextarea 554 ] 555 ) 556 557 PlanAndResourcesFetched buildId (Ok planAndResources) -> 558 updateOutput 559 (Build.Output.Output.planAndResourcesFetched 560 buildId 561 planAndResources 562 ) 563 ( model 564 , effects 565 ++ [ Effects.OpenBuildEventStream 566 { url = 567 Endpoints.BuildEventStream 568 |> Endpoints.Build buildId 569 |> Endpoints.toString [] 570 , eventTypes = [ "end", "event" ] 571 } 572 ] 573 ) 574 575 PlanAndResourcesFetched _ (Err err) -> 576 case err of 577 Http.BadStatus { status } -> 578 if status.code == 401 || status.code == 403 then 579 ( { model | authorized = False }, effects ) 580 581 else 582 ( model, effects ) 583 584 _ -> 585 ( model, effects ) 586 587 _ -> 588 ( model, effects ) 589 590 591 handleDelivery : { a | hovered : HoverState.HoverState } -> Delivery -> ET Model 592 handleDelivery session delivery ( model, effects ) = 593 (case delivery of 594 KeyDown keyEvent -> 595 if 596 (keyEvent.code == Keyboard.Enter) 597 && Keyboard.hasControlModifier keyEvent 598 && model.textAreaFocused 599 then 600 ( model 601 , case model.pinnedVersion of 602 PinnedDynamicallyTo { comment } _ -> 603 effects ++ [ SetPinComment model.resourceIdentifier comment ] 604 605 _ -> 606 effects 607 ) 608 609 else 610 ( model, effects ) 611 612 ClockTicked OneSecond time -> 613 ( { model | now = Just time } 614 , case session.hovered of 615 HoverState.Hovered (StepState stepID) -> 616 [ GetViewportOf (StepState stepID) ] 617 618 _ -> 619 [] 620 ) 621 622 ClockTicked FiveSeconds _ -> 623 ( model 624 , effects 625 ++ [ FetchResource model.resourceIdentifier 626 , FetchVersionedResources model.resourceIdentifier model.currentPage 627 , FetchAllPipelines 628 ] 629 ++ fetchDataForExpandedVersions model 630 ) 631 632 WindowResized _ _ -> 633 ( model 634 , effects ++ [ SyncTextareaHeight ResourceCommentTextarea ] 635 ) 636 637 EventsReceived (Ok envelopes) -> 638 let 639 ended = 640 List.any (\{ data } -> data == STModels.End) envelopes 641 in 642 updateOutput 643 (Build.Output.Output.handleEnvelopes envelopes) 644 ( model 645 , effects 646 ++ (if ended then 647 [ FetchResource model.resourceIdentifier 648 , FetchVersionedResources model.resourceIdentifier model.currentPage 649 ] 650 651 else 652 [] 653 ) 654 ) 655 656 _ -> 657 ( model, effects ) 658 ) 659 |> Tooltip.handleDelivery session delivery 660 661 662 update : Message -> ET Model 663 update msg ( model, effects ) = 664 case msg of 665 Click (PaginationButton page) -> 666 ( { model | currentPage = page } 667 , effects 668 ++ [ FetchVersionedResources model.resourceIdentifier <| page 669 , NavigateTo <| 670 Routes.toString <| 671 Routes.Resource 672 { id = model.resourceIdentifier 673 , page = Just page 674 } 675 ] 676 ) 677 678 Click (VersionHeader versionID) -> 679 let 680 version : Maybe Models.Version 681 version = 682 model.versions.content 683 |> List.Extra.find (.id >> (==) versionID) 684 685 newExpandedState : Bool 686 newExpandedState = 687 case version of 688 Just v -> 689 not v.expanded 690 691 Nothing -> 692 False 693 in 694 ( updateVersion 695 versionID 696 (\v -> 697 { v | expanded = newExpandedState } 698 ) 699 model 700 , if newExpandedState then 701 effects 702 ++ [ FetchInputTo versionID 703 , FetchOutputOf versionID 704 ] 705 706 else 707 effects 708 ) 709 710 Click (PinButton versionID) -> 711 let 712 version : Maybe Models.Version 713 version = 714 model.versions.content 715 |> List.Extra.find (\v -> v.id == versionID) 716 in 717 case model.pinnedVersion of 718 PinnedDynamicallyTo _ v -> 719 version 720 |> Maybe.map 721 (\vn -> 722 if vn.version == v then 723 ( { model 724 | pinnedVersion = 725 Pinned.startUnpinning model.pinnedVersion 726 } 727 , effects 728 ++ [ DoUnpinVersion model.resourceIdentifier ] 729 ) 730 731 else 732 ( { model 733 | pinnedVersion = 734 Pinned.startPinningTo versionID model.pinnedVersion 735 } 736 , effects 737 ++ [ DoPinVersion vn.id ] 738 ) 739 ) 740 |> Maybe.withDefault ( model, effects ) 741 742 NotPinned -> 743 ( { model 744 | pinnedVersion = 745 Pinned.startPinningTo versionID model.pinnedVersion 746 } 747 , case version of 748 Just _ -> 749 effects ++ [ DoPinVersion versionID ] 750 751 Nothing -> 752 effects 753 ) 754 755 _ -> 756 ( model, effects ) 757 758 Click PinIcon -> 759 case model.pinnedVersion of 760 PinnedDynamicallyTo _ _ -> 761 ( { model 762 | pinnedVersion = 763 Pinned.startUnpinning model.pinnedVersion 764 } 765 , effects ++ [ DoUnpinVersion model.resourceIdentifier ] 766 ) 767 768 _ -> 769 ( model, effects ) 770 771 Click (VersionToggle versionID) -> 772 let 773 enabledState : Maybe Models.VersionEnabledState 774 enabledState = 775 model.versions.content 776 |> List.Extra.find (.id >> (==) versionID) 777 |> Maybe.map .enabled 778 in 779 case enabledState of 780 Just Models.Enabled -> 781 ( updateVersion versionID 782 (\v -> 783 { v | enabled = Models.Changing } 784 ) 785 model 786 , effects ++ [ DoToggleVersion Message.Disable versionID ] 787 ) 788 789 Just Models.Disabled -> 790 ( updateVersion versionID 791 (\v -> 792 { v | enabled = Models.Changing } 793 ) 794 model 795 , effects ++ [ DoToggleVersion Message.Enable versionID ] 796 ) 797 798 _ -> 799 ( model, effects ) 800 801 Click (CheckButton isAuthorized) -> 802 if isAuthorized then 803 ( { model | checkStatus = Models.CheckPending } 804 , effects ++ [ DoCheck model.resourceIdentifier ] 805 ) 806 807 else 808 ( model, effects ++ [ RedirectToLogin ] ) 809 810 Click EditButton -> 811 ( { model | isEditing = True } 812 , effects ++ [ Focus (toHtmlID ResourceCommentTextarea) ] 813 ) 814 815 Click (StepHeader id) -> 816 updateOutput 817 (Build.Output.Output.handleStepTreeMsg <| StepTree.toggleStep id) 818 ( model, effects ) 819 820 Click (StepInitialization id) -> 821 updateOutput 822 (Build.Output.Output.handleStepTreeMsg <| StepTree.toggleStepInitialization id) 823 ( model, effects ++ [ SyncStickyBuildLogHeaders ] ) 824 825 EditComment input -> 826 let 827 newPinnedVersion = 828 case model.pinnedVersion of 829 PinnedDynamicallyTo { pristineComment } v -> 830 PinnedDynamicallyTo 831 { comment = input 832 , pristineComment = pristineComment 833 } 834 v 835 836 x -> 837 x 838 in 839 ( { model | pinnedVersion = newPinnedVersion } 840 , effects ++ [ SyncTextareaHeight ResourceCommentTextarea ] 841 ) 842 843 Click SaveCommentButton -> 844 case model.pinnedVersion of 845 PinnedDynamicallyTo commentState _ -> 846 let 847 commentChanged = 848 commentState.comment /= commentState.pristineComment 849 in 850 if commentChanged then 851 ( { model | pinCommentLoading = True } 852 , effects 853 ++ [ SetPinComment 854 model.resourceIdentifier 855 commentState.comment 856 ] 857 ) 858 859 else 860 ( model, effects ) 861 862 _ -> 863 ( model, effects ) 864 865 FocusTextArea -> 866 ( { model | textAreaFocused = True }, effects ) 867 868 BlurTextArea -> 869 ( { model | textAreaFocused = False }, effects ) 870 871 _ -> 872 ( model, effects ) 873 874 875 updateVersion : 876 Models.VersionId 877 -> (Models.Version -> Models.Version) 878 -> Model 879 -> Model 880 updateVersion versionID updateFunc model = 881 let 882 newVersionsContent : List Models.Version 883 newVersionsContent = 884 model.versions.content 885 |> List.Extra.updateIf (.id >> (==) versionID) updateFunc 886 887 resourceVersions : Paginated Models.Version 888 resourceVersions = 889 model.versions 890 in 891 { model | versions = { resourceVersions | content = newVersionsContent } } 892 893 894 documentTitle : Model -> String 895 documentTitle model = 896 model.resourceIdentifier.resourceName 897 898 899 type alias VersionPresenter = 900 { id : Models.VersionId 901 , version : Concourse.Version 902 , metadata : Concourse.Metadata 903 , enabled : Models.VersionEnabledState 904 , expanded : Bool 905 , inputTo : List Concourse.Build 906 , outputOf : List Concourse.Build 907 , pinState : VersionPinState 908 } 909 910 911 versions : 912 { a 913 | versions : Paginated Models.Version 914 , pinnedVersion : Models.PinnedVersion 915 } 916 -> List VersionPresenter 917 versions model = 918 model.versions.content 919 |> List.map 920 (\v -> 921 { id = v.id 922 , version = v.version 923 , metadata = v.metadata 924 , enabled = v.enabled 925 , expanded = v.expanded 926 , inputTo = v.inputTo 927 , outputOf = v.outputOf 928 , pinState = 929 case Pinned.pinState v.version v.id model.pinnedVersion of 930 PinnedStatically _ -> 931 PinnedStatically v.showTooltip 932 933 x -> 934 x 935 } 936 ) 937 938 939 view : Session -> Model -> Html Message 940 view session model = 941 let 942 route = 943 Routes.Resource 944 { id = model.resourceIdentifier 945 , page = Nothing 946 } 947 in 948 Html.div 949 (id "page-including-top-bar" :: Views.Styles.pageIncludingTopBar) 950 [ Html.div 951 (id "top-bar-app" :: Views.Styles.topBar False) 952 [ SideBar.hamburgerMenu session 953 , TopBar.concourseLogo 954 , TopBar.breadcrumbs route 955 , Login.view session.userState model 956 ] 957 , Html.div 958 (id "page-below-top-bar" :: Views.Styles.pageBelowTopBar route) 959 [ SideBar.view session 960 (Just 961 { pipelineName = model.resourceIdentifier.pipelineName 962 , teamName = model.resourceIdentifier.teamName 963 } 964 ) 965 , if model.pageStatus == Err Models.Empty then 966 Html.text "" 967 968 else 969 Html.div 970 [ style "flex-grow" "1" 971 , style "display" "flex" 972 , style "flex-direction" "column" 973 ] 974 [ header session model 975 , body session model 976 ] 977 ] 978 ] 979 980 981 tooltip : Model -> { a | hovered : HoverState.HoverState } -> Maybe Tooltip.Tooltip 982 tooltip model session = 983 model.output 984 |> Maybe.andThen .steps 985 |> Maybe.andThen (\steps -> StepTree.tooltip steps session) 986 987 988 header : Session -> Model -> Html Message 989 header session model = 990 let 991 archived = 992 isPipelineArchived 993 session.pipelines 994 model.resourceIdentifier 995 996 lastCheckedView = 997 case ( model.now, model.lastChecked, archived ) of 998 ( Just now, Just date, False ) -> 999 viewLastChecked session.timeZone now date 1000 1001 ( _, _, _ ) -> 1002 Html.text "" 1003 1004 iconView = 1005 case model.icon of 1006 Just icon -> 1007 Svg.svg 1008 [ style "height" "24px" 1009 , style "width" "24px" 1010 , style "margin-left" "-6px" 1011 , style "margin-right" "10px" 1012 , SvgAttributes.fill "white" 1013 ] 1014 [ Svg.use [ SvgAttributes.xlinkHref ("#" ++ icon ++ "-svg-icon") ] [] 1015 ] 1016 1017 Nothing -> 1018 Html.text "" 1019 in 1020 Html.div 1021 (id "page-header" :: Resource.Styles.headerBar) 1022 [ Html.h1 1023 Resource.Styles.headerResourceName 1024 [ iconView 1025 , Html.text model.resourceIdentifier.resourceName 1026 ] 1027 , Html.div 1028 Resource.Styles.headerLastCheckedSection 1029 [ lastCheckedView ] 1030 , paginationMenu session model 1031 ] 1032 1033 1034 body : 1035 { a 1036 | userState : UserState 1037 , pipelines : WebData (List Concourse.Pipeline) 1038 , hovered : HoverState.HoverState 1039 , timeZone : Time.Zone 1040 } 1041 -> Model 1042 -> Html Message 1043 body session model = 1044 let 1045 sectionModel = 1046 { checkStatus = model.checkStatus 1047 , build = model.build 1048 , hovered = session.hovered 1049 , userState = session.userState 1050 , timeZone = session.timeZone 1051 , teamName = model.resourceIdentifier.teamName 1052 , authorized = model.authorized 1053 , output = model.output 1054 } 1055 1056 archived = 1057 isPipelineArchived 1058 session.pipelines 1059 model.resourceIdentifier 1060 in 1061 Html.div 1062 (id "body" :: Resource.Styles.body) 1063 <| 1064 (if model.pinnedVersion == NotPinned then 1065 if archived then 1066 [] 1067 1068 else 1069 [ checkSection sectionModel ] 1070 1071 else 1072 [ pinTools session model ] 1073 ) 1074 ++ [ viewVersionedResources session model ] 1075 1076 1077 paginationMenu : 1078 { a | hovered : HoverState.HoverState } 1079 -> 1080 { b 1081 | versions : Paginated Models.Version 1082 , resourceIdentifier : Concourse.ResourceIdentifier 1083 } 1084 -> Html Message 1085 paginationMenu { hovered } model = 1086 let 1087 previousButtonEventHandler = 1088 case model.versions.pagination.previousPage of 1089 Nothing -> 1090 [] 1091 1092 Just pp -> 1093 [ onClick <| Click <| PaginationButton pp ] 1094 1095 nextButtonEventHandler = 1096 case model.versions.pagination.nextPage of 1097 Nothing -> 1098 [] 1099 1100 Just np -> 1101 let 1102 updatedPage = 1103 { np | limit = 100 } 1104 in 1105 [ onClick <| Click <| PaginationButton updatedPage ] 1106 in 1107 Html.div 1108 (id "pagination" :: Resource.Styles.pagination) 1109 [ case model.versions.pagination.previousPage of 1110 Nothing -> 1111 Html.div 1112 chevronContainer 1113 [ Html.div 1114 (chevronLeft 1115 { enabled = False 1116 , hovered = False 1117 } 1118 ) 1119 [] 1120 ] 1121 1122 Just page -> 1123 Html.div 1124 ([ onMouseEnter <| Hover <| Just Message.PreviousPageButton 1125 , onMouseLeave <| Hover Nothing 1126 ] 1127 ++ chevronContainer 1128 ++ previousButtonEventHandler 1129 ) 1130 [ Html.a 1131 ([ href <| 1132 Routes.toString <| 1133 Routes.Resource 1134 { id = model.resourceIdentifier 1135 , page = Just page 1136 } 1137 , attribute "aria-label" "Previous Page" 1138 ] 1139 ++ chevronLeft 1140 { enabled = True 1141 , hovered = HoverState.isHovered PreviousPageButton hovered 1142 } 1143 ) 1144 [] 1145 ] 1146 , case model.versions.pagination.nextPage of 1147 Nothing -> 1148 Html.div 1149 chevronContainer 1150 [ Html.div 1151 (chevronRight 1152 { enabled = False 1153 , hovered = False 1154 } 1155 ) 1156 [] 1157 ] 1158 1159 Just page -> 1160 Html.div 1161 ([ onMouseEnter <| Hover <| Just Message.NextPageButton 1162 , onMouseLeave <| Hover Nothing 1163 ] 1164 ++ chevronContainer 1165 ++ nextButtonEventHandler 1166 ) 1167 [ Html.a 1168 ([ href <| 1169 Routes.toString <| 1170 Routes.Resource 1171 { id = model.resourceIdentifier 1172 , page = Just page 1173 } 1174 , attribute "aria-label" "Next Page" 1175 ] 1176 ++ chevronRight 1177 { enabled = True 1178 , hovered = HoverState.isHovered NextPageButton hovered 1179 } 1180 ) 1181 [] 1182 ] 1183 ] 1184 1185 1186 checkSection : 1187 { a 1188 | checkStatus : Models.CheckStatus 1189 , build : Maybe Concourse.Build 1190 , hovered : HoverState.HoverState 1191 , userState : UserState 1192 , teamName : String 1193 , timeZone : Time.Zone 1194 , authorized : Bool 1195 , output : Maybe OutputModel 1196 } 1197 -> Html Message 1198 checkSection ({ checkStatus, build } as model) = 1199 let 1200 spinner = 1201 Spinner.spinner 1202 { sizePx = 14 1203 , margin = "7px" 1204 } 1205 1206 icon image = 1207 Icon.icon 1208 { sizePx = 28 1209 , image = image 1210 } 1211 Resource.Styles.checkStatusIcon 1212 1213 ( checkMessage, statusIcon ) = 1214 case Maybe.map .status build of 1215 Nothing -> 1216 ( "not checked yet", icon Assets.PendingIcon ) 1217 1218 Just Concourse.BuildStatus.BuildStatusFailed -> 1219 ( "check failed", icon Assets.FailureTimesIcon ) 1220 1221 Just Concourse.BuildStatus.BuildStatusPending -> 1222 ( "check pending", icon Assets.PendingIcon ) 1223 1224 Just Concourse.BuildStatus.BuildStatusStarted -> 1225 ( "check in progress", spinner ) 1226 1227 Just Concourse.BuildStatus.BuildStatusSucceeded -> 1228 ( "check succeeded", icon Assets.SuccessCheckIcon ) 1229 1230 Just Concourse.BuildStatus.BuildStatusErrored -> 1231 ( "check errored", icon Assets.ExclamationTriangleIcon ) 1232 1233 Just Concourse.BuildStatus.BuildStatusAborted -> 1234 ( "check aborted", icon Assets.InterruptedIcon ) 1235 1236 statusBar = 1237 Html.div 1238 (class "resource-check-status-summary" :: Resource.Styles.checkBarStatus) 1239 [ Html.h3 [] [ Html.text checkMessage ] 1240 , statusIcon 1241 ] 1242 1243 checkBar = 1244 Html.div 1245 [ style "display" "flex" ] 1246 [ checkButton model 1247 , Html.div Resource.Styles.checkStatus 1248 [ if model.authorized && model.output /= Nothing then 1249 Html.Lazy.lazy3 1250 viewBuildOutput 1251 model.timeZone 1252 (Build.Output.Output.filterHoverState model.hovered) 1253 model.output 1254 1255 else 1256 statusBar 1257 ] 1258 ] 1259 in 1260 Html.div [ class "resource-check-status" ] [ checkBar ] 1261 1262 1263 checkButton : 1264 { a 1265 | hovered : HoverState.HoverState 1266 , userState : UserState 1267 , teamName : String 1268 , checkStatus : Models.CheckStatus 1269 } 1270 -> Html Message 1271 checkButton ({ hovered, userState, checkStatus } as params) = 1272 let 1273 isMember = 1274 UserState.isMember params 1275 1276 isHovered = 1277 HoverState.isHovered (CheckButton isMember) hovered 1278 1279 isCurrentlyChecking = 1280 case checkStatus of 1281 Models.CheckPending -> 1282 True 1283 1284 Models.CurrentlyChecking _ -> 1285 True 1286 1287 _ -> 1288 False 1289 1290 isAnonymous = 1291 UserState.isAnonymous userState 1292 1293 isClickable = 1294 (isAnonymous || isMember) 1295 && not isCurrentlyChecking 1296 1297 isHighlighted = 1298 (isClickable && isHovered) || isCurrentlyChecking 1299 in 1300 Html.div 1301 ([ onMouseEnter <| Hover <| Just <| CheckButton isMember 1302 , onMouseLeave <| Hover Nothing 1303 ] 1304 ++ Resource.Styles.checkButton isClickable 1305 ++ (if isClickable then 1306 [ onClick <| Click <| CheckButton isMember ] 1307 1308 else 1309 [] 1310 ) 1311 ) 1312 [ Icon.icon 1313 { sizePx = 20 1314 , image = Assets.RefreshIcon 1315 } 1316 (Resource.Styles.checkButtonIcon isHighlighted) 1317 ] 1318 1319 1320 commentBar : 1321 { a 1322 | userState : UserState 1323 , pipelines : WebData (List Concourse.Pipeline) 1324 , hovered : HoverState.HoverState 1325 } 1326 -> 1327 { b 1328 | pinnedVersion : Models.PinnedVersion 1329 , resourceIdentifier : Concourse.ResourceIdentifier 1330 , pinCommentLoading : Bool 1331 , isEditing : Bool 1332 } 1333 -> Html Message 1334 commentBar session { resourceIdentifier, pinnedVersion, pinCommentLoading, isEditing } = 1335 case pinnedVersion of 1336 PinnedDynamicallyTo commentState _ -> 1337 Html.div 1338 (id "comment-bar" :: Resource.Styles.commentBar True) 1339 [ Html.div 1340 (id "icon-container" :: Resource.Styles.commentBarIconContainer isEditing) 1341 (Icon.icon 1342 { sizePx = 16 1343 , image = Assets.MessageIcon 1344 } 1345 Resource.Styles.commentBarMessageIcon 1346 :: (if 1347 UserState.isMember 1348 { teamName = resourceIdentifier.teamName 1349 , userState = session.userState 1350 } 1351 && not 1352 (isPipelineArchived 1353 session.pipelines 1354 resourceIdentifier 1355 ) 1356 then 1357 [ Html.textarea 1358 ([ id (toHtmlID ResourceCommentTextarea) 1359 , value commentState.comment 1360 , onInput EditComment 1361 , onFocus FocusTextArea 1362 , onBlur BlurTextArea 1363 , readonly (not isEditing) 1364 ] 1365 ++ Resource.Styles.commentTextArea 1366 ) 1367 [] 1368 , Html.div (id "edit-save-wrapper" :: Resource.Styles.editSaveWrapper) 1369 (if isEditing == False then 1370 [ editButton session ] 1371 1372 else 1373 [ saveButton commentState pinCommentLoading session.hovered ] 1374 ) 1375 ] 1376 1377 else 1378 [ Html.pre 1379 Resource.Styles.commentText 1380 [ Html.text commentState.pristineComment ] 1381 ] 1382 ) 1383 ) 1384 ] 1385 1386 _ -> 1387 Html.text "" 1388 1389 1390 editButton : { a | hovered : HoverState.HoverState } -> Html Message 1391 editButton session = 1392 Icon.icon 1393 { sizePx = 16 1394 , image = Assets.PencilIcon 1395 } 1396 ([ id "edit-button" 1397 , onMouseEnter <| Hover <| Just EditButton 1398 , onMouseLeave <| Hover Nothing 1399 , onClick <| Click EditButton 1400 ] 1401 ++ Resource.Styles.editButton (HoverState.isHovered EditButton session.hovered) 1402 ) 1403 1404 1405 saveButton : 1406 { s | comment : String, pristineComment : String } 1407 -> Bool 1408 -> HoverState.HoverState 1409 -> Html Message 1410 saveButton commentState pinCommentLoading hovered = 1411 Html.button 1412 (let 1413 commentChanged = 1414 commentState.comment 1415 /= commentState.pristineComment 1416 in 1417 [ id "save-button" 1418 , onMouseEnter <| Hover <| Just SaveCommentButton 1419 , onMouseLeave <| Hover Nothing 1420 , onClick <| Click SaveCommentButton 1421 ] 1422 ++ Resource.Styles.commentSaveButton 1423 { isHovered = HoverState.isHovered SaveCommentButton hovered 1424 , commentChanged = commentChanged 1425 , pinCommentLoading = pinCommentLoading 1426 } 1427 ) 1428 (if pinCommentLoading then 1429 [ Spinner.spinner 1430 { sizePx = 12 1431 , margin = "0" 1432 } 1433 ] 1434 1435 else 1436 [ Html.text "save" ] 1437 ) 1438 1439 1440 pinTools : 1441 { s 1442 | hovered : HoverState.HoverState 1443 , pipelines : WebData (List Concourse.Pipeline) 1444 , userState : UserState 1445 } 1446 -> 1447 { b 1448 | pinnedVersion : Models.PinnedVersion 1449 , resourceIdentifier : Concourse.ResourceIdentifier 1450 , pinCommentLoading : Bool 1451 , isEditing : Bool 1452 } 1453 -> Html Message 1454 pinTools session model = 1455 let 1456 pinBarVersion = 1457 Pinned.stable model.pinnedVersion 1458 in 1459 Html.div 1460 (id "pin-tools" :: Resource.Styles.pinTools (ME.isJust pinBarVersion)) 1461 [ pinBar session model 1462 , commentBar session model 1463 ] 1464 1465 1466 pinBar : 1467 { a 1468 | hovered : HoverState.HoverState 1469 , pipelines : WebData (List Concourse.Pipeline) 1470 } 1471 -> 1472 { b 1473 | pinnedVersion : Models.PinnedVersion 1474 , resourceIdentifier : Concourse.ResourceIdentifier 1475 } 1476 -> Html Message 1477 pinBar { hovered, pipelines } { pinnedVersion, resourceIdentifier } = 1478 let 1479 pinBarVersion = 1480 Pinned.stable pinnedVersion 1481 1482 attrList : List ( Html.Attribute Message, Bool ) -> List (Html.Attribute Message) 1483 attrList = 1484 List.filter Tuple.second >> List.map Tuple.first 1485 1486 isPinnedStatically = 1487 case pinnedVersion of 1488 PinnedStaticallyTo _ -> 1489 True 1490 1491 _ -> 1492 False 1493 1494 isPinnedDynamically = 1495 case pinnedVersion of 1496 PinnedDynamicallyTo _ _ -> 1497 True 1498 1499 _ -> 1500 False 1501 1502 archived = 1503 isPipelineArchived 1504 pipelines 1505 resourceIdentifier 1506 in 1507 Html.div 1508 (attrList 1509 [ ( id "pin-bar", True ) 1510 , ( onMouseEnter <| Hover <| Just PinBar, isPinnedStatically ) 1511 , ( onMouseLeave <| Hover Nothing, isPinnedStatically ) 1512 ] 1513 ++ Resource.Styles.pinBar (ME.isJust pinBarVersion) 1514 ) 1515 (Icon.icon 1516 { sizePx = 14 1517 , image = 1518 if ME.isJust pinBarVersion then 1519 Assets.PinIconWhite 1520 1521 else 1522 Assets.PinIconGrey 1523 } 1524 (attrList 1525 [ ( id "pin-icon", True ) 1526 , ( onClick <| Click PinIcon 1527 , isPinnedDynamically && not archived 1528 ) 1529 , ( onMouseEnter <| Hover <| Just PinIcon 1530 , isPinnedDynamically && not archived 1531 ) 1532 , ( onMouseLeave <| Hover Nothing, True ) 1533 ] 1534 ++ Resource.Styles.pinIcon 1535 { clickable = isPinnedDynamically && not archived 1536 , hover = HoverState.isHovered PinIcon hovered 1537 } 1538 ) 1539 :: (case pinBarVersion of 1540 Just v -> 1541 [ viewVersion Resource.Styles.pinBarViewVersion v ] 1542 1543 _ -> 1544 [] 1545 ) 1546 ++ (if HoverState.isHovered PinBar hovered then 1547 [ Html.div 1548 (id "pin-bar-tooltip" :: Resource.Styles.pinBarTooltip) 1549 [ Html.text "pinned in pipeline config" ] 1550 ] 1551 1552 else 1553 [] 1554 ) 1555 ) 1556 1557 1558 isPipelineArchived : 1559 WebData (List Concourse.Pipeline) 1560 -> Concourse.ResourceIdentifier 1561 -> Bool 1562 isPipelineArchived pipelines { pipelineName, teamName } = 1563 pipelines 1564 |> RemoteData.withDefault [] 1565 |> List.Extra.find (\p -> p.name == pipelineName && p.teamName == teamName) 1566 |> Maybe.map .archived 1567 |> Maybe.withDefault False 1568 1569 1570 viewVersionedResources : 1571 { a 1572 | hovered : HoverState.HoverState 1573 , pipelines : WebData (List Concourse.Pipeline) 1574 } 1575 -> 1576 { b 1577 | versions : Paginated Models.Version 1578 , pinnedVersion : Models.PinnedVersion 1579 , resourceIdentifier : Concourse.ResourceIdentifier 1580 } 1581 -> Html Message 1582 viewVersionedResources { hovered, pipelines } model = 1583 let 1584 archived = 1585 isPipelineArchived 1586 pipelines 1587 model.resourceIdentifier 1588 in 1589 model 1590 |> versions 1591 |> List.map 1592 (\v -> 1593 viewVersionedResource 1594 { version = v 1595 , pinnedVersion = model.pinnedVersion 1596 , hovered = hovered 1597 , archived = archived 1598 } 1599 ) 1600 |> Html.ul [ class "list list-collapsable list-enableDisable resource-versions" ] 1601 1602 1603 viewVersionedResource : 1604 { version : VersionPresenter 1605 , pinnedVersion : Models.PinnedVersion 1606 , hovered : HoverState.HoverState 1607 , archived : Bool 1608 } 1609 -> Html Message 1610 viewVersionedResource { version, hovered, archived } = 1611 Html.li 1612 (case ( version.pinState, version.enabled ) of 1613 ( Disabled, _ ) -> 1614 [ style "opacity" "0.5" ] 1615 1616 ( NotThePinnedVersion, _ ) -> 1617 [ style "opacity" "0.5" ] 1618 1619 ( _, Models.Disabled ) -> 1620 [ style "opacity" "0.5" ] 1621 1622 _ -> 1623 [] 1624 ) 1625 (Html.div 1626 [ style "display" "flex" 1627 , style "margin" "5px 0px" 1628 ] 1629 ((if archived then 1630 [] 1631 1632 else 1633 [ viewEnabledCheckbox 1634 { enabled = version.enabled 1635 , id = version.id 1636 , pinState = version.pinState 1637 } 1638 , viewPinButton 1639 { versionID = version.id 1640 , pinState = version.pinState 1641 , hovered = hovered 1642 } 1643 ] 1644 ) 1645 ++ [ viewVersionHeader 1646 { id = version.id 1647 , version = version.version 1648 , pinnedState = version.pinState 1649 } 1650 ] 1651 ) 1652 :: (if version.expanded then 1653 [ viewVersionBody 1654 { inputTo = version.inputTo 1655 , outputOf = version.outputOf 1656 , metadata = version.metadata 1657 } 1658 ] 1659 1660 else 1661 [] 1662 ) 1663 ) 1664 1665 1666 viewVersionBody : 1667 { a 1668 | inputTo : List Concourse.Build 1669 , outputOf : List Concourse.Build 1670 , metadata : Concourse.Metadata 1671 } 1672 -> Html Message 1673 viewVersionBody { inputTo, outputOf, metadata } = 1674 Html.div 1675 [ style "display" "flex" 1676 , style "padding" "5px 10px" 1677 ] 1678 [ Html.div [ class "vri" ] <| 1679 List.concat 1680 [ [ Html.div [ style "line-height" "25px" ] [ Html.text "inputs to" ] ] 1681 , viewBuilds <| listToMap inputTo 1682 ] 1683 , Html.div [ class "vri" ] <| 1684 List.concat 1685 [ [ Html.div [ style "line-height" "25px" ] [ Html.text "outputs of" ] ] 1686 , viewBuilds <| listToMap outputOf 1687 ] 1688 , Html.div [ class "vri metadata-container" ] 1689 [ Html.div [ class "list-collapsable-title" ] [ Html.text "metadata" ] 1690 , viewMetadata metadata 1691 ] 1692 ] 1693 1694 1695 viewEnabledCheckbox : 1696 { a 1697 | enabled : Models.VersionEnabledState 1698 , id : Models.VersionId 1699 , pinState : VersionPinState 1700 } 1701 -> Html Message 1702 viewEnabledCheckbox ({ enabled, id } as params) = 1703 let 1704 clickHandler = 1705 case enabled of 1706 Models.Enabled -> 1707 [ onClick <| Click <| VersionToggle id ] 1708 1709 Models.Changing -> 1710 [] 1711 1712 Models.Disabled -> 1713 [ onClick <| Click <| VersionToggle id ] 1714 in 1715 Html.div 1716 (Html.Attributes.attribute "aria-label" "Toggle Resource Version Enabled" 1717 :: Resource.Styles.enabledCheckbox params 1718 ++ clickHandler 1719 ) 1720 (case enabled of 1721 Models.Enabled -> 1722 [] 1723 1724 Models.Changing -> 1725 [ Spinner.spinner 1726 { sizePx = 12.5 1727 , margin = "6.25px" 1728 } 1729 ] 1730 1731 Models.Disabled -> 1732 [] 1733 ) 1734 1735 1736 viewPinButton : 1737 { versionID : Models.VersionId 1738 , pinState : VersionPinState 1739 , hovered : HoverState.HoverState 1740 } 1741 -> Html Message 1742 viewPinButton { versionID, pinState, hovered } = 1743 let 1744 eventHandlers = 1745 case pinState of 1746 Enabled -> 1747 [ onClick <| Click <| PinButton versionID ] 1748 1749 PinnedDynamically -> 1750 [ onClick <| Click <| PinButton versionID ] 1751 1752 NotThePinnedVersion -> 1753 [ onClick <| Click <| PinButton versionID ] 1754 1755 PinnedStatically _ -> 1756 [ onMouseOver <| Hover <| Just <| PinButton versionID 1757 , onMouseOut <| Hover Nothing 1758 ] 1759 1760 Disabled -> 1761 [] 1762 1763 InTransition -> 1764 [] 1765 in 1766 Html.div 1767 (Html.Attributes.attribute "aria-label" "Pin Resource Version" 1768 :: Resource.Styles.pinButton pinState 1769 ++ eventHandlers 1770 ) 1771 (case pinState of 1772 PinnedStatically _ -> 1773 if HoverState.isHovered (PinButton versionID) hovered then 1774 [ Html.div 1775 Resource.Styles.pinButtonTooltip 1776 [ Html.text "enable via pipeline config" ] 1777 ] 1778 1779 else 1780 [] 1781 1782 InTransition -> 1783 [ Spinner.spinner 1784 { sizePx = 12.5 1785 , margin = "6.25px" 1786 } 1787 ] 1788 1789 _ -> 1790 [] 1791 ) 1792 1793 1794 viewVersionHeader : 1795 { a 1796 | id : Models.VersionId 1797 , version : Concourse.Version 1798 , pinnedState : VersionPinState 1799 } 1800 -> Html Message 1801 viewVersionHeader { id, version, pinnedState } = 1802 Html.div 1803 ((onClick <| Click <| VersionHeader id) 1804 :: Resource.Styles.versionHeader pinnedState 1805 ) 1806 [ viewVersion [] version ] 1807 1808 1809 viewVersion : List (Html.Attribute Message) -> Concourse.Version -> Html Message 1810 viewVersion attrs version = 1811 version 1812 |> Dict.map (always Html.text) 1813 |> DictView.view attrs 1814 1815 1816 viewMetadata : Concourse.Metadata -> Html Message 1817 viewMetadata metadata = 1818 Html.dl [ class "build-metadata" ] 1819 (List.concatMap viewMetadataField metadata) 1820 1821 1822 viewMetadataField : Concourse.MetadataField -> List (Html a) 1823 viewMetadataField field = 1824 [ Html.dt [] [ Html.text field.name ] 1825 , Html.dd [] 1826 [ Html.pre [ class "metadata-field" ] [ Html.text field.value ] 1827 ] 1828 ] 1829 1830 1831 listToMap : List Concourse.Build -> Dict.Dict String (List Concourse.Build) 1832 listToMap builds = 1833 let 1834 insertBuild = 1835 \build dict -> 1836 let 1837 jobName = 1838 case build.job of 1839 Nothing -> 1840 -- Jobless builds shouldn't appear on this page! 1841 "" 1842 1843 Just job -> 1844 job.jobName 1845 1846 oldList = 1847 Dict.get jobName dict 1848 1849 newList = 1850 case oldList of 1851 Nothing -> 1852 [ build ] 1853 1854 Just list -> 1855 list ++ [ build ] 1856 in 1857 Dict.insert jobName newList dict 1858 in 1859 List.foldr insertBuild Dict.empty builds 1860 1861 1862 viewBuilds : Dict.Dict String (List Concourse.Build) -> List (Html Message) 1863 viewBuilds buildDict = 1864 List.concatMap (viewBuildsByJob buildDict) <| Dict.keys buildDict 1865 1866 1867 formatDate : Time.Zone -> Time.Posix -> String 1868 formatDate = 1869 DateFormat.format 1870 [ DateFormat.monthNameAbbreviated 1871 , DateFormat.text " " 1872 , DateFormat.dayOfMonthNumber 1873 , DateFormat.text " " 1874 , DateFormat.yearNumber 1875 , DateFormat.text " " 1876 , DateFormat.hourFixed 1877 , DateFormat.text ":" 1878 , DateFormat.minuteFixed 1879 , DateFormat.text ":" 1880 , DateFormat.secondFixed 1881 , DateFormat.text " " 1882 , DateFormat.amPmUppercase 1883 ] 1884 1885 1886 viewLastChecked : Time.Zone -> Time.Posix -> Time.Posix -> Html a 1887 viewLastChecked timeZone now date = 1888 let 1889 ago = 1890 Duration.between date now 1891 in 1892 Html.table [ id "last-checked" ] 1893 [ Html.tr 1894 [] 1895 [ Html.td [] [ Html.text "checked" ] 1896 , Html.td 1897 [ title <| formatDate timeZone date ] 1898 [ Html.span [] [ Html.text (Duration.format ago ++ " ago") ] ] 1899 ] 1900 ] 1901 1902 1903 viewBuildsByJob : Dict.Dict String (List Concourse.Build) -> String -> List (Html Message) 1904 viewBuildsByJob buildDict jobName = 1905 let 1906 oneBuildToLi = 1907 \build -> 1908 case build.job of 1909 Nothing -> 1910 Html.li [ class <| Concourse.BuildStatus.show build.status ] 1911 [ Html.text <| "#" ++ build.name ] 1912 1913 Just job -> 1914 let 1915 link = 1916 Routes.Build 1917 { id = 1918 { teamName = job.teamName 1919 , pipelineName = job.pipelineName 1920 , jobName = job.jobName 1921 , buildName = build.name 1922 } 1923 , highlight = Routes.HighlightNothing 1924 } 1925 in 1926 Html.li [ class <| Concourse.BuildStatus.show build.status ] 1927 [ Html.a 1928 [ StrictEvents.onLeftClick <| GoToRoute link 1929 , href (Routes.toString link) 1930 ] 1931 [ Html.text <| "#" ++ build.name ] 1932 ] 1933 in 1934 [ Html.h3 [ class "man pas ansi-bright-black-bg" ] [ Html.text jobName ] 1935 , Html.ul [ class "builds-list" ] 1936 (case Dict.get jobName buildDict of 1937 Nothing -> 1938 [] 1939 1940 -- never happens 1941 Just buildList -> 1942 List.map oneBuildToLi buildList 1943 ) 1944 ] 1945 1946 1947 fetchDataForExpandedVersions : Model -> List Effect 1948 fetchDataForExpandedVersions model = 1949 model.versions.content 1950 |> List.filter .expanded 1951 |> List.concatMap (\v -> [ FetchInputTo v.id, FetchOutputOf v.id ]) 1952 1953 1954 updateOutput : 1955 (OutputModel -> ( OutputModel, List Effect )) 1956 -> ET Model 1957 updateOutput updater ( model, effects ) = 1958 case model.output of 1959 Just output -> 1960 let 1961 ( newOutput, outputEffects ) = 1962 updater output 1963 1964 newModel = 1965 { model 1966 | output = 1967 -- model.output must be equal-by-reference 1968 -- to its previous value when passed 1969 -- into `Html.Lazy.lazy3` below. 1970 if newOutput /= output then 1971 Just newOutput 1972 1973 else 1974 model.output 1975 } 1976 in 1977 ( newModel, effects ++ outputEffects ) 1978 1979 _ -> 1980 ( model, effects ) 1981 1982 1983 viewBuildOutput : Time.Zone -> HoverState.HoverState -> Maybe OutputModel -> Html Message 1984 viewBuildOutput timeZone hovered output = 1985 case output of 1986 Just o -> 1987 Build.Output.Output.view 1988 { timeZone = timeZone, hovered = hovered } 1989 o 1990 1991 Nothing -> 1992 Html.div [] []