Commit effda708 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev-graph-eff-rewrite' into dev

parents 002eb113 83c9beeb
...@@ -2352,11 +2352,11 @@ ...@@ -2352,11 +2352,11 @@
}, },
"read": { "read": {
"dependencies": [ "dependencies": [
"maybe",
"prelude", "prelude",
"maybe",
"strings" "strings"
], ],
"repo": "https://github.com/truqu/purescript-read.git", "repo": "https://github.com/truqu/purescript-read",
"version": "v1.0.1" "version": "v1.0.1"
}, },
"record": { "record": {
......
...@@ -80,6 +80,18 @@ li#rename #rename-a { ...@@ -80,6 +80,18 @@ li#rename #rename-a {
width: 1300px; width: 1300px;
} }
#search-popup-tooltip {
position: absolute;
left: 300px;
top: -300px;
background-color: white;
z-index: 1000;
}
#search-popup-tooltip:hover {
border: none;
text-decoration: none;
}
#create-node-tooltip { #create-node-tooltip {
position: absolute; position: absolute;
left: 96px; left: 96px;
......
...@@ -222,7 +222,7 @@ let additions = ...@@ -222,7 +222,7 @@ let additions =
] ]
"https://github.com/slamdata/purescript-uri" "https://github.com/slamdata/purescript-uri"
"v7.0.0" "v7.0.0"
, read = mkPackage ["purescript-prelude", "purescript-maybe", "purescript-string"] , read = mkPackage ["prelude", "maybe", "strings"]
"https://github.com/truqu/purescript-read" "https://github.com/truqu/purescript-read"
"v1.0.1" "v1.0.1"
} }
......
...@@ -4,42 +4,37 @@ module Gargantext.Components.Graph ...@@ -4,42 +4,37 @@ module Gargantext.Components.Graph
-- , forceAtlas2Settings, ForceAtlas2Settings, ForceAtlas2OptionalSettings -- , forceAtlas2Settings, ForceAtlas2Settings, ForceAtlas2OptionalSettings
-- ) -- )
where where
import Prelude (bind, discard, pure, ($), unit) import Prelude (bind, discard, pure, ($), unit, map)
import Data.Map as Map
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Nullable (notNull, null, Nullable) import Data.Nullable (notNull, null, Nullable)
import Data.Sequence as Seq import Data.Set as Set
import Data.Tuple (fst, snd, Tuple(..))
import Data.Tuple.Nested ((/\))
import DOM.Simple (createElement, setAttr) import DOM.Simple (createElement, setAttr)
import DOM.Simple.Console (log, log2) import DOM.Simple.Console (log, log2)
import DOM.Simple.Types (Element) import DOM.Simple.Types (Element)
import Effect.Timer (setTimeout) import Effect.Timer (setTimeout)
import FFI.Simple (delay) import FFI.Simple (delay, (..))
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as RH import Reactix.DOM.HTML as RH
import Gargantext.Hooks.Sigmax import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Types as Sigmax import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
type OnProps = () type OnProps = ()
type Node = type Graph = SigmaxTypes.Graph SigmaxTypes.Node SigmaxTypes.Edge
( id :: String
, label :: String
, x :: Number
, y :: Number
, size :: Number
, color :: String )
type Edge = ( id :: String, source :: String, target :: String )
type Graph = Sigmax.Graph Node Edge
type Props sigma forceatlas2 = type Props sigma forceatlas2 =
( elRef :: R.Ref (Nullable Element) ( elRef :: R.Ref (Nullable Element)
, forceAtlas2Settings :: forceatlas2 , forceAtlas2Settings :: forceatlas2
, graph :: Graph , graph :: Graph
, selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds
, sigmaSettings :: sigma , sigmaSettings :: sigma
, sigmaRef :: R.Ref Sigma , sigmaRef :: R.Ref Sigmax.Sigma
) )
graph :: forall s fa2. Record (Props s fa2) -> R.Element graph :: forall s fa2. Record (Props s fa2) -> R.Element
...@@ -49,28 +44,25 @@ graphCpt :: forall s fa2. R.Component (Props s fa2) ...@@ -49,28 +44,25 @@ graphCpt :: forall s fa2. R.Component (Props s fa2)
graphCpt = R.hooksComponent "Graph" cpt graphCpt = R.hooksComponent "Graph" cpt
where where
cpt props _ = do cpt props _ = do
-- R.useEffectOnce' $ do let nodesMap = SigmaxTypes.nodesMap props.graph
-- el <- case R.readNullableRef props.elRef of let selectedNodeIds = props.selectedNodeIds
-- Just el -> do
-- pure el
-- Nothing -> do
-- let el = createElement "div"
-- setAttr el "style" "height: 95%"
-- setAttr el "id" "graph-cpt-root"
-- R.setRef props.elRef $ notNull $ el
-- pure el
-- case R.readNullableRef props.parentRef of R.useEffect' $ do
-- Nothing -> pure unit Sigmax.dependOnSigma (R.readRef props.sigmaRef) "[graphCpt] no sigma" $ \sigma ->
-- Just parentEl -> R2.appendChild parentEl el Sigmax.markSelectedNodes sigma (fst selectedNodeIds) nodesMap
-- pure unit
R.useEffectOnce $ do R.useEffectOnce $ do
--log "[graphCpt] calling startSigmaEff" let mSigma = Sigmax.readSigma $ R.readRef props.sigmaRef
startSigmaEff props.elRef props.sigmaRef props.sigmaSettings props.forceAtlas2Settings props.graph
Sigmax.startSigmaEff props.elRef props.sigmaRef props.sigmaSettings props.forceAtlas2Settings props.graph
-- bind the click event only initially, when ref was empty
case mSigma of
Nothing -> Sigmax.bindSelectedNodesClick props.sigmaRef selectedNodeIds
Just _ -> pure unit
delay unit $ \_ -> do delay unit $ \_ -> do
log "[GraphCpt] cleaning up" log "[GraphCpt] cleanup"
pure $ pure unit pure $ pure unit
-- NOTE: This div is not empty after sigma initializes. -- NOTE: This div is not empty after sigma initializes.
......
...@@ -5,10 +5,12 @@ import Gargantext.Prelude hiding (max,min) ...@@ -5,10 +5,12 @@ import Gargantext.Prelude hiding (max,min)
import Data.FoldableWithIndex (foldMapWithIndex) import Data.FoldableWithIndex (foldMapWithIndex)
import Data.Foldable (foldMap) import Data.Foldable (foldMap)
import Data.Int (toNumber) import Data.Int (toNumber)
import Data.Map as Map
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Nullable (null, Nullable) import Data.Nullable (null, Nullable)
import Data.Sequence as Seq import Data.Sequence as Seq
import Data.Tuple (fst,snd) import Data.Set as Set
import Data.Tuple (fst, snd, Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Types (Element) import DOM.Simple.Types (Element)
import Effect.Aff (Aff) import Effect.Aff (Aff)
...@@ -17,7 +19,7 @@ import Reactix.DOM.HTML as RH ...@@ -17,7 +19,7 @@ import Reactix.DOM.HTML as RH
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Sigmax (Sigma) import Gargantext.Hooks.Sigmax (Sigma)
import Gargantext.Hooks.Sigmax.Types as Sigmax import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Components.GraphExplorer.Controls as Controls import Gargantext.Components.GraphExplorer.Controls as Controls
import Gargantext.Components.GraphExplorer.Sidebar as Sidebar import Gargantext.Components.GraphExplorer.Sidebar as Sidebar
import Gargantext.Components.GraphExplorer.ToggleButton as Toggle import Gargantext.Components.GraphExplorer.ToggleButton as Toggle
...@@ -33,15 +35,17 @@ type GraphId = Int ...@@ -33,15 +35,17 @@ type GraphId = Int
type LayoutProps = type LayoutProps =
( graphId :: GraphId ( graphId :: GraphId
, frontends :: Frontends
, mCurrentRoute :: AppRoute , mCurrentRoute :: AppRoute
, treeId :: Maybe Int
, session :: Session , session :: Session
, sessions :: Sessions , sessions :: Sessions
, frontends :: Frontends , treeId :: Maybe Int
) )
type Props = ( type Props = (
graph :: Maybe Graph.Graph | LayoutProps graph :: Maybe Graph.Graph
, mMetaData :: Maybe GET.MetaData
| LayoutProps
) )
-------------------------------------------------------------- --------------------------------------------------------------
...@@ -55,8 +59,8 @@ explorerLayoutCpt = R.hooksComponent "G.C.GraphExplorer.explorerLayout" cpt ...@@ -55,8 +59,8 @@ explorerLayoutCpt = R.hooksComponent "G.C.GraphExplorer.explorerLayout" cpt
useLoader graphId (getNodes session) handler useLoader graphId (getNodes session) handler
where where
handler loaded = handler loaded =
explorer {graphId, mCurrentRoute, treeId, session, sessions, graph, frontends} explorer {graphId, mCurrentRoute, mMetaData, treeId, session, sessions, graph: Just graph, frontends}
where graph = Just (convert loaded) where (Tuple mMetaData graph) = convert loaded
-------------------------------------------------------------- --------------------------------------------------------------
explorer :: Record Props -> R.Element explorer :: Record Props -> R.Element
...@@ -65,11 +69,13 @@ explorer props = R.createElement explorerCpt props [] ...@@ -65,11 +69,13 @@ explorer props = R.createElement explorerCpt props []
explorerCpt :: R.Component Props explorerCpt :: R.Component Props
explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
where where
cpt {sessions, session, graphId, mCurrentRoute, treeId, graph, frontends} _ = do cpt {frontends, graph, graphId, mCurrentRoute, mMetaData, session, sessions, treeId} _ = do
graphRef <- R.useRef null graphRef <- R.useRef null
controls <- Controls.useGraphControls controls <- Controls.useGraphControls
state <- useExplorerState state <- useExplorerState
showLogin <- snd <$> R.useState' true showLogin <- snd <$> R.useState' true
selectedNodeIds <- R.useState' $ Set.empty
pure $ pure $
RH.div RH.div
{ id: "graph-explorer" } { id: "graph-explorer" }
...@@ -84,8 +90,9 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt ...@@ -84,8 +90,9 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
, row [ Controls.controls controls ] , row [ Controls.controls controls ]
, row [ tree {mCurrentRoute, treeId} controls showLogin , row [ tree {mCurrentRoute, treeId} controls showLogin
, RH.div { ref: graphRef, id: "graph-view", className: "col-md-12", style: {height: "95%"} } [] -- graph container , RH.div { ref: graphRef, id: "graph-view", className: "col-md-12", style: {height: "95%"} } [] -- graph container
, mGraph graphRef controls.sigmaRef {graphId, graph} , mGraph graphRef controls.sigmaRef {graphId, graph, selectedNodeIds}
, Sidebar.sidebar {showSidePanel: fst controls.showSidePanel} ] , mSidebar graph mMetaData {session, selectedNodeIds, showSidePanel: fst controls.showSidePanel}
]
, row [ , row [
] ]
] ]
...@@ -107,9 +114,30 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt ...@@ -107,9 +114,30 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
pullLeft = RH.div { className: "pull-left" } pullLeft = RH.div { className: "pull-left" }
pullRight = RH.div { className: "pull-right" } pullRight = RH.div { className: "pull-right" }
mGraph :: R.Ref (Nullable Element) -> R.Ref Sigma -> {graphId :: GraphId, graph :: Maybe Graph.Graph} -> R.Element mGraph :: R.Ref (Nullable Element)
-> R.Ref Sigma
-> { graphId :: GraphId
, graph :: Maybe Graph.Graph
, selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds}
-> R.Element
mGraph _ _ {graph: Nothing} = RH.div {} [] mGraph _ _ {graph: Nothing} = RH.div {} []
mGraph graphRef sigmaRef {graphId, graph: Just graph} = graphView graphRef sigmaRef {graphId, graph} mGraph graphRef sigmaRef {graphId, graph: Just graph, selectedNodeIds} = graphView graphRef sigmaRef {graphId, graph, selectedNodeIds}
mSidebar :: Maybe Graph.Graph
-> Maybe GET.MetaData
-> { showSidePanel :: Boolean
, selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds
, session :: Session }
-> R.Element
mSidebar Nothing _ _ = RH.div {} []
mSidebar _ Nothing _ = RH.div {} []
mSidebar (Just graph) (Just metaData) {session, selectedNodeIds, showSidePanel} =
Sidebar.sidebar { graph
, metaData
, session
, selectedNodeIds
, showSidePanel
}
useExplorerState :: R.Hooks (Record GET.State) useExplorerState :: R.Hooks (Record GET.State)
useExplorerState = do pure {} useExplorerState = do pure {}
...@@ -132,6 +160,7 @@ useExplorerState = do pure {} ...@@ -132,6 +160,7 @@ useExplorerState = do pure {}
type GraphProps = ( type GraphProps = (
graphId :: GraphId graphId :: GraphId
, graph :: Graph.Graph , graph :: Graph.Graph
, selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds
) )
graphView :: R.Ref (Nullable Element) -> R.Ref Sigma -> Record GraphProps -> R.Element graphView :: R.Ref (Nullable Element) -> R.Ref Sigma -> Record GraphProps -> R.Element
...@@ -140,17 +169,18 @@ graphView elRef sigmaRef props = R.createElement el props [] ...@@ -140,17 +169,18 @@ graphView elRef sigmaRef props = R.createElement el props []
where where
--memoCmp props1 props2 = props1.graphId == props2.graphId --memoCmp props1 props2 = props1.graphId == props2.graphId
el = R.hooksComponent "GraphView" cpt el = R.hooksComponent "GraphView" cpt
cpt {graphId, graph} _children = do cpt {graphId, graph, selectedNodeIds} _children = do
pure $ Graph.graph { pure $ Graph.graph {
elRef elRef
, forceAtlas2Settings: Graph.forceAtlas2Settings , forceAtlas2Settings: Graph.forceAtlas2Settings
, graph , graph
, selectedNodeIds
, sigmaSettings: Graph.sigmaSettings , sigmaSettings: Graph.sigmaSettings
, sigmaRef: sigmaRef , sigmaRef: sigmaRef
} }
convert :: GET.GraphData -> Graph.Graph convert :: GET.GraphData -> Tuple (Maybe GET.MetaData) Graph.Graph
convert (GET.GraphData r) = Sigmax.Graph {nodes, edges} convert (GET.GraphData r) = Tuple r.metaData $ SigmaxTypes.Graph {nodes, edges}
where where
nodes = foldMapWithIndex nodeFn r.nodes nodes = foldMapWithIndex nodeFn r.nodes
nodeFn i (GET.Node n) = nodeFn i (GET.Node n) =
...@@ -171,7 +201,7 @@ defaultPalette :: Array String ...@@ -171,7 +201,7 @@ 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"] 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"]
-- clusterColor :: Cluster -> Color -- clusterColor :: Cluster -> Color
-- clusterColor (Cluster {clustDefault}) = unsafePartial $ fromJust $ defaultPalette !! (clustDefault `mod` length defaultPalette) -- clusterColor (Cluster {clustDefault}) = unsafePartial $ fromJust $ defaultPalette !! (clustDefault `molength defrultPalette)
-- div [className "col-md-12", style {"padding-bottom" : "10px"}] -- div [className "col-md-12", style {"padding-bottom" : "10px"}]
-- [ menu [_id "toolbar"] -- [ menu [_id "toolbar"]
......
...@@ -3,10 +3,28 @@ module Gargantext.Components.GraphExplorer.Sidebar ...@@ -3,10 +3,28 @@ module Gargantext.Components.GraphExplorer.Sidebar
where where
import Prelude import Prelude
import Data.Array (head)
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Set as Set
import Data.Tuple.Nested((/\))
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as RH import Reactix.DOM.HTML as RH
type Props = ( showSidePanel :: Boolean ) import Gargantext.Components.RandomText (words)
import Gargantext.Components.Nodes.Corpus.Graph.Tabs as GT
import Gargantext.Components.Graph as Graph
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Sessions (Session)
type Props =
( graph :: Graph.Graph
, metaData :: GET.MetaData
, selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds
, session :: Session
, showSidePanel :: Boolean
)
sidebar :: Record Props -> R.Element sidebar :: Record Props -> R.Element
sidebar props = R.createElement sidebarCpt props [] sidebar props = R.createElement sidebarCpt props []
...@@ -17,6 +35,8 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt ...@@ -17,6 +35,8 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
cpt {showSidePanel: false} _children = do cpt {showSidePanel: false} _children = do
pure $ RH.div {} [] pure $ RH.div {} []
cpt props _children = do cpt props _children = do
let nodesMap = SigmaxTypes.nodesMap props.graph
pure $ pure $
RH.div { id: "sp-container", className: "col-md-2" } RH.div { id: "sp-container", className: "col-md-2" }
[ RH.div {} [ RH.div {}
...@@ -39,7 +59,16 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt ...@@ -39,7 +59,16 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
[ checkbox "Pubs" [ checkbox "Pubs"
, checkbox "Projects" , checkbox "Projects"
, checkbox "Patents" , checkbox "Patents"
, checkbox "Others" ] ] ] ] ] , checkbox "Others"
]
]
, RH.div { className: "col-md-12", id: "query" }
[
query props.metaData props.session nodesMap props.selectedNodeIds
]
]
]
]
badge text = badge text =
RH.a { className: "badge badge-light" } [ RH.text text ] RH.a { className: "badge badge-light" } [ RH.text text ]
checkbox text = checkbox text =
...@@ -59,3 +88,19 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt ...@@ -59,3 +88,19 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
, "software engineering" , "software engineering"
, "complex systems" , "complex systems"
, "wireless communications" ] , "wireless communications" ]
query _ _ _ (selectedNodeIds /\ _) | Set.isEmpty selectedNodeIds = RH.div {} []
query (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _) =
query' (head metaData.corpusId)
where
query' Nothing = RH.div {} []
query' (Just corpusId) =
GT.tabs {session, query: q <$> Set.toUnfoldable selectedNodeIds, sides: [side corpusId]}
q id = case Map.lookup id nodesMap of
Nothing -> []
Just n -> words n.label
side corpusId = GET.GraphSideCorpus {
corpusId
, listId: metaData.listId
, corpusLabel: metaData.title
}
...@@ -8,18 +8,21 @@ import DOM.Simple.Types (Element) ...@@ -8,18 +8,21 @@ import DOM.Simple.Types (Element)
import Data.Array as A import Data.Array as A
import Data.Either (Either(..), either) import Data.Either (Either(..), either)
import Data.Foldable (sequence_) import Data.Foldable (sequence_)
import Data.Map as Map
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable) import Data.Nullable (Nullable)
import Data.Sequence (Seq) import Data.Sequence (Seq)
import Data.Sequence as Seq import Data.Sequence as Seq
import Data.Set as Set
import Data.Traversable (traverse_) import Data.Traversable (traverse_)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Data.Tuple.Nested((/\)) import Data.Tuple.Nested((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Class.Console (error)
import Effect.Timer (TimeoutId, clearTimeout) import Effect.Timer (TimeoutId, clearTimeout)
import FFI.Simple (delay) import FFI.Simple (delay, (.=))
import Gargantext.Hooks.Sigmax.Sigma as Sigma import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Hooks.Sigmax.Types (Graph(..)) import Gargantext.Hooks.Sigmax.Types (Graph(..), Node(..), NodesMap, SelectedNodeIds)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Prelude (Unit, bind, const, discard, flip, pure, unit, ($), (*>), (<$), (<$>), (<<<), (<>), (>>=), not) import Prelude (Unit, bind, const, discard, flip, pure, unit, ($), (*>), (<$), (<$>), (<<<), (<>), (>>=), not)
import Reactix as R import Reactix as R
...@@ -321,8 +324,36 @@ setEdges sigma val = do ...@@ -321,8 +324,36 @@ setEdges sigma val = do
-- prevent showing edges (via show edges button) when FA is running (flickering) -- prevent showing edges (via show edges button) when FA is running (flickering)
isFARunning <- Sigma.isForceAtlas2Running sigma isFARunning <- Sigma.isForceAtlas2Running sigma
case Tuple val isFARunning of case Tuple val isFARunning of
Tuple false true -> Tuple false _ ->
Sigma.setSettings sigma settings Sigma.setSettings sigma settings
Tuple true false -> Tuple true false ->
Sigma.setSettings sigma settings Sigma.setSettings sigma settings
_ -> pure unit _ -> pure unit
markSelectedNodes :: Sigma.Sigma -> SelectedNodeIds -> NodesMap -> Effect Unit
markSelectedNodes sigma selectedNodeIds graphNodes = do
log2 "[markSelectedNodes] selectedNodeIds" selectedNodeIds
Sigma.forEachNode sigma \n -> do
case Map.lookup n.id graphNodes of
Nothing -> error $ "Node id " <> n.id <> " not found in graphNodes map"
Just {color} -> do
let newColor =
if Set.member n.id selectedNodeIds then
"#ff0000"
else
color
_ <- pure $ (n .= "color") newColor
pure unit
Sigma.refresh sigma
bindSelectedNodesClick :: R.Ref Sigma -> R.State SelectedNodeIds -> Effect Unit
bindSelectedNodesClick sigmaRef (_ /\ setSelectedNodeIds) =
dependOnSigma (R.readRef sigmaRef) "[graphCpt] no sigma" $ \sigma ->
Sigma.bindClickNode sigma $ \node -> do
log2 "[graphCpt] clickNode" node
setSelectedNodeIds \nids ->
if Set.member node.id nids then
Set.delete node.id nids
else
Set.insert node.id nids
...@@ -55,6 +55,9 @@ function killSigma(left, right, sigma) { ...@@ -55,6 +55,9 @@ function killSigma(left, right, sigma) {
} }
function clear(sigma) { sigma.graph.clear(); } function clear(sigma) { sigma.graph.clear(); }
function bind(sigma, event, handler) { sigma.bind(event, handler); } function bind(sigma, event, handler) { sigma.bind(event, handler); }
function unbind(sigma, event) { sigma.unbind(event); }
function forEachNode(sigma, handler) { sigma.graph.nodes().forEach(handler); }
function forEachEdge(sigma, handler) { sigma.graph.edges().forEach(handler); }
function setSettings(sigma, settings) { sigma.settings(settings); } function setSettings(sigma, settings) { sigma.settings(settings); }
function startForceAtlas2(sigma, settings) { sigma.startForceAtlas2(settings); } function startForceAtlas2(sigma, settings) { sigma.startForceAtlas2(settings); }
function stopForceAtlas2(sigma) { sigma.stopForceAtlas2(); } function stopForceAtlas2(sigma) { sigma.stopForceAtlas2(); }
...@@ -80,6 +83,9 @@ exports._setRendererContainer = setRendererContainer; ...@@ -80,6 +83,9 @@ exports._setRendererContainer = setRendererContainer;
exports._killSigma = killSigma exports._killSigma = killSigma
exports._clear = clear; exports._clear = clear;
exports._bind = bind; exports._bind = bind;
exports._unbind = unbind;
exports._forEachNode = forEachNode;
exports._forEachEdge = forEachEdge;
exports._setSettings = setSettings; exports._setSettings = setSettings;
exports._startForceAtlas2 = startForceAtlas2; exports._startForceAtlas2 = startForceAtlas2;
exports._stopForceAtlas2 = stopForceAtlas2; exports._stopForceAtlas2 = stopForceAtlas2;
......
...@@ -5,12 +5,15 @@ import Data.Either (Either(..)) ...@@ -5,12 +5,15 @@ import Data.Either (Either(..))
import Data.Nullable (notNull, null, Nullable) import Data.Nullable (notNull, null, Nullable)
import DOM.Simple.Console (log, log2) import DOM.Simple.Console (log, log2)
import DOM.Simple.Types (Element) import DOM.Simple.Types (Element)
import FFI.Simple (delay, (..))
import Effect (Effect, foreachE) import Effect (Effect, foreachE)
import Effect.Timer (setTimeout) import Effect.Timer (setTimeout)
import Effect.Uncurried (EffectFn1, mkEffectFn1, runEffectFn1, EffectFn2, runEffectFn2, EffectFn3, runEffectFn3, EffectFn4, runEffectFn4) import Effect.Uncurried (EffectFn1, mkEffectFn1, runEffectFn1, EffectFn2, runEffectFn2, EffectFn3, runEffectFn3, EffectFn4, runEffectFn4)
import Type.Row (class Union) import Type.Row (class Union)
import Reactix as R import Reactix as R
import Gargantext.Hooks.Sigmax.Types as Types
foreign import data Sigma :: Type foreign import data Sigma :: Type
type NodeRequiredProps = ( id :: String ) type NodeRequiredProps = ( id :: String )
...@@ -116,6 +119,29 @@ bind_ s e h = runEffectFn3 _bind s e (mkEffectFn1 h) ...@@ -116,6 +119,29 @@ bind_ s e h = runEffectFn3 _bind s e (mkEffectFn1 h)
foreign import _bind :: forall e. EffectFn3 Sigma String (EffectFn1 e Unit) Unit foreign import _bind :: forall e. EffectFn3 Sigma String (EffectFn1 e Unit) Unit
unbind_ :: forall e. Sigma -> String -> Effect Unit
unbind_ s e = runEffectFn2 _unbind s e
foreign import _unbind :: forall e. EffectFn2 Sigma String Unit
forEachNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
forEachNode s f = runEffectFn2 _forEachNode s (mkEffectFn1 f)
foreign import _forEachNode :: EffectFn2 Sigma (EffectFn1 (Record Types.Node) Unit) Unit
forEachEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
forEachEdge s f = runEffectFn2 _forEachEdge s (mkEffectFn1 f)
foreign import _forEachEdge :: EffectFn2 Sigma (EffectFn1 (Record Types.Edge) Unit) Unit
bindClickNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
bindClickNode sigma f = bind_ sigma "clickNode" $ \e -> do
let node = e .. "data" .. "node" :: Record Types.Node
f node
unbindClickNode :: Sigma -> Effect Unit
unbindClickNode sigma = unbind_ sigma "clickNode"
setSettings :: forall settings. Sigma -> settings -> Effect Unit setSettings :: forall settings. Sigma -> settings -> Effect Unit
setSettings sigma settings = do setSettings sigma settings = do
runEffectFn2 _setSettings sigma settings runEffectFn2 _setSettings sigma settings
......
module Gargantext.Hooks.Sigmax.Types where module Gargantext.Hooks.Sigmax.Types where
import Prelude (map, ($))
import Data.Map as Map
import Data.Sequence (Seq) import Data.Sequence (Seq)
import Data.Set as Set
import Data.Tuple (Tuple(..))
import DOM.Simple.Types (Element) import DOM.Simple.Types (Element)
newtype Graph n e = Graph { nodes :: Seq {|n}, edges :: Seq {|e} } newtype Graph n e = Graph { nodes :: Seq {|n}, edges :: Seq {|e} }
...@@ -13,3 +17,21 @@ newtype Graph n e = Graph { nodes :: Seq {|n}, edges :: Seq {|e} } ...@@ -13,3 +17,21 @@ newtype Graph n e = Graph { nodes :: Seq {|n}, edges :: Seq {|e} }
type Renderer = { "type" :: String, container :: Element } type Renderer = { "type" :: String, container :: Element }
type Node =
( id :: String
, label :: String
, x :: Number
, y :: Number
, size :: Number
, color :: String )
type Edge = ( id :: String, source :: String, target :: String )
type SelectedNodeIds = Set.Set String
type NodesMap = Map.Map String (Record Node)
nodesMap :: Graph Node Edge -> NodesMap
nodesMap graph = do
let (Graph {nodes}) = graph
Map.fromFoldable $ map (\n -> Tuple n.id n) nodes
...@@ -13,6 +13,7 @@ ...@@ -13,6 +13,7 @@
<link rel="stylesheet" type="text/css" href="styles/menu.css"/> <link rel="stylesheet" type="text/css" href="styles/menu.css"/>
<link href="styles/Graph.css" rel="stylesheet" type="text/css" /> <link href="styles/Graph.css" rel="stylesheet" type="text/css" />
<link href="styles/Login.css" rel="stylesheet" type="text/css" /> <link href="styles/Login.css" rel="stylesheet" type="text/css" />
<link href="styles/range-slider.css" rel="stylesheet" type="text/css" />
<style> <style>
* {margin: 0; padding: 0; list-style: none;} * {margin: 0; padding: 0; list-style: none;}
.tree ul li { .tree ul li {
......
...@@ -5177,10 +5177,10 @@ purescript-installer@^0.2.0: ...@@ -5177,10 +5177,10 @@ purescript-installer@^0.2.0:
which "^1.3.1" which "^1.3.1"
zen-observable "^0.8.14" zen-observable "^0.8.14"
purescript@^0.13.4: purescript@^0.13.5:
version "0.13.4" version "0.13.5"
resolved "https://registry.yarnpkg.com/purescript/-/purescript-0.13.4.tgz#8f61e54d8fb3be80e3666f443a463bec1a7a28b7" resolved "https://registry.yarnpkg.com/purescript/-/purescript-0.13.5.tgz#0b1621577c64390ee34908d772679b1e23b8edd1"
integrity sha512-wVvmdHpBJaxkqigkCNEmxvKElech8V+NWQtj0hQdL0Vhcd3SUFKbdIul9sN4ABOsfYIobKk/foI1VZbUuTJZEw== integrity sha512-nwCqlhPZKfm1HkZzEy91dC9vIoRcah226OkIfW0kiz7tPl+LddwAIVT2bdhfQwzu2XUhgOKmYbvn9nlbHlOGMQ==
dependencies: dependencies:
purescript-installer "^0.2.0" purescript-installer "^0.2.0"
......
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