Merge branch 'feature/hovercard' into develop

elm.json.base

@@ -27,6 +27,7 @@
             "elm/http": "2.0.0",
             "elm/json": "1.1.3",
             "elm/regex": "1.0.0",
+            "elm/svg": "1.0.1",
             "elm/time": "1.0.0",
             "elm/url": "1.0.0",
             "elm-community/basics-extra": "4.1.0",
@@ -41,7 +42,7 @@
             "jschomay/elm-bounded-number": "2.1.2",
             "krisajenkins/remotedata": "6.0.1",
             "lukewestby/elm-string-interpolate": "1.0.4",
-            "myrho/elm-hovercard": "3.0.0",
+            "myrho/elm-hovercard": "4.0.0",
             "myrho/numeral-elm": "1.0.1",
             "myrho/yaml": "1.0.0",
             "noahzgordon/elm-color-extra": "1.0.2",
@@ -55,7 +56,6 @@
             "elm/bytes": "1.0.8",
             "elm/parser": "1.1.0",
             "elm/random": "1.0.0",
-            "elm/svg": "1.0.1",
             "elm/virtual-dom": "1.0.3",
             "elm-explorations/test": "1.2.2",
             "fredcy/elm-parseint": "2.0.1",

src/Css/Browser.elm

@@ -8,7 +8,6 @@ root : Config -> Float -> List Style
 root vc width =
     position absolute
         :: height (px 0)
-        :: (zIndex <| int 50)
         :: (maxWidth <| px width)
         :: vc.theme.browser.root
 

src/Css/Graph.elm

@@ -53,6 +53,7 @@ svgRoot : Config -> List Style
 svgRoot vc =
     [ pct 100 |> width
     , property "color" "black"
+    , property "user-select" "none"
     ]
         ++ vc.theme.graph.svgRoot vc.lightmode
 
@@ -215,7 +216,6 @@ searchTextarea vc =
 toolbox : Config -> Bool -> List Style
 toolbox vc visible =
     position absolute
-        :: Util.Css.zIndexMain
         :: vc.theme.graph.toolbox vc.lightmode visible
 
 

src/Css/Header.elm

@@ -2,14 +2,15 @@ module Css.Header exposing (..)
 
 import Config.View exposing (Config)
 import Css exposing (..)
+import Util.Css
 
 
 header : Config -> List Style
 header vc =
     [ displayFlex
     , flexDirection row
     , justifyContent spaceBetween
-    , zIndex <| int 51
+    , zIndex <| int <| Util.Css.zIndexMainValue + 1
     ]
         ++ vc.theme.header vc.lightmode
 

src/Css/View.elm

@@ -89,7 +89,8 @@ contents vc =
 
 tool : Config -> List Style
 tool vc =
-    vc.theme.tool
+    cursor pointer
+        :: vc.theme.tool
 
 
 hovercard : Config -> List ( String, String )

src/Init.elm

@@ -45,7 +45,7 @@ init plugins flags url key =
       , user =
             { apiKey = ""
             , auth = Unknown
-            , hovercardElement = Nothing
+            , hovercard = Nothing
             }
       , stats = NotAsked
       , width = flags.width

src/Init/Graph.elm

@@ -36,4 +36,5 @@ init us now =
     , history = History.init
     , highlights = Highlighter.init
     , selectIfLoaded = Nothing
+    , hovercard = Nothing
     }

src/Init/Graph/Search.elm

@@ -1,21 +1,31 @@
 module Init.Graph.Search exposing (..)
 
 import Api.Data
-import Browser.Dom as Dom
-import Model.Graph.Id exposing (EntityId)
+import Hovercard
+import Model.Graph.Id exposing (EntityId, entityIdToString)
 import Model.Graph.Search exposing (..)
+import Msg.Graph exposing (Msg(..))
+import Tuple exposing (mapSecond)
 
 
-init : List Api.Data.Concept -> Dom.Element -> EntityId -> Model
-init categories element entityId =
-    { direction = Outgoing
-    , criterion = initCriterion categories
-    , id = entityId
-    , element = element
-    , depth = "2"
-    , breadth = "20"
-    , maxAddresses = "100"
-    }
+init : List Api.Data.Concept -> EntityId -> ( Model, Cmd Msg )
+init categories entityId =
+    let
+        ( hovercard, cmd ) =
+            entityIdToString entityId
+                |> Hovercard.init
+                |> mapSecond (Cmd.map SearchHovercardMsg)
+    in
+    ( { direction = Outgoing
+      , criterion = initCriterion categories
+      , id = entityId
+      , hovercard = hovercard
+      , depth = "2"
+      , breadth = "20"
+      , maxAddresses = "100"
+      }
+    , cmd
+    )
 
 
 initCriterion : List Api.Data.Concept -> Criterion

src/Init/Graph/Tag.elm

@@ -1,27 +1,46 @@
 module Init.Graph.Tag exposing (..)
 
 import Browser.Dom as Dom
+import Hovercard
 import Init.Search as Search
 import Model.Graph.Id exposing (..)
 import Model.Graph.Tag exposing (..)
 import Model.Node exposing (Node(..))
 import Model.Search as Search
+import Msg.Graph exposing (Msg(..))
+import Tuple exposing (mapSecond)
 
 
-initAddressTag : AddressId -> Dom.Element -> Maybe UserTag -> Model
-initAddressTag id element existing =
-    { input = initInput (Address id) existing
-    , existing = existing
-    , hovercardElement = element
-    }
+initAddressTag : AddressId -> Maybe UserTag -> ( Model, Cmd Msg )
+initAddressTag id existing =
+    let
+        ( hovercard, cmd ) =
+            addressIdToString id
+                |> Hovercard.init
+                |> mapSecond (Cmd.map TagHovercardMsg)
+    in
+    ( { input = initInput (Address id) existing
+      , existing = existing
+      , hovercard = hovercard
+      }
+    , cmd
+    )
 
 
-initEntityTag : EntityId -> Dom.Element -> Maybe UserTag -> Model
-initEntityTag id element existing =
-    { input = initInput (Entity id) existing
-    , existing = existing
-    , hovercardElement = element
-    }
+initEntityTag : EntityId -> Maybe UserTag -> ( Model, Cmd Msg )
+initEntityTag id existing =
+    let
+        ( hovercard, cmd ) =
+            entityIdToString id
+                |> Hovercard.init
+                |> mapSecond (Cmd.map TagHovercardMsg)
+    in
+    ( { input = initInput (Entity id) existing
+      , existing = existing
+      , hovercard = hovercard
+      }
+    , cmd
+    )
 
 
 initInput : Node AddressId EntityId -> Maybe UserTag -> Input

src/Model.elm

@@ -10,6 +10,7 @@ import Effect.Api
 import Effect.Graph
 import Effect.Locale
 import Effect.Search
+import Hovercard
 import Http
 import Json.Encode
 import Model.Dialog
@@ -23,6 +24,7 @@ import Msg.Search
 import Plugin.Model as Plugin
 import Plugin.Msg as Plugin
 import RemoteData exposing (WebData)
+import Theme.Hovercard exposing (Hovercard)
 import Time
 import Url exposing (Url)
 
@@ -73,7 +75,7 @@ type Msg
     | UserSwitchesLocale String
     | UserSubmitsApiKeyForm
     | UserInputsApiKeyForm String
-    | UserHoversUserIcon String
+    | UserClickedUserIcon String
     | UserLeftUserHovercard
     | UserClickedLayout
     | UserClickedConfirm Msg
@@ -96,6 +98,7 @@ type Msg
     | GraphMsg Msg.Graph.Msg
     | PluginMsg Plugin.Msg
     | UserClickedExampleSearch String
+    | UserHovercardMsg Hovercard.Msg
 
 
 type RequestLimit
@@ -111,7 +114,7 @@ showResetCounterAtRemaining =
 type alias UserModel =
     { auth : Auth
     , apiKey : String
-    , hovercardElement : Maybe Browser.Dom.Element
+    , hovercard : Maybe Hovercard.Model
     }
 
 

src/Model/Graph.elm

@@ -5,6 +5,7 @@ import Browser.Dom as Dom
 import Color
 import Config.Graph exposing (Config)
 import Dict exposing (Dict)
+import Hovercard
 import IntDict exposing (IntDict)
 import Model.Address as A
 import Model.Entity as E
@@ -41,6 +42,7 @@ type alias Model =
     , history : History.Model
     , highlights : Highlighter.Model
     , selectIfLoaded : Maybe SelectIfLoaded
+    , hovercard : Maybe Hovercard.Model
     }
 
 

src/Model/Graph/Search.elm

@@ -2,14 +2,15 @@ module Model.Graph.Search exposing (..)
 
 import Api.Data
 import Browser.Dom as Dom
+import Hovercard
 import Model.Graph.Id exposing (EntityId)
 
 
 type alias Model =
     { direction : Direction
     , criterion : Criterion
     , id : EntityId
-    , element : Dom.Element
+    , hovercard : Hovercard.Model
     , depth : String
     , breadth : String
     , maxAddresses : String

src/Model/Graph/Tag.elm

@@ -2,6 +2,7 @@ module Model.Graph.Tag exposing (..)
 
 import Api.Data
 import Browser.Dom as Dom
+import Hovercard
 import Model.Graph.Id exposing (AddressId, EntityId)
 import Model.Node exposing (Node)
 import Model.Search as Search
@@ -10,7 +11,7 @@ import Model.Search as Search
 type alias Model =
     { input : Input
     , existing : Maybe UserTag
-    , hovercardElement : Dom.Element
+    , hovercard : Hovercard.Model
     }
 
 

src/Msg/Graph.elm

@@ -4,6 +4,7 @@ import Api.Data
 import Browser.Dom
 import Color
 import File
+import Hovercard
 import Json.Encode
 import Model.Actor as Act
 import Model.Address as A
@@ -105,8 +106,6 @@ type Msg
     | InternalGraphSelectedAddress AddressId
     | UserScrolledTable Browser.ScrollPos
     | TagSearchMsg Search.Msg
-    | BrowserGotAddressElementForAnnotate AddressId (Result Browser.Dom.Error Browser.Dom.Element)
-    | BrowserGotEntityElementForAnnotate EntityId (Result Browser.Dom.Error Browser.Dom.Element)
     | UserInputsTagSource String
     | UserInputsTagCategory String
     | UserInputsTagAbuse String
@@ -127,7 +126,6 @@ type Msg
     | UserChangesAddressLabelType String
     | UserChangesTxLabelType String
     | UserClickedSearch EntityId
-    | BrowserGotEntityElementForSearch EntityId (Result Browser.Dom.Error Browser.Dom.Element)
     | UserSelectsDirection String
     | UserSelectsCriterion String
     | UserSelectsSearchCategory String
@@ -176,3 +174,5 @@ type Msg
     | UserClickedToggleShowZeroTransactions
     | AnimationFrameDeltaForTransform Float
     | RuntimeDebouncedAddingEntities
+    | SearchHovercardMsg Hovercard.Msg
+    | TagHovercardMsg Hovercard.Msg

src/Sub.elm

@@ -2,6 +2,7 @@ module Sub exposing (subscriptions)
 
 import Browser.Events
 import Browser.Navigation as Nav
+import Hovercard
 import Model exposing (Model, Msg(..))
 import Plugin.Sub as Plugin
 import Ports
@@ -33,6 +34,9 @@ subscriptions model =
 
         _ ->
             Sub.none
+    , model.user.hovercard
+        |> Maybe.map (Hovercard.subscriptions >> Sub.map UserHovercardMsg)
+        |> Maybe.withDefault Sub.none
     , Plugin.subscriptions Ports.pluginsIn model.plugins
         |> Sub.map PluginMsg
     ]

src/Sub/Graph.elm

@@ -1,6 +1,7 @@
 module Sub.Graph exposing (subscriptions)
 
 import Browser.Events
+import Hovercard
 import Json.Decode
 import Model.Graph exposing (Dragging(..), Model)
 import Msg.Graph exposing (Msg(..))
@@ -32,5 +33,11 @@ subscriptions model =
                 )
         )
     , Transform.subscriptions model.transform
+    , model.tag
+        |> Maybe.map (.hovercard >> Hovercard.subscriptions >> Sub.map TagHovercardMsg)
+        |> Maybe.withDefault Sub.none
+    , model.search
+        |> Maybe.map (.hovercard >> Hovercard.subscriptions >> Sub.map SearchHovercardMsg)
+        |> Maybe.withDefault Sub.none
     ]
         |> Sub.batch