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

     1  module Tooltip exposing
     2      ( Alignment(..)
     3      , Direction(..)
     4      , Model
     5      , Tooltip
     6      , handleCallback
     7      , handleDelivery
     8      , view
     9      )
    10  
    11  import Browser.Dom
    12  import EffectTransformer exposing (ET)
    13  import HoverState exposing (TooltipPosition(..))
    14  import Html exposing (Html)
    15  import Html.Attributes exposing (id, style)
    16  import Message.Callback exposing (Callback(..))
    17  import Message.Effects as Effects
    18  import Message.Message exposing (DomID(..), Message)
    19  import Message.Subscription exposing (Delivery(..), Interval(..))
    20  
    21  
    22  type alias Model m =
    23      { m | hovered : HoverState.HoverState }
    24  
    25  
    26  type alias Tooltip =
    27      { body : Html Message
    28      , arrow : Maybe Arrow
    29      , attachPosition : AttachPosition
    30      }
    31  
    32  
    33  
    34  -- Many tooltips, especially in crowded parts of the UI, have an extra
    35  -- triangular piece sticking out that points to the tooltip's target. Online
    36  -- this element is variously called a 'tail' or an 'arrow', with 'arrow'
    37  -- predominating.
    38  
    39  
    40  type alias Arrow =
    41      { size : Float
    42      , color : String
    43      }
    44  
    45  
    46  type TooltipCondition
    47      = AlwaysShow
    48      | OnlyShowWhenOverflowing
    49  
    50  
    51  type alias AttachPosition =
    52      { direction : Direction
    53      , alignment : Alignment
    54      }
    55  
    56  
    57  type Direction
    58      = Top
    59      | Right Float
    60  
    61  
    62  type Alignment
    63      = Start
    64      | Middle Float
    65      | End
    66  
    67  
    68  policy : DomID -> TooltipCondition
    69  policy domID =
    70      case domID of
    71          SideBarPipeline _ _ ->
    72              OnlyShowWhenOverflowing
    73  
    74          SideBarTeam _ _ ->
    75              OnlyShowWhenOverflowing
    76  
    77          _ ->
    78              AlwaysShow
    79  
    80  
    81  position : AttachPosition -> Browser.Dom.Element -> List (Html.Attribute msg)
    82  position { direction, alignment } { element, viewport } =
    83      let
    84          target =
    85              element
    86  
    87          vertical =
    88              case ( direction, alignment ) of
    89                  ( Top, _ ) ->
    90                      [ style "bottom" <| String.fromFloat (viewport.height - target.y) ++ "px" ]
    91  
    92                  ( Right _, Start ) ->
    93                      [ style "top" <| String.fromFloat target.y ++ "px" ]
    94  
    95                  ( Right _, Middle height ) ->
    96                      [ style "top" <| String.fromFloat (target.y + (target.height - height) / 2) ++ "px" ]
    97  
    98                  ( Right _, End ) ->
    99                      [ style "bottom" <| String.fromFloat (viewport.height - target.y - target.height) ++ "px" ]
   100  
   101          horizontal =
   102              case ( direction, alignment ) of
   103                  ( Top, Start ) ->
   104                      [ style "left" <| String.fromFloat target.x ++ "px" ]
   105  
   106                  ( Top, Middle width ) ->
   107                      [ style "left" <| String.fromFloat (target.x + (target.width - width) / 2) ++ "px" ]
   108  
   109                  ( Top, End ) ->
   110                      [ style "right" <| String.fromFloat (viewport.width - target.x - target.width) ++ "px" ]
   111  
   112                  ( Right offset, _ ) ->
   113                      [ style "left" <| String.fromFloat (target.x + target.width + offset) ++ "px" ]
   114      in
   115      [ style "position" "fixed", style "z-index" "100" ] ++ vertical ++ horizontal
   116  
   117  
   118  handleCallback : Callback -> ET (Model m)
   119  handleCallback callback ( model, effects ) =
   120      case callback of
   121          GotViewport _ (Ok { scene, viewport }) ->
   122              case model.hovered of
   123                  HoverState.Hovered domID ->
   124                      if policy domID == OnlyShowWhenOverflowing && viewport.width >= scene.width then
   125                          ( model, effects )
   126  
   127                      else
   128                          ( { model
   129                              | hovered =
   130                                  HoverState.TooltipPending domID
   131                            }
   132                          , effects ++ [ Effects.GetElement domID ]
   133                          )
   134  
   135                  _ ->
   136                      ( model, effects )
   137  
   138          GotElement (Ok element) ->
   139              case model.hovered of
   140                  HoverState.TooltipPending domID ->
   141                      ( { model | hovered = HoverState.Tooltip domID element }
   142                      , effects
   143                      )
   144  
   145                  _ ->
   146                      ( model, effects )
   147  
   148          _ ->
   149              ( model, effects )
   150  
   151  
   152  arrowView : AttachPosition -> Browser.Dom.Element -> Arrow -> Html Message
   153  arrowView { direction } target { size, color } =
   154      Html.div
   155          ((case direction of
   156              Top ->
   157                  [ style "border-top" <| String.fromFloat size ++ "px solid " ++ color
   158                  , style "border-left" <| String.fromFloat size ++ "px solid transparent"
   159                  , style "border-right" <| String.fromFloat size ++ "px solid transparent"
   160                  , style "margin-bottom" <| "-" ++ String.fromFloat size ++ "px"
   161                  ]
   162  
   163              Right _ ->
   164                  [ style "border-right" <| String.fromFloat size ++ "px solid " ++ color
   165                  , style "border-top" <| String.fromFloat size ++ "px solid transparent"
   166                  , style "border-bottom" <| String.fromFloat size ++ "px solid transparent"
   167                  , style "margin-left" <| "-" ++ String.fromFloat size ++ "px"
   168                  ]
   169           )
   170              ++ position
   171                  { direction = direction, alignment = Middle (2 * size) }
   172                  target
   173          )
   174          []
   175  
   176  
   177  view : Model m -> Tooltip -> Html Message
   178  view { hovered } { body, attachPosition, arrow } =
   179      case ( hovered, arrow ) of
   180          ( HoverState.Tooltip _ target, a ) ->
   181              Html.div (id "tooltips" :: position attachPosition target)
   182                  [ Maybe.map (arrowView attachPosition target) a |> Maybe.withDefault (Html.text "")
   183                  , body
   184                  ]
   185  
   186          _ ->
   187              Html.text ""
   188  
   189  
   190  handleDelivery : { a | hovered : HoverState.HoverState } -> Delivery -> ET m
   191  handleDelivery session delivery ( model, effects ) =
   192      case delivery of
   193          ClockTicked OneSecond _ ->
   194              ( model
   195              , effects
   196                  ++ (case session.hovered of
   197                          HoverState.Hovered domID ->
   198                              [ Effects.GetViewportOf domID
   199                              ]
   200  
   201                          _ ->
   202                              []
   203                     )
   204              )
   205  
   206          _ ->
   207              ( model, effects )