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

[FIX] #205 GraphExplorer, still needs to lower the loader when recomputing (TODO)

parent 162bd7ff
...@@ -40,20 +40,20 @@ import Gargantext.Utils.Reactix as R2 ...@@ -40,20 +40,20 @@ import Gargantext.Utils.Reactix as R2
thisModule = "Gargantext.Components.GraphExplorer" thisModule = "Gargantext.Components.GraphExplorer"
type LayoutProps = type LayoutProps =
( frontends :: Frontends ( frontends :: Frontends
, graphId :: GET.GraphId , graphId :: GET.GraphId
, handed :: Types.Handed , handed :: Types.Handed
, mCurrentRoute :: AppRoute , mCurrentRoute :: AppRoute
, session :: Session , session :: Session
, sessions :: Sessions , sessions :: Sessions
, showLogin :: R.State Boolean , showLogin :: R.State Boolean
) )
type Props = ( type Props =
graph :: SigmaxT.SGraph ( graph :: SigmaxT.SGraph
, graphVersion :: R.State Int , graphVersion :: R.State Int
, hyperdataGraph :: GET.HyperdataGraph , hyperdataGraph :: GET.HyperdataGraph
, mMetaData :: Maybe GET.MetaData , mMetaData :: Maybe GET.MetaData
| LayoutProps | LayoutProps
) )
...@@ -66,7 +66,6 @@ explorerLayoutCpt = R2.hooksComponent thisModule "explorerLayout" cpt ...@@ -66,7 +66,6 @@ explorerLayoutCpt = R2.hooksComponent thisModule "explorerLayout" cpt
where where
cpt props _ = do cpt props _ = do
graphVersion <- R.useState' 0 graphVersion <- R.useState' 0
pure $ explorerLayoutView graphVersion props pure $ explorerLayoutView graphVersion props
explorerLayoutView :: R.State Int -> Record LayoutProps -> R.Element explorerLayoutView :: R.State Int -> Record LayoutProps -> R.Element
...@@ -103,19 +102,22 @@ explorerCpt = R2.hooksComponent thisModule "explorer" cpt ...@@ -103,19 +102,22 @@ explorerCpt = R2.hooksComponent thisModule "explorer" cpt
} _ = do } _ = do
let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas }) -> startForceAtlas) mMetaData let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas }) -> startForceAtlas) mMetaData
let forceAtlasS = if startForceAtlas then SigmaxT.InitialRunning else SigmaxT.InitialStopped
let forceAtlasS = if startForceAtlas
then SigmaxT.InitialRunning
else SigmaxT.InitialStopped
dataRef <- R.useRef graph dataRef <- R.useRef graph
graphRef <- R.useRef null graphRef <- R.useRef null
graphVersionRef <- R.useRef (fst graphVersion) graphVersionRef <- R.useRef (fst graphVersion)
treeReload <- R.useState' 0 treeReload <- R.useState' 0
controls <- Controls.useGraphControls { forceAtlasS controls <- Controls.useGraphControls { forceAtlasS
, graph , graph
, graphId , graphId
, hyperdataGraph , hyperdataGraph
, session , session
, treeReload: \_ -> (snd treeReload) $ (+) 1 , treeReload: \_ -> (snd treeReload) $ (+) 1
} }
multiSelectEnabledRef <- R.useRef $ fst controls.multiSelectEnabled multiSelectEnabledRef <- R.useRef $ fst controls.multiSelectEnabled
R.useEffect' $ do R.useEffect' $ do
...@@ -184,13 +186,13 @@ explorerCpt = R2.hooksComponent thisModule "explorer" cpt ...@@ -184,13 +186,13 @@ explorerCpt = R2.hooksComponent thisModule "explorer" cpt
] ]
mainLayout Types.RightHanded (tree' /\ gc /\ gv /\ sdb) = [tree', gc, gv, sdb] mainLayout Types.RightHanded (tree' /\ gc /\ gv /\ sdb) = [tree', gc, gv, sdb]
mainLayout Types.LeftHanded (tree' /\ gc /\ gv /\ sdb) = [sdb, gc, gv, tree'] mainLayout Types.LeftHanded (tree' /\ gc /\ gv /\ sdb) = [sdb, gc, gv, tree']
outer = RH.div { className: "col-md-12" } outer = RH.div { className: "col-md-12" }
inner h = RH.div { className: "container-fluid " <> hClass } inner h = RH.div { className: "container-fluid " <> hClass }
where where
hClass = case h of hClass = case h of
Types.LeftHanded -> "lefthanded" Types.LeftHanded -> "lefthanded"
Types.RightHanded -> "righthanded" Types.RightHanded -> "righthanded"
rowToggle = RH.div { id: "toggle-container" } rowToggle = RH.div { id: "toggle-container" }
rowControls = RH.div { id: "controls-container" } rowControls = RH.div { id: "controls-container" }
...@@ -275,20 +277,19 @@ graphViewCpt = R2.hooksComponent thisModule "graphView" cpt ...@@ -275,20 +277,19 @@ graphViewCpt = R2.hooksComponent thisModule "graphView" cpt
R.useEffect1' (fst controls.multiSelectEnabled) $ do R.useEffect1' (fst controls.multiSelectEnabled) $ do
R.setRef multiSelectEnabledRef $ fst controls.multiSelectEnabled R.setRef multiSelectEnabledRef $ fst controls.multiSelectEnabled
pure $ Graph.graph { pure $ Graph.graph { elRef
elRef , forceAtlas2Settings: Graph.forceAtlas2Settings
, forceAtlas2Settings: Graph.forceAtlas2Settings , graph
, graph , mCamera
, mCamera , multiSelectEnabledRef
, multiSelectEnabledRef , selectedNodeIds: controls.selectedNodeIds
, selectedNodeIds: controls.selectedNodeIds , showEdges: controls.showEdges
, showEdges: controls.showEdges , sigmaRef: controls.sigmaRef
, sigmaRef: controls.sigmaRef , sigmaSettings: Graph.sigmaSettings
, sigmaSettings: Graph.sigmaSettings , stage: controls.graphStage
, stage: controls.graphStage , startForceAtlas
, startForceAtlas , transformedGraph
, transformedGraph }
}
convert :: GET.GraphData -> Tuple (Maybe GET.MetaData) SigmaxT.SGraph convert :: GET.GraphData -> Tuple (Maybe GET.MetaData) SigmaxT.SGraph
convert (GET.GraphData r) = Tuple r.metaData $ SigmaxT.Graph {nodes, edges} convert (GET.GraphData r) = Tuple r.metaData $ SigmaxT.Graph {nodes, edges}
...@@ -344,7 +345,10 @@ modeGraphType Types.Terms = "def" ...@@ -344,7 +345,10 @@ modeGraphType Types.Terms = "def"
getNodes :: Session -> R.State Int -> GET.GraphId -> Aff GET.HyperdataGraph getNodes :: Session -> R.State Int -> GET.GraphId -> Aff GET.HyperdataGraph
getNodes session (graphVersion /\ _) graphId = get session $ NodeAPI Types.Graph (Just graphId) ("?version=" <> show graphVersion) getNodes session (graphVersion /\ _) graphId =
get session $ NodeAPI Types.Graph
(Just graphId)
("?version=" <> show graphVersion)
transformGraph :: Record Controls.Controls -> SigmaxT.SGraph -> SigmaxT.SGraph transformGraph :: Record Controls.Controls -> SigmaxT.SGraph -> SigmaxT.SGraph
...@@ -361,8 +365,8 @@ transformGraph controls graph = SigmaxT.Graph {nodes: newNodes, edges: newEdges} ...@@ -361,8 +365,8 @@ transformGraph controls graph = SigmaxT.Graph {nodes: newNodes, edges: newEdges}
--newNodes = Seq.map (nodeSizeFilter <<< nodeMarked) nodes --newNodes = Seq.map (nodeSizeFilter <<< nodeMarked) nodes
--newEdges = Seq.map (edgeConfluenceFilter <<< edgeWeightFilter <<< edgeShowFilter <<< edgeMarked) edges --newEdges = Seq.map (edgeConfluenceFilter <<< edgeWeightFilter <<< edgeShowFilter <<< edgeMarked) edges
newEdges' = Seq.filter edgeFilter $ Seq.map (edgeShowFilter <<< edgeMarked) edges newEdges' = Seq.filter edgeFilter $ Seq.map (edgeShowFilter <<< edgeMarked) edges
newNodes = Seq.filter nodeFilter $ Seq.map (nodeMarked) nodes newNodes = Seq.filter nodeFilter $ Seq.map (nodeMarked) nodes
newEdges = Seq.filter (edgeInGraph $ Set.fromFoldable $ Seq.map _.id newNodes) newEdges' newEdges = Seq.filter (edgeInGraph $ Set.fromFoldable $ Seq.map _.id newNodes) newEdges'
edgeFilter e = edgeConfluenceFilter e && edgeFilter e = edgeConfluenceFilter e &&
edgeWeightFilter e edgeWeightFilter e
......
...@@ -109,7 +109,7 @@ controlsCpt = R2.hooksComponent thisModule "controls" cpt ...@@ -109,7 +109,7 @@ controlsCpt = R2.hooksComponent thisModule "controls" cpt
-- CPU, has memory leaks etc. -- CPU, has memory leaks etc.
R.useEffect1' (fst props.forceAtlasState) $ do R.useEffect1' (fst props.forceAtlasState) $ do
if (fst props.forceAtlasState) == SigmaxT.InitialRunning then do if (fst props.forceAtlasState) == SigmaxT.InitialRunning then do
timeoutId <- setTimeout 2000 $ do timeoutId <- setTimeout 9000 $ do
let (toggled /\ setToggled) = props.forceAtlasState let (toggled /\ setToggled) = props.forceAtlasState
case toggled of case toggled of
SigmaxT.InitialRunning -> setToggled $ const SigmaxT.Paused SigmaxT.InitialRunning -> setToggled $ const SigmaxT.Paused
......
...@@ -157,7 +157,7 @@ instance decodeJsonNode :: DecodeJson Node where ...@@ -157,7 +157,7 @@ instance decodeJsonNode :: DecodeJson Node where
id_ <- obj .: "id" id_ <- obj .: "id"
type_ <- obj .: "type" type_ <- obj .: "type"
label <- obj .: "label" label <- obj .: "label"
size <- obj .: "size" size <- obj .: "size"
attributes <- obj .: "attributes" attributes <- obj .: "attributes"
x <- obj .: "x_coord" x <- obj .: "x_coord"
y <- obj .: "y_coord" y <- obj .: "y_coord"
...@@ -177,14 +177,14 @@ instance encodeJsonNode :: EncodeJson Node where ...@@ -177,14 +177,14 @@ instance encodeJsonNode :: EncodeJson Node where
instance decodeJsonMetaData :: DecodeJson MetaData where instance decodeJsonMetaData :: DecodeJson MetaData where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
legend <- obj .: "legend" legend <- obj .: "legend"
corpusId <- obj .: "corpusId" corpusId <- obj .: "corpusId"
list <- obj .: "list" list <- obj .: "list"
listId <- list .: "listId" listId <- list .: "listId"
metric <- obj .: "metric" metric <- obj .: "metric"
startForceAtlas <- obj .: "startForceAtlas" startForceAtlas <- obj .: "startForceAtlas"
title <- obj .: "title" title <- obj .: "title"
version <- list .: "version" version <- list .: "version"
pure $ MetaData { pure $ MetaData {
corpusId corpusId
...@@ -208,7 +208,7 @@ instance encodeJsonMetaData :: EncodeJson MetaData where ...@@ -208,7 +208,7 @@ instance encodeJsonMetaData :: EncodeJson MetaData where
instance decodeJsonLegend :: DecodeJson Legend where instance decodeJsonLegend :: DecodeJson Legend where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
id_ <- obj .: "id" id_ <- obj .: "id"
color <- obj .: "color" color <- obj .: "color"
label <- obj .: "label" label <- obj .: "label"
pure $ Legend { id_, color, label } pure $ Legend { id_, color, label }
...@@ -286,11 +286,11 @@ instance showSideTab :: Show SideTab where ...@@ -286,11 +286,11 @@ instance showSideTab :: Show SideTab where
show SideTabCommunity = "Community" show SideTabCommunity = "Community"
newtype Camera = Camera { newtype Camera =
ratio :: Number Camera { ratio :: Number
, x :: Number , x :: Number
, y :: Number , y :: Number
} }
instance decodeCamera :: DecodeJson Camera where instance decodeCamera :: DecodeJson Camera where
decodeJson json = do decodeJson json = do
...@@ -315,7 +315,7 @@ newtype HyperdataGraph = HyperdataGraph { ...@@ -315,7 +315,7 @@ newtype HyperdataGraph = HyperdataGraph {
instance decodeHyperdataGraph :: DecodeJson HyperdataGraph where instance decodeHyperdataGraph :: DecodeJson HyperdataGraph where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
graph <- obj .: "graph" graph <- obj .: "graph"
mCamera <- obj .:? "camera" mCamera <- obj .:? "camera"
pure $ HyperdataGraph { graph, mCamera } pure $ HyperdataGraph { graph, mCamera }
......
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