github.com/pf-qiu/concourse/v6@v6.7.3-0.20201207032516-1f455d73275f/web/elm/src/Dashboard/DashboardPreview.elm (about)

     1  module Dashboard.DashboardPreview exposing (groupByRank, view)
     2  
     3  import Concourse
     4  import Concourse.PipelineStatus exposing (PipelineStatus(..), StatusDetails(..))
     5  import Dashboard.Styles as Styles
     6  import Dict exposing (Dict)
     7  import HoverState
     8  import Html exposing (Html)
     9  import Html.Attributes exposing (attribute, class, href)
    10  import Html.Events exposing (onMouseEnter, onMouseLeave)
    11  import List.Extra
    12  import Message.Message exposing (DomID(..), Message(..), PipelinesSection(..))
    13  import Routes
    14  
    15  
    16  view : PipelinesSection -> HoverState.HoverState -> List (List Concourse.Job) -> Html Message
    17  view section hovered layers =
    18      Html.div
    19          (class "pipeline-grid" :: Styles.pipelinePreviewGrid)
    20          (List.map (viewJobLayer section hovered) layers)
    21  
    22  
    23  viewJobLayer : PipelinesSection -> HoverState.HoverState -> List Concourse.Job -> Html Message
    24  viewJobLayer section hovered jobs =
    25      Html.div [ class "parallel-grid" ] (List.map (viewJob section hovered) jobs)
    26  
    27  
    28  viewJob : PipelinesSection -> HoverState.HoverState -> Concourse.Job -> Html Message
    29  viewJob section hovered job =
    30      let
    31          latestBuild : Maybe Concourse.Build
    32          latestBuild =
    33              if job.nextBuild == Nothing then
    34                  job.finishedBuild
    35  
    36              else
    37                  job.nextBuild
    38  
    39          buildRoute : Routes.Route
    40          buildRoute =
    41              case latestBuild of
    42                  Nothing ->
    43                      Routes.jobRoute job
    44  
    45                  Just build ->
    46                      Routes.buildRoute build.id build.name build.job
    47  
    48          jobId =
    49              { jobName = job.name
    50              , pipelineName = job.pipelineName
    51              , teamName = job.teamName
    52              }
    53      in
    54      Html.div
    55          (attribute "data-tooltip" job.name
    56              :: Styles.jobPreview job
    57                  (HoverState.isHovered
    58                      (JobPreview section jobId)
    59                      hovered
    60                  )
    61              ++ [ onMouseEnter <| Hover <| Just <| JobPreview section jobId
    62                 , onMouseLeave <| Hover Nothing
    63                 ]
    64          )
    65          [ Html.a
    66              (href (Routes.toString buildRoute) :: Styles.jobPreviewLink)
    67              [ Html.text "" ]
    68          ]
    69  
    70  
    71  type alias Job a b =
    72      { a
    73          | name : String
    74          , inputs : List { b | passed : List String }
    75      }
    76  
    77  
    78  groupByRank : List (Job a b) -> List (List (Job a b))
    79  groupByRank jobs =
    80      let
    81          depths =
    82              jobDepths Dict.empty Dict.empty jobs
    83      in
    84      depths
    85          |> Dict.values
    86          |> List.sort
    87          |> List.Extra.unique
    88          |> List.map
    89              (\d ->
    90                  jobs
    91                      |> List.filter (\j -> Dict.get j.name depths == Just d)
    92              )
    93  
    94  
    95  jobDepths :
    96      Dict String { value : Int, uncertainty : Int }
    97      -> Dict String Int
    98      -> List (Job a b)
    99      -> Dict String Int
   100  jobDepths calculations depths jobs =
   101      case jobs of
   102          [] ->
   103              depths
   104  
   105          job :: otherJobs ->
   106              let
   107                  dependencies =
   108                      List.concatMap .passed job.inputs
   109  
   110                  values =
   111                      List.filterMap
   112                          (\jobName -> Dict.get jobName depths)
   113                          dependencies
   114  
   115                  new =
   116                      { value =
   117                          values
   118                              |> List.maximum
   119                              |> Maybe.map ((+) 1)
   120                              |> Maybe.withDefault 0
   121                      , uncertainty = List.length otherJobs
   122                      }
   123  
   124                  totalConfidence =
   125                      List.length values
   126                          == List.length dependencies
   127  
   128                  neverGonnaGetBetter =
   129                      Dict.get job.name calculations
   130                          |> Maybe.map (\oldCalc -> oldCalc.uncertainty <= new.uncertainty)
   131                          |> Maybe.withDefault False
   132              in
   133              if totalConfidence || neverGonnaGetBetter then
   134                  jobDepths
   135                      (Dict.remove job.name calculations)
   136                      (Dict.insert job.name new.value depths)
   137                      otherJobs
   138  
   139              else
   140                  jobDepths
   141                      (Dict.insert job.name new calculations)
   142                      depths
   143                      (otherJobs ++ [ job ])