github.com/pf-qiu/concourse/v6@v6.7.3-0.20201207032516-1f455d73275f/web/elm/src/Build/Header/Header.elm (about) 1 module Build.Header.Header exposing 2 ( changeToBuild 3 , handleCallback 4 , handleDelivery 5 , header 6 , update 7 , view 8 ) 9 10 import Api.Endpoints as Endpoints 11 import Application.Models exposing (Session) 12 import Build.Header.Models exposing (BuildPageType(..), HistoryItem, Model) 13 import Build.Header.Views as Views 14 import Build.StepTree.Models as STModels 15 import Concourse 16 import Concourse.BuildStatus 17 import Concourse.Pagination exposing (Paginated) 18 import DateFormat 19 import Duration exposing (Duration) 20 import EffectTransformer exposing (ET) 21 import HoverState 22 import Html exposing (Html) 23 import List.Extra 24 import Maybe.Extra 25 import Message.Callback exposing (Callback(..)) 26 import Message.Effects as Effects exposing (Effect(..)) 27 import Message.Message exposing (DomID(..), Message(..)) 28 import Message.ScrollDirection exposing (ScrollDirection(..)) 29 import Message.Subscription 30 exposing 31 ( Delivery(..) 32 , Interval(..) 33 , Subscription(..) 34 ) 35 import RemoteData exposing (WebData) 36 import Routes 37 import StrictEvents exposing (DeltaMode(..)) 38 import Time 39 40 41 historyId : String 42 historyId = 43 "builds" 44 45 46 header : Session -> Model r -> Views.Header 47 header session model = 48 { leftWidgets = 49 [ Views.Title model.name model.job 50 , Views.Duration (duration session model) 51 ] 52 , rightWidgets = 53 if isPipelineArchived session.pipelines model.job then 54 [] 55 56 else 57 [ Views.Button 58 (if Concourse.BuildStatus.isRunning model.status then 59 Just 60 { type_ = Views.Abort 61 , isClickable = True 62 , backgroundShade = 63 if 64 HoverState.isHovered 65 AbortBuildButton 66 session.hovered 67 then 68 Views.Dark 69 70 else 71 Views.Light 72 , backgroundColor = Concourse.BuildStatus.BuildStatusFailed 73 , tooltip = False 74 } 75 76 else if model.job /= Nothing then 77 let 78 isHovered = 79 HoverState.isHovered 80 RerunBuildButton 81 session.hovered 82 in 83 Just 84 { type_ = Views.Rerun 85 , isClickable = True 86 , backgroundShade = 87 if isHovered then 88 Views.Dark 89 90 else 91 Views.Light 92 , backgroundColor = model.status 93 , tooltip = isHovered 94 } 95 96 else 97 Nothing 98 ) 99 , Views.Button 100 (if model.job /= Nothing then 101 let 102 isHovered = 103 HoverState.isHovered 104 TriggerBuildButton 105 session.hovered 106 in 107 Just 108 { type_ = Views.Trigger 109 , isClickable = not model.disableManualTrigger 110 , backgroundShade = 111 if isHovered then 112 Views.Dark 113 114 else 115 Views.Light 116 , backgroundColor = model.status 117 , tooltip = isHovered && model.disableManualTrigger 118 } 119 120 else 121 Nothing 122 ) 123 ] 124 , backgroundColor = model.status 125 , tabs = tabs model 126 } 127 128 129 isPipelineArchived : 130 WebData (List Concourse.Pipeline) 131 -> Maybe Concourse.JobIdentifier 132 -> Bool 133 isPipelineArchived pipelines jobId = 134 case jobId of 135 Just { pipelineName, teamName } -> 136 pipelines 137 |> RemoteData.withDefault [] 138 |> List.Extra.find (\p -> p.name == pipelineName && p.teamName == teamName) 139 |> Maybe.map .archived 140 |> Maybe.withDefault False 141 142 Nothing -> 143 False 144 145 146 tabs : Model r -> List Views.BuildTab 147 tabs model = 148 model.history 149 |> List.map 150 (\b -> 151 { id = b.id 152 , name = b.name 153 , background = b.status 154 , href = Routes.buildRoute b.id b.name model.job 155 , isCurrent = b.id == model.id 156 } 157 ) 158 159 160 historyItem : Model r -> HistoryItem 161 historyItem model = 162 { id = model.id 163 , name = model.name 164 , status = model.status 165 , duration = model.duration 166 } 167 168 169 changeToBuild : BuildPageType -> ET (Model r) 170 changeToBuild pageType ( model, effects ) = 171 case pageType of 172 JobBuildPage buildID -> 173 ( model.history 174 |> List.Extra.find (.name >> (==) buildID.buildName) 175 |> Maybe.map 176 (\b -> 177 { model 178 | id = b.id 179 , status = b.status 180 , duration = b.duration 181 , name = b.name 182 } 183 ) 184 |> Maybe.withDefault model 185 , effects 186 ) 187 188 _ -> 189 ( model, effects ) 190 191 192 duration : Session -> Model r -> Views.BuildDuration 193 duration session model = 194 case ( model.duration.startedAt, model.duration.finishedAt ) of 195 ( Nothing, Nothing ) -> 196 Views.Pending 197 198 ( Nothing, Just finished ) -> 199 Views.Cancelled (timestamp session.timeZone model.now finished) 200 201 ( Just started, Nothing ) -> 202 Views.Running (timestamp session.timeZone model.now started) 203 204 ( Just started, Just finished ) -> 205 Views.Finished 206 { started = timestamp session.timeZone model.now started 207 , finished = timestamp session.timeZone model.now finished 208 , duration = timespan <| Duration.between started finished 209 } 210 211 212 timestamp : Time.Zone -> Maybe Time.Posix -> Time.Posix -> Views.Timestamp 213 timestamp timeZone now time = 214 let 215 ago = 216 Maybe.map (Duration.between time) now 217 218 formatted = 219 format timeZone time 220 in 221 case ago of 222 Just a -> 223 if a < 24 * 60 * 60 * 1000 then 224 Views.Relative (timespan a) formatted 225 226 else 227 Views.Absolute formatted (Just <| timespan a) 228 229 Nothing -> 230 Views.Absolute formatted Nothing 231 232 233 format : Time.Zone -> Time.Posix -> String 234 format = 235 DateFormat.format 236 [ DateFormat.monthNameAbbreviated 237 , DateFormat.text " " 238 , DateFormat.dayOfMonthNumber 239 , DateFormat.text " " 240 , DateFormat.yearNumber 241 , DateFormat.text " " 242 , DateFormat.hourFixed 243 , DateFormat.text ":" 244 , DateFormat.minuteFixed 245 , DateFormat.text ":" 246 , DateFormat.secondFixed 247 , DateFormat.text " " 248 , DateFormat.amPmUppercase 249 ] 250 251 252 timespan : Duration -> Views.Timespan 253 timespan dur = 254 let 255 seconds = 256 dur // 1000 257 258 remainingSeconds = 259 remainderBy 60 seconds 260 261 minutes = 262 seconds // 60 263 264 remainingMinutes = 265 remainderBy 60 minutes 266 267 hours = 268 minutes // 60 269 270 remainingHours = 271 remainderBy 24 hours 272 273 days = 274 hours // 24 275 in 276 case ( ( days, remainingHours ), remainingMinutes, remainingSeconds ) of 277 ( ( 0, 0 ), 0, s ) -> 278 Views.JustSeconds s 279 280 ( ( 0, 0 ), m, s ) -> 281 Views.MinutesAndSeconds m s 282 283 ( ( 0, h ), m, _ ) -> 284 Views.HoursAndMinutes h m 285 286 ( ( d, h ), _, _ ) -> 287 Views.DaysAndHours d h 288 289 290 view : Session -> Model r -> Html Message 291 view session model = 292 header session model |> Views.viewHeader 293 294 295 handleDelivery : Delivery -> ET (Model r) 296 handleDelivery delivery ( model, effects ) = 297 case delivery of 298 ElementVisible ( id, True ) -> 299 let 300 lastBuildVisible = 301 model.history 302 |> List.Extra.last 303 |> Maybe.map .id 304 |> Maybe.map String.fromInt 305 |> Maybe.map ((==) id) 306 |> Maybe.withDefault False 307 308 hasNextPage = 309 model.nextPage /= Nothing 310 311 needsToFetchMorePages = 312 not model.fetchingHistory && lastBuildVisible && hasNextPage 313 in 314 case model.job of 315 Just job -> 316 if needsToFetchMorePages then 317 ( { model | fetchingHistory = True } 318 , effects ++ [ FetchBuildHistory job model.nextPage ] 319 ) 320 321 else 322 ( model, effects ) 323 324 Nothing -> 325 ( model, effects ) 326 327 ElementVisible ( id, False ) -> 328 let 329 currentBuildInvisible = 330 String.fromInt model.id == id 331 332 shouldScroll = 333 currentBuildInvisible && not model.scrolledToCurrentBuild 334 in 335 ( { model | scrolledToCurrentBuild = True } 336 , effects 337 ++ (if shouldScroll then 338 [ Scroll (ToId id) historyId ] 339 340 else 341 [] 342 ) 343 ) 344 345 EventsReceived result -> 346 Result.toMaybe result 347 |> Maybe.map 348 (List.filter 349 (.url 350 >> String.endsWith 351 (Endpoints.BuildEventStream 352 |> Endpoints.Build model.id 353 |> Endpoints.toString [] 354 ) 355 ) 356 ) 357 |> Maybe.map 358 (List.filterMap 359 (\{ data } -> 360 case data of 361 STModels.BuildStatus status date -> 362 Just ( status, date ) 363 364 _ -> 365 Nothing 366 ) 367 ) 368 |> Maybe.andThen List.Extra.last 369 |> Maybe.map 370 (\( status, date ) -> 371 let 372 newStatus = 373 if Concourse.BuildStatus.isRunning model.status then 374 status 375 376 else 377 model.status 378 379 newDuration = 380 let 381 dur = 382 model.duration 383 in 384 { dur 385 | finishedAt = 386 if Concourse.BuildStatus.isRunning status then 387 dur.finishedAt 388 389 else 390 Just date 391 } 392 in 393 ( { model 394 | history = 395 List.Extra.updateIf (.id >> (==) model.id) 396 (\item -> 397 { item 398 | status = newStatus 399 , duration = newDuration 400 } 401 ) 402 model.history 403 , duration = newDuration 404 , status = newStatus 405 } 406 , effects 407 ) 408 ) 409 |> Maybe.withDefault ( model, effects ) 410 411 _ -> 412 ( model, effects ) 413 414 415 update : Message -> ET (Model r) 416 update msg ( model, effects ) = 417 case msg of 418 ScrollBuilds event -> 419 let 420 scrollFactor = 421 case event.deltaMode of 422 DeltaModePixel -> 423 1 424 425 DeltaModeLine -> 426 20 427 428 DeltaModePage -> 429 800 430 431 scroll = 432 if event.deltaX == 0 then 433 [ Scroll (Sideways <| event.deltaY * scrollFactor) historyId ] 434 435 else 436 [ Scroll (Sideways <| -event.deltaX * scrollFactor) historyId ] 437 438 checkVisibility = 439 case model.history |> List.Extra.last of 440 Just b -> 441 [ Effects.CheckIsVisible <| String.fromInt b.id ] 442 443 Nothing -> 444 [] 445 in 446 ( model, effects ++ scroll ++ checkVisibility ) 447 448 Click RerunBuildButton -> 449 ( model 450 , effects 451 ++ (model.job 452 |> Maybe.map 453 (\j -> 454 RerunJobBuild 455 { teamName = j.teamName 456 , pipelineName = j.pipelineName 457 , jobName = j.jobName 458 , buildName = model.name 459 } 460 ) 461 |> Maybe.Extra.toList 462 ) 463 ) 464 465 _ -> 466 ( model, effects ) 467 468 469 handleCallback : Callback -> ET (Model r) 470 handleCallback callback ( model, effects ) = 471 case callback of 472 BuildFetched (Ok b) -> 473 handleBuildFetched b ( model, effects ) 474 475 BuildTriggered (Ok b) -> 476 ( { model 477 | history = 478 ({ id = b.id 479 , name = b.name 480 , status = b.status 481 , duration = b.duration 482 } 483 :: model.history 484 ) 485 |> List.sortWith 486 (\n m -> 487 Maybe.map2 488 (\( i, j ) ( k, l ) -> 489 case compare i k of 490 EQ -> 491 compare j l 492 493 x -> 494 x 495 ) 496 (buildName n.name) 497 (buildName m.name) 498 |> Maybe.withDefault EQ 499 ) 500 |> List.reverse 501 } 502 , effects 503 ++ [ NavigateTo <| Routes.toString <| Routes.buildRoute b.id b.name model.job ] 504 ) 505 506 BuildHistoryFetched (Ok history) -> 507 handleHistoryFetched history ( model, effects ) 508 509 BuildHistoryFetched (Err _) -> 510 -- https://github.com/concourse/concourse/issues/3201 511 ( { model | fetchingHistory = False }, effects ) 512 513 _ -> 514 ( model, effects ) 515 516 517 handleBuildFetched : Concourse.Build -> ET (Model r) 518 handleBuildFetched b ( model, effects ) = 519 if not model.hasLoadedYet || model.id == b.id then 520 ( { model 521 | hasLoadedYet = True 522 , history = 523 List.Extra.setIf (.id >> (==) b.id) 524 { id = b.id 525 , name = b.name 526 , status = b.status 527 , duration = b.duration 528 } 529 model.history 530 , fetchingHistory = True 531 , duration = b.duration 532 , status = b.status 533 , job = b.job 534 , id = b.id 535 , name = b.name 536 } 537 , effects 538 ) 539 540 else 541 ( model, effects ) 542 543 544 buildName : String -> Maybe ( Int, Int ) 545 buildName s = 546 case String.split "." s |> List.map String.toInt of 547 [ Just n ] -> 548 Just ( n, 0 ) 549 550 [ Just n, Just m ] -> 551 Just ( n, m ) 552 553 _ -> 554 Nothing 555 556 557 handleHistoryFetched : Paginated Concourse.Build -> ET (Model r) 558 handleHistoryFetched history ( model, effects ) = 559 let 560 newModel = 561 { model 562 | history = 563 model.history 564 ++ (history.content 565 |> List.map 566 (\b -> 567 { id = b.id 568 , name = b.name 569 , status = b.status 570 , duration = b.duration 571 } 572 ) 573 ) 574 , nextPage = history.pagination.nextPage 575 , fetchingHistory = False 576 } 577 in 578 case model.job of 579 Just job -> 580 if List.member (historyItem model) newModel.history then 581 ( newModel 582 , effects ++ [ CheckIsVisible <| String.fromInt <| model.id ] 583 ) 584 585 else 586 ( { newModel | fetchingHistory = True } 587 , effects ++ [ FetchBuildHistory job history.pagination.nextPage ] 588 ) 589 590 _ -> 591 ( newModel, effects )