Merge branch 'dev-warnings-cleanup' of...

Merge branch 'dev-warnings-cleanup' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev

src/Gargantext/Components/Graph.purs

@@ -30,6 +30,7 @@ type Props sigma forceatlas2 =
   ( elRef :: R.Ref (Nullable Element)
   , forceAtlas2Settings :: forceatlas2
   , graph :: Graph
+  , selectedEdgeIds :: R.State SigmaxTypes.SelectedEdgeIds
   , selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds
   , sigmaSettings :: sigma
   , sigmaRef :: R.Ref Sigmax.Sigma
@@ -79,6 +80,7 @@ graphCpt = R.hooksComponent "Graph" cpt
 
                 -- bind the click event only initially, when ref was empty
                 Sigmax.bindSelectedNodesClick props.sigmaRef props.selectedNodeIds
+                Sigmax.bindSelectedEdgesClick props.sigmaRef props.selectedEdgeIds
           Just sig -> do
             pure unit
 
@@ -89,11 +91,13 @@ graphCpt = R.hooksComponent "Graph" cpt
           pure $ pure unit
 
     stageHooks props@{stage: (Ready /\ setStage)} = do
-      let nodesMap = SigmaxTypes.nodesMap props.graph
+      let edgesMap = SigmaxTypes.edgesGraphMap props.graph
+      let nodesMap = SigmaxTypes.nodesGraphMap props.graph
 
       -- TODO Probably this can be optimized to re-mark selected nodes only when they changed
       R.useEffect' $ do
-        Sigmax.dependOnSigma (R.readRef props.sigmaRef) "[graphCpt] no sigma" $ \sigma ->
+        Sigmax.dependOnSigma (R.readRef props.sigmaRef) "[graphCpt] no sigma" $ \sigma -> do
+          Sigmax.markSelectedEdges sigma (fst props.selectedEdgeIds) edgesMap
           Sigmax.markSelectedNodes sigma (fst props.selectedNodeIds) nodesMap
 
     stageHooks _ = pure unit
@@ -108,7 +112,7 @@ type SigmaSettings =
   -- , canvasEdgesBatchSize :: Number
   -- , clone :: Boolean
   -- , defaultEdgeColor :: String
-  -- , defaultEdgeHoverColor :: String
+  , defaultEdgeHoverColor :: String
   , defaultEdgeType :: String
   , defaultHoverLabelBGColor :: String
   , defaultHoverLabelColor :: String
@@ -119,7 +123,7 @@ type SigmaSettings =
   , defaultNodeColor :: String
   -- , defaultNodeHoverColor :: String
   -- , defaultNodeType :: String
-  -- , doubleClickEnabled :: Boolean
+  , doubleClickEnabled :: Boolean
   -- , doubleClickTimeout :: Number
   -- , doubleClickZoomDuration :: Number
   -- , doubleClickZoomingRatio :: Number
@@ -130,10 +134,10 @@ type SigmaSettings =
   , drawLabels :: Boolean
   , drawNodes :: Boolean
   -- , edgeColor :: String
-  -- , edgeHoverColor :: String
-  -- , edgeHoverExtremities :: Boolean
+  , edgeHoverColor :: String
+  , edgeHoverExtremities :: Boolean
   -- , edgeHoverPrecision :: Number
-  -- , edgeHoverSizeRatio :: Number
+  , edgeHoverSizeRatio :: Number
   -- , edgesPowRatio :: Number
   -- , enableCamera :: Boolean
   , enableEdgeHovering :: Boolean
@@ -198,6 +202,7 @@ sigmaSettings =
   , autoResize: true
   , batchEdgesDrawing: true
   , borderSize: 3.0                   -- for ex, bigger border when hover
+  , defaultEdgeHoverColor: "#f00"
   , defaultEdgeType: "curve"          -- 'curve' or 'line' (curve iff ourRendering)
   , defaultHoverLabelBGColor: "#fff"
   , defaultHoverLabelColor: "#000"
@@ -205,11 +210,15 @@ sigmaSettings =
   , defaultLabelSize: 8.0                -- (old tina: showLabelsIfZoom)
   , defaultNodeBorderColor: "black"   -- <- if nodeBorderColor = 'default'
   , defaultNodeColor: "#ddd"
+  , doubleClickEnabled: false
   , drawEdgeLabels: true
   , drawEdges: true
   , drawLabels: true
   , drawNodes: true
-  , enableEdgeHovering: false
+  , enableEdgeHovering: true
+  , edgeHoverExtremities: true
+  , edgeHoverColor: "edge"
+  , edgeHoverSizeRatio: 2.0
   , enableHovering: true
   , font: "Droid Sans"                -- font params
   , fontStyle: "bold"

src/Gargantext/Components/GraphExplorer.purs

@@ -5,6 +5,7 @@ import Gargantext.Prelude hiding (max,min)
 import Data.FoldableWithIndex (foldMapWithIndex)
 import Data.Foldable (foldMap)
 import Data.Int (toNumber)
+import Data.Map as Map
 import Data.Maybe (Maybe(..))
 import Data.Nullable (null, Nullable)
 import Data.Sequence as Seq
@@ -77,6 +78,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
       graphRef <- R.useRef null
       controls <- Controls.useGraphControls
       selectedNodeIds <- R.useState' $ Set.empty
+      selectedEdgeIds <- R.useState' $ Set.empty
 
       R.useEffect' $ do
         case Tuple (R.readRef dataRef) graph of
@@ -87,6 +89,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
             Sigmax.cleanupSigma rSigma "explorerCpt"
             R.setRef dataRef graph
             snd selectedNodeIds $ const Set.empty
+            snd selectedEdgeIds $ const Set.empty
             snd controls.graphStage $ const Graph.Init
 
       R.useEffect' $ do
@@ -109,7 +112,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
                 , row [ Controls.controls controls ]
                 , row [ tree (fst controls.showTree) {sessions, mCurrentRoute, frontends} (snd showLogin)
                       , RH.div { ref: graphRef, id: "graph-view", className: graphClassName controls, style: {height: "95%"} } []  -- graph container
-                      , mGraph graphRef controls.sigmaRef {graphId, graph, graphStage: controls.graphStage, selectedNodeIds}
+                      , mGraph graphRef controls.sigmaRef {graphId, graph, graphStage: controls.graphStage, selectedNodeIds, selectedEdgeIds}
                       , mSidebar graph mMetaData {frontends, session, selectedNodeIds, showSidePanel: fst controls.showSidePanel}
                       ]
                 , row [
@@ -147,7 +150,8 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
            -> { graphId :: GraphId
               , graph :: Maybe Graph.Graph
               , graphStage :: R.State Graph.Stage
-              , selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds}
+              , selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds
+              , selectedEdgeIds :: R.State SigmaxTypes.SelectedEdgeIds}
            -> R.Element
     mGraph _ _ {graph: Nothing} = RH.div {} []
     mGraph graphRef sigmaRef r@{graph: Just graph} = graphView graphRef sigmaRef $ r { graph = graph }
@@ -175,6 +179,7 @@ type GraphProps = (
   , graph :: Graph.Graph
   , graphStage :: R.State Graph.Stage
   , selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds
+  , selectedEdgeIds :: R.State SigmaxTypes.SelectedEdgeIds
 )
 
 graphView :: R.Ref (Nullable Element) -> R.Ref Sigma -> Record GraphProps -> R.Element
@@ -183,11 +188,12 @@ graphView elRef sigmaRef props = R.createElement el props []
   where
     --memoCmp props1 props2 = props1.graphId == props2.graphId
     el = R.hooksComponent "GraphView" cpt
-    cpt {graphId, graph, selectedNodeIds} _children = do
+    cpt {graphId, graph, selectedEdgeIds, selectedNodeIds} _children = do
       pure $ Graph.graph {
           elRef
         , forceAtlas2Settings: Graph.forceAtlas2Settings
         , graph
+        , selectedEdgeIds
         , selectedNodeIds
         , sigmaSettings: Graph.sigmaSettings
         , sigmaRef: sigmaRef
@@ -209,8 +215,13 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxTypes.Graph {nodes, edges}
         }
       where
         cDef (GET.Cluster {clustDefault}) = clustDefault
+    nodesMap = SigmaxTypes.nodesMap $ Seq.toUnfoldable nodes
     edges = foldMap edgeFn r.edges
-    edgeFn (GET.Edge e) = Seq.singleton {id : e.id_, source : e.source, target : e.target}
+    edgeFn (GET.Edge e) = Seq.singleton {id : e.id_, color, size: 1.5, source : e.source, target : e.target}
+      where
+        color = case Map.lookup e.source nodesMap of
+          Nothing -> "#000000"
+          Just node -> node.color
 
 defaultPalette :: Array String
 defaultPalette = ["#5fa571","#ab9ba2","#da876d","#bdd3ff","#b399df","#ffdfed","#33c8f3","#739e9a","#caeca3","#f6f7e5","#f9bcca","#ccb069","#c9ffde","#c58683","#6c9eb0","#ffd3cf","#ccffc7","#52a1b0","#d2ecff","#99fffe","#9295ae","#5ea38b","#fff0b3","#d99e68"]

src/Gargantext/Components/GraphExplorer/Sidebar.purs

@@ -40,7 +40,7 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
     cpt {showSidePanel: GET.InitialClosed} _children = do
       pure $ RH.div {} []
     cpt props _children = do
-      let nodesMap = SigmaxTypes.nodesMap props.graph
+      let nodesMap = SigmaxTypes.nodesGraphMap props.graph
 
       pure $
         RH.div { id: "sp-container", className: "col-md-2" }

src/Gargantext/Components/Nodes/Annuaire.purs

@@ -56,9 +56,10 @@ annuaire props = R.createElement annuaireCpt props []
 
 -- Abuses closure to work around the Loader
 annuaireCpt :: R.Component AnnuaireProps
-annuaireCpt = R.staticComponent "G.P.Annuaire.annuaire" cpt
+annuaireCpt = R.hooksComponent "G.P.Annuaire.annuaire" cpt
   where
-    cpt {session, path, info: info@(AnnuaireInfo {name, date: date'}), frontends} _ = R.fragment
+    cpt {session, path, info: info@(AnnuaireInfo {name, date: date'}), frontends} _ =
+      pure $ R.fragment
       [ T.tableHeaderLayout headerProps
       , H.p {} []
       , H.div {className: "col-md-3"}

src/Gargantext/Hooks/Sigmax.purs

 module Gargantext.Hooks.Sigmax
   where
 
-import DOM.Simple.Console (log, log2)
-import DOM.Simple.Types (Element)
 import Data.Array as A
 import Data.Either (either)
 import Data.Foldable (sequence_)
@@ -15,12 +13,14 @@ import Data.Set as Set
 import Data.Traversable (traverse_)
 import Data.Tuple (Tuple(..))
 import Data.Tuple.Nested((/\))
+import DOM.Simple.Console (log, log2)
+import DOM.Simple.Types (Element)
 import Effect (Effect)
 import Effect.Class.Console (error)
 import Effect.Timer (TimeoutId, clearTimeout)
 import FFI.Simple ((.=))
 import Gargantext.Hooks.Sigmax.Sigma as Sigma
-import Gargantext.Hooks.Sigmax.Types (Graph(..), NodesMap, SelectedNodeIds)
+import Gargantext.Hooks.Sigmax.Types (Graph(..), EdgesMap, NodesMap, SelectedNodeIds, SelectedEdgeIds)
 import Gargantext.Utils.Reactix as R2
 import Prelude (Unit, bind, discard, flip, pure, unit, ($), (*>), (<<<), (<>), (>>=), not)
 import Reactix as R
@@ -153,6 +153,21 @@ setEdges sigma val = do
       Sigma.setSettings sigma settings
     _ -> pure unit
 
+markSelectedEdges :: Sigma.Sigma -> SelectedEdgeIds -> EdgesMap -> Effect Unit
+markSelectedEdges sigma selectedEdgeIds graphEdges = do
+  Sigma.forEachEdge sigma \e -> do
+    case Map.lookup e.id graphEdges of
+      Nothing -> error $ "Edge id " <> e.id <> " not found in graphEdges map"
+      Just {color} -> do
+        let newColor =
+              if Set.member e.id selectedEdgeIds then
+                "#ff0000"
+              else
+                color
+        _ <- pure $ (e .= "color") newColor
+        pure unit
+  Sigma.refresh sigma
+
 markSelectedNodes :: Sigma.Sigma -> SelectedNodeIds -> NodesMap -> Effect Unit
 markSelectedNodes sigma selectedNodeIds graphNodes = do
   Sigma.forEachNode sigma \n -> do
@@ -171,10 +186,21 @@ markSelectedNodes sigma selectedNodeIds graphNodes = do
 
 bindSelectedNodesClick :: R.Ref Sigma -> R.State SelectedNodeIds -> Effect Unit
 bindSelectedNodesClick sigmaRef (_ /\ setSelectedNodeIds) =
-  dependOnSigma (R.readRef sigmaRef) "[graphCpt] no sigma" $ \sigma ->
+  dependOnSigma (R.readRef sigmaRef) "[graphCpt] no sigma" $ \sigma -> do
     Sigma.bindClickNode sigma $ \node -> do
       setSelectedNodeIds \nids ->
         if Set.member node.id nids then
           Set.delete node.id nids
         else
           Set.insert node.id nids
+
+bindSelectedEdgesClick :: R.Ref Sigma -> R.State SelectedEdgeIds -> Effect Unit
+bindSelectedEdgesClick sigmaRef (_ /\ setSelectedEdgeIds) =
+  dependOnSigma (R.readRef sigmaRef) "[graphCpt] no sigma" $ \sigma -> do
+    Sigma.bindClickEdge sigma $ \edge -> do
+      log2 "[bindClickEdge] edge" edge
+      setSelectedEdgeIds \eids ->
+        if Set.member edge.id eids then
+          Set.delete edge.id eids
+        else
+          Set.insert edge.id eids

src/Gargantext/Hooks/Sigmax/Sigma.purs

@@ -142,6 +142,24 @@ bindClickNode s f = bind_ s "clickNode" $ \e -> do
 unbindClickNode :: Sigma -> Effect Unit
 unbindClickNode s = unbind_ s "clickNode"
 
+bindOverNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
+bindOverNode s f = bind_ s "overNode" $ \e -> do
+  let node = e .. "data" .. "node" :: Record Types.Node
+  f node
+
+bindClickEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
+bindClickEdge s f = bind_ s "clickEdge" $ \e -> do
+  let edge = e .. "data" .. "edge" :: Record Types.Edge
+  f edge
+
+unbindClickEdge :: Sigma -> Effect Unit
+unbindClickEdge s = unbind_ s "clickEdge"
+
+bindOverEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
+bindOverEdge s f = bind_ s "overEdge" $ \e -> do
+  let edge = e .. "data" .. "edge" :: Record Types.Edge
+  f edge
+
 setSettings :: forall settings. Sigma -> settings -> Effect Unit
 setSettings s settings = do
   runEffectFn2 _setSettings s settings

src/Gargantext/Hooks/Sigmax/Types.purs

@@ -2,7 +2,7 @@ module Gargantext.Hooks.Sigmax.Types where
 
 import Prelude (map, ($), (&&), (==))
 import Data.Map as Map
-import Data.Sequence (Seq)
+import Data.Sequence (Seq, toUnfoldable)
 import Data.Set as Set
 import Data.Tuple (Tuple(..))
 import DOM.Simple.Types (Element)
@@ -26,15 +26,30 @@ type Node =
   , size  :: Number
   , color :: String )
 
-type Edge = ( id :: String, source :: String, target :: String )
+type Edge =
+  ( id :: String
+  , color :: String
+  , size :: Number
+  , source :: String
+  , target :: String )
 
 type SelectedNodeIds = Set.Set String
+type SelectedEdgeIds = Set.Set String
+type EdgesMap = Map.Map String (Record Edge)
 type NodesMap = Map.Map String (Record Node)
 
-nodesMap :: Graph Node Edge -> NodesMap
-nodesMap graph = do
+edgesGraphMap :: Graph Node Edge -> EdgesMap
+edgesGraphMap graph = do
+  let (Graph {edges}) = graph
+  Map.fromFoldable $ map (\e -> Tuple e.id e) edges
+
+nodesMap :: Array (Record Node) -> NodesMap
+nodesMap nodes = Map.fromFoldable $ map (\n -> Tuple n.id n) nodes
+
+nodesGraphMap :: Graph Node Edge -> NodesMap
+nodesGraphMap graph = do
   let (Graph {nodes}) = graph
-  Map.fromFoldable $ map (\n -> Tuple n.id n) nodes
+  nodesMap $ toUnfoldable nodes
 
 eqGraph :: (Graph Node Edge) -> (Graph Node Edge) -> Boolean
 eqGraph (Graph {nodes: n1, edges: e1}) (Graph {nodes: n2, edges: e2}) = (n1 == n2) && (e1 == e2)