Commit 2c0ecaa9 authored by Karen Konou's avatar Karen Konou

[Graph Explorer] Add cluster button

parent 694a2d1e
...@@ -128,6 +128,8 @@ sideTabLegendCpt = here.component "sideTabLegend" cpt where ...@@ -128,6 +128,8 @@ sideTabLegendCpt = here.component "sideTabLegend" cpt where
hyperdataGraph hyperdataGraph
<- R2.useLive' store.hyperdataGraph <- R2.useLive' store.hyperdataGraph
legend' /\ legendBox <- R2.useBox' legend
-- | Computed -- | Computed
-- | -- |
let let
...@@ -161,12 +163,13 @@ sideTabLegendCpt = here.component "sideTabLegend" cpt where ...@@ -161,12 +163,13 @@ sideTabLegendCpt = here.component "sideTabLegend" cpt where
{ className: "graph-sidebar__legend-tab" } { className: "graph-sidebar__legend-tab" }
[ [
Legend.legend Legend.legend
{ legendSeq: Seq.fromFoldable legend { legendSeq: Seq.fromFoldable legend'
, extractedNodeList , extractedNodeList
, nodeCountList , nodeCountList
, selectedNodeIds: store.selectedNodeIds , selectedNodeIds: store.selectedNodeIds
, session , session
, graphId , graphId
, legendBox
} }
] ]
......
...@@ -5,14 +5,16 @@ module Gargantext.Components.GraphExplorer.Sidebar.Legend ...@@ -5,14 +5,16 @@ module Gargantext.Components.GraphExplorer.Sidebar.Legend
import Prelude hiding (map) import Prelude hiding (map)
import Control.Applicative (map) import Control.Applicative (map)
import Data.Array (fromFoldable) import Data.Array (fromFoldable, snoc)
import Data.Array as A import Data.Array as A
import Data.Foldable (length)
import Data.Maybe (isJust, maybe) import Data.Maybe (isJust, maybe)
import Data.Sequence (Seq, replace) import Data.Sequence (Seq, replace)
import Data.Set as Set import Data.Set as Set
import Data.Traversable (foldMap, intercalate) import Data.Traversable (foldMap, intercalate)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (launchAff_) import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.Bootstrap as B import Gargantext.Components.Bootstrap as B
import Gargantext.Components.GraphExplorer.API (updateLegend) import Gargantext.Components.GraphExplorer.API (updateLegend)
import Gargantext.Components.GraphExplorer.GraphTypes as GEGT import Gargantext.Components.GraphExplorer.GraphTypes as GEGT
...@@ -36,6 +38,7 @@ type Props = ...@@ -36,6 +38,7 @@ type Props =
, selectedNodeIds :: T.Box ST.NodeIds , selectedNodeIds :: T.Box ST.NodeIds
, session :: Session , session :: Session
, graphId :: GET.GraphId , graphId :: GET.GraphId
, legendBox :: T.Box (Array GET.Legend)
) )
legend :: R2.Leaf Props legend :: R2.Leaf Props
...@@ -48,6 +51,7 @@ legendCpt = here.component "legend" cpt where ...@@ -48,6 +51,7 @@ legendCpt = here.component "legend" cpt where
, selectedNodeIds , selectedNodeIds
, session , session
, graphId , graphId
, legendBox
} _ = do } _ = do
-- | Hooks -- | Hooks
-- | -- |
...@@ -56,34 +60,47 @@ legendCpt = here.component "legend" cpt where ...@@ -56,34 +60,47 @@ legendCpt = here.component "legend" cpt where
-- | -- |
pure $ pure $
H.ul R.fragment
{ className: "graph-legend" }
[ [
flip foldMap legendSeq \(GET.Legend { id_, label, color}) -> H.ul
{ className: "graph-legend" }
[
flip foldMap legendSeq \(GET.Legend { id_, label, color}) ->
H.li H.li
{ className: "graph-legend__item" } { className: "graph-legend__item" }
[
H.button
{ className: "graph-legend__code"
, style: { backgroundColor: GET.intColor id_ }
, on: { click: \_ -> selectNodes id_}
}
[]
,
B.wad
[ "flex-grow-1" ]
[ [
renameable { text: label, className: "graph-legend__label", onRename: \s -> rename s id_ color } H.button
, { className: "graph-legend__code"
selectedNodes , style: { backgroundColor: GET.intColor id_ }
{ selectedNodeIds , on: { click: \_ -> selectNodes id_}
, extractedNodeList
, clusterId: id_
, nodeCount: getClusterNodeCount nodeCountList id_
} }
[]
,
B.wad
[ "flex-grow-1" ]
[
renameable { text: label, className: "graph-legend__label", onRename: \s -> rename s id_ color }
,
selectedNodes
{ selectedNodeIds
, extractedNodeList
, clusterId: id_
, nodeCount: getClusterNodeCount nodeCountList id_
}
]
] ]
] ]
,
H.li
{ className: "graph-legend__item" }
[
H.button
{ className: "fa fa-plus"
, on: { click: \_ -> addCluster }
}
[]
]
] ]
where where
rename :: String -> Int -> String -> Effect Unit rename :: String -> Int -> String -> Effect Unit
...@@ -98,6 +115,14 @@ legendCpt = here.component "legend" cpt where ...@@ -98,6 +115,14 @@ legendCpt = here.component "legend" cpt where
let nodes = filterByCluster id extractedNodeList let nodes = filterByCluster id extractedNodeList
T.write_ (Set.fromFoldable $ map (\(GEGT.Node { id_ }) -> id_) nodes) selectedNodeIds T.write_ (Set.fromFoldable $ map (\(GEGT.Node { id_ }) -> id_) nodes) selectedNodeIds
addCluster :: Effect Unit
addCluster = do
let newLegend = snoc (fromFoldable legendSeq) $ GET.Legend { id_: (length legendSeq) + 1, label: "Cluster" <> show ((length legendSeq) + 1), color: "#ffffff" }
launchAff_ do
_ <- updateLegend { legend: newLegend, graphId, session }
_ <- liftEffect $ T.write newLegend legendBox
pure unit
filterByCluster :: Int -> Array GEGT.Node -> Array GEGT.Node filterByCluster :: Int -> Array GEGT.Node -> Array GEGT.Node
filterByCluster id filterByCluster id
= A.filter = A.filter
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment