Commit 2148af2b authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[sigma] comment apparently unused code (refresh), some refactoring

parent 20e560a7
...@@ -121,7 +121,7 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where ...@@ -121,7 +121,7 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where
pure unit pure unit
--newGraph <- Graphology.graphFromSigmaxGraph graph' --newGraph <- Graphology.graphFromSigmaxGraph graph'
--gmax.refreshData sig newGraph --Sigmax.refreshData sig newGraph
Sigmax.dependOnSigma (R.readRef sigmaRef) "[graphCpt (Ready)] no sigma" $ \sigma -> do Sigmax.dependOnSigma (R.readRef sigmaRef) "[graphCpt (Ready)] no sigma" $ \sigma -> do
-- bind the click event only initially, when ref was empty -- bind the click event only initially, when ref was empty
...@@ -183,8 +183,8 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where ...@@ -183,8 +183,8 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where
Sigmax.dependOnSigma (R.readRef sigmaRef) "[graphCpt (Ready)] no sigma" $ \sigma -> do Sigmax.dependOnSigma (R.readRef sigmaRef) "[graphCpt (Ready)] no sigma" $ \sigma -> do
Sigmax.performDiff sigma transformedGraph Sigmax.performDiff sigma transformedGraph
Sigmax.updateEdges sigma tEdgesMap -- Sigmax.updateEdges sigma tEdgesMap
Sigmax.updateNodes sigma tNodesMap -- Sigmax.updateNodes sigma tNodesMap
let edgesState = not $ SigmaxTypes.edgeStateHidden showEdges' let edgesState = not $ SigmaxTypes.edgeStateHidden showEdges'
-- here.log2 "[graphCpt] edgesState" edgesState -- here.log2 "[graphCpt] edgesState" edgesState
Sigmax.setEdges sigma edgesState Sigmax.setEdges sigma edgesState
......
...@@ -80,24 +80,24 @@ cleanupSigma sigma context = traverse_ kill (readSigma sigma) ...@@ -80,24 +80,24 @@ cleanupSigma sigma context = traverse_ kill (readSigma sigma)
errorMsg = prefix <> "Error killing sigma:" errorMsg = prefix <> "Error killing sigma:"
successMsg = prefix <> "Killed sigma" successMsg = prefix <> "Killed sigma"
refreshData :: Sigma.Sigma -> Graphology.Graph -> Effect Unit -- refreshData :: Sigma.Sigma -> Graphology.Graph -> Effect Unit
refreshData sigma graph = do -- refreshData sigma graph = do
console.log clearingMsg -- console.log clearingMsg
Graphology.clear sigmaGraph -- Graphology.clear sigmaGraph
console.log readingMsg -- console.log readingMsg
_ <- Graphology.updateWithGraph sigmaGraph graph -- _ <- Graphology.updateWithGraph sigmaGraph graph
-- refresh -- -- refresh
console.log refreshingMsg -- console.log refreshingMsg
Sigma.refresh sigma -- Sigma.refresh sigma
--pure $ either (console.log2 errorMsg) refresh -- --pure $ either (console.log2 errorMsg) refresh
where -- where
sigmaGraph = Sigma.graph sigma -- sigmaGraph = Sigma.graph sigma
refresh _ = console.log refreshingMsg *> Sigma.refresh sigma -- refresh _ = console.log refreshingMsg *> Sigma.refresh sigma
clearingMsg = "[refreshData] Clearing existing graph data" -- clearingMsg = "[refreshData] Clearing existing graph data"
readingMsg = "[refreshData] Reading graph data" -- readingMsg = "[refreshData] Reading graph data"
refreshingMsg = "[refreshData] Refreshing graph" -- refreshingMsg = "[refreshData] Refreshing graph"
errorMsg = "[refreshData] Error reading graph data:" -- errorMsg = "[refreshData] Error reading graph data:"
dependOnSigma :: Sigma -> String -> (Sigma.Sigma -> Effect Unit) -> Effect Unit dependOnSigma :: Sigma -> String -> (Sigma.Sigma -> Effect Unit) -> Effect Unit
dependOnSigma sigma notFoundMsg f = do dependOnSigma sigma notFoundMsg f = do
...@@ -151,37 +151,37 @@ setEdges sigma val = do ...@@ -151,37 +151,37 @@ setEdges sigma val = do
Sigma.setSettings sigma settings Sigma.setSettings sigma settings
updateEdges :: Sigma.Sigma -> ST.EdgesMap -> Effect Unit -- updateEdges :: Sigma.Sigma -> ST.EdgesMap -> Effect Unit
updateEdges sigma edgesMap = do -- updateEdges sigma edgesMap = do
Graphology.forEachEdge (Sigma.graph sigma) \e -> do -- Graphology.forEachEdge (Sigma.graph sigma) \e -> do
let mTEdge = Map.lookup e.id edgesMap -- let mTEdge = Map.lookup e.id edgesMap
case mTEdge of -- case mTEdge of
Nothing -> error $ "Edge id " <> e.id <> " not found in edgesMap" -- Nothing -> error $ "Edge id " <> e.id <> " not found in edgesMap"
(Just {color: tColor, hidden: tHidden}) -> do -- (Just {color: tColor, hidden: tHidden}) -> do
_ <- pure $ (e .= "color") tColor -- _ <- pure $ (e .= "color") tColor
_ <- pure $ (e .= "hidden") tHidden -- _ <- pure $ (e .= "hidden") tHidden
pure unit -- pure unit
--Sigma.refresh sigma -- --Sigma.refresh sigma
updateNodes :: Sigma.Sigma -> ST.NodesMap -> Effect Unit -- updateNodes :: Sigma.Sigma -> ST.NodesMap -> Effect Unit
updateNodes sigma nodesMap = do -- updateNodes sigma nodesMap = do
Graphology.forEachNode (Sigma.graph sigma) \n -> do -- Graphology.forEachNode (Sigma.graph sigma) \n -> do
let mTNode = Map.lookup n.id nodesMap -- let mTNode = Map.lookup n.id nodesMap
case mTNode of -- case mTNode of
Nothing -> error $ "Node id " <> n.id <> " not found in nodesMap" -- Nothing -> error $ "Node id " <> n.id <> " not found in nodesMap"
(Just { borderColor: tBorderColor -- (Just { borderColor: tBorderColor
, color: tColor -- , color: tColor
, equilateral: tEquilateral -- , equilateral: tEquilateral
, hidden: tHidden -- , hidden: tHidden
, type: tType }) -> do -- , type: tType }) -> do
_ <- pure $ (n .= "borderColor") tBorderColor -- _ <- pure $ (n .= "borderColor") tBorderColor
_ <- pure $ (n .= "color") tColor -- _ <- pure $ (n .= "color") tColor
_ <- pure $ (n .= "equilateral") tEquilateral -- _ <- pure $ (n .= "equilateral") tEquilateral
_ <- pure $ (n .= "hidden") tHidden -- _ <- pure $ (n .= "hidden") tHidden
_ <- pure $ (n .= "type") tType -- _ <- pure $ (n .= "type") tType
pure unit -- pure unit
--Sigma.refresh sigma -- --Sigma.refresh sigma
-- | Toggles item visibility in the selected set -- | Toggles item visibility in the selected set
...@@ -230,7 +230,12 @@ performDiff sigma g = do ...@@ -230,7 +230,12 @@ performDiff sigma g = do
traverse_ (Graphology.removeEdge sigmaGraph) removeEdges traverse_ (Graphology.removeEdge sigmaGraph) removeEdges
traverse_ (Graphology.removeNode sigmaGraph) removeNodes traverse_ (Graphology.removeNode sigmaGraph) removeNodes
traverse_ (Graphology.updateEdge sigmaGraph) updateEdges traverse_ (Graphology.updateEdge sigmaGraph) updateEdges
traverse_ (Graphology.updateNode sigmaGraph) updateNodes --traverse_ (Graphology.updateNode sigmaGraph) updateNodes
traverse_ (\n -> Graphology.mergeNodeAttributes sigmaGraph n.id { borderColor: n.borderColor
, color: n.color
, equilateral: n.equilateral
, hidden: n.hidden
, highlighted: n.highlighted }) updateNodes
--Sigma.refresh sigma --Sigma.refresh sigma
-- TODO Use FA2Layout here -- TODO Use FA2Layout here
--Sigma.killForceAtlas2 sigma --Sigma.killForceAtlas2 sigma
......
...@@ -14,6 +14,10 @@ export function _updateNode(g, name, updater) { ...@@ -14,6 +14,10 @@ export function _updateNode(g, name, updater) {
return g.updateNode(name, updater); return g.updateNode(name, updater);
} }
export function _mergeNodeAttributes(g, name, attrs) {
return g.mergeNodeAttributes(name, attrs);
}
export function _addEdge(g, source, target, e) { export function _addEdge(g, source, target, e) {
return g.addEdge(source, target, e); return g.addEdge(source, target, e);
} }
......
...@@ -25,6 +25,7 @@ foreign import _newGraph :: EffectFn1 Unit Graph ...@@ -25,6 +25,7 @@ foreign import _newGraph :: EffectFn1 Unit Graph
foreign import _addNode :: EffectFn3 Graph String (Record Types.Node) String foreign import _addNode :: EffectFn3 Graph String (Record Types.Node) String
foreign import _updateNode :: EffectFn3 Graph String (Record Types.Node -> Record Types.Node) Unit foreign import _updateNode :: EffectFn3 Graph String (Record Types.Node -> Record Types.Node) Unit
foreign import _addEdge :: EffectFn4 Graph String String (Record Types.Edge) String foreign import _addEdge :: EffectFn4 Graph String String (Record Types.Edge) String
foreign import _mergeNodeAttributes :: forall a. EffectFn3 Graph String a Unit
--foreign import _updateEdge :: EffectFn4 Graph String String (Record Types.Edge) String --foreign import _updateEdge :: EffectFn4 Graph String String (Record Types.Edge) String
foreign import _mapNodes :: forall a. Fn2 Graph (Record Types.Node -> a) (Array a) foreign import _mapNodes :: forall a. Fn2 Graph (Record Types.Node -> a) (Array a)
foreign import _forEachEdge :: EffectFn2 Graph (Record Types.Edge -> Effect Unit) Unit foreign import _forEachEdge :: EffectFn2 Graph (Record Types.Edge -> Effect Unit) Unit
...@@ -49,9 +50,14 @@ removeNode :: Graph -> String -> Effect Unit ...@@ -49,9 +50,14 @@ removeNode :: Graph -> String -> Effect Unit
removeNode g nId = pure $ g ... "dropNode" $ [nId] removeNode g nId = pure $ g ... "dropNode" $ [nId]
updateNode :: Graph -> Record Types.Node -> Effect Unit updateNode :: Graph -> Record Types.Node -> Effect Unit
-- | See Types.compareNodes -- | See Types.compareNodes
updateNode g node@{ id, hidden, highlighted } = updateNode g node@{ id, borderColor, color, equilateral, hidden, highlighted, type: t } =
runEffectFn3 _updateNode g id (\n -> n { hidden = hidden runEffectFn3 _updateNode g id (\n -> n { borderColor = borderColor
, color = color
, equilateral = equilateral
, hidden = hidden
, highlighted = highlighted }) , highlighted = highlighted })
mergeNodeAttributes :: forall a. Graph -> Types.NodeId -> a -> Effect Unit
mergeNodeAttributes = runEffectFn3 _mergeNodeAttributes
forEachNode :: Graph -> (Record Types.Node -> Effect Unit) -> Effect Unit forEachNode :: Graph -> (Record Types.Node -> Effect Unit) -> Effect Unit
-- TODO Check this: how does FFI translate function of two arguments -- TODO Check this: how does FFI translate function of two arguments
-- into PS \x y ? -- into PS \x y ?
......
...@@ -46,9 +46,8 @@ kill :: Sigma -> Effect Unit ...@@ -46,9 +46,8 @@ kill :: Sigma -> Effect Unit
kill s = pure $ s ... "kill" $ [] kill s = pure $ s ... "kill" $ []
-- | Call the `refresh()` method on a sigmajs instance. -- | Call the `refresh()` method on a sigmajs instance.
refresh :: Sigma -> Effect Unit -- refresh :: Sigma -> Effect Unit
refresh = runEffectFn1 _refresh -- refresh = runEffectFn1 _refresh
--refresh s = pure $ s ... "refresh" $ []
-- | Type representing a sigmajs renderer. -- | Type representing a sigmajs renderer.
foreign import data Renderer :: Type foreign import data Renderer :: Type
......
...@@ -72,10 +72,16 @@ type NodesMap = Map.Map String (Record Node) ...@@ -72,10 +72,16 @@ type NodesMap = Map.Map String (Record Node)
-- | When comparing nodes, we don't want to compare all fields. Only -- | When comparing nodes, we don't want to compare all fields. Only
-- | some are relevant (when updating sigma graph). -- | some are relevant (when updating sigma graph).
-- NOTE For some reason, `Graphology.updateNode` throws error if `type` is set
compareNodes :: Record Node -> Record Node -> Boolean compareNodes :: Record Node -> Record Node -> Boolean
compareNodes n1 n2 = n1.hidden == n2.hidden && compareNodes n1 n2 = n1.borderColor == n2.borderColor &&
n1.color == n2.color &&
n1.equilateral == n2.equilateral &&
n1.hidden == n2.hidden &&
n1.highlighted == n2.highlighted n1.highlighted == n2.highlighted
-- TODO For edges, see `Sigmax.updateEdges` (`color` and `hidden`)
emptyEdgeIds :: EdgeIds emptyEdgeIds :: EdgeIds
emptyEdgeIds = Set.empty emptyEdgeIds = Set.empty
emptyNodeIds :: NodeIds emptyNodeIds :: NodeIds
......
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