Commit ee6295cc authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[Graph] Sigmax code cleanup

Remove utility functions. They were reading refs constantly, pattern
matching on Maybe/Either. We can do everything in one go.
parent 83c9beeb
...@@ -5,6 +5,7 @@ module Gargantext.Components.Graph ...@@ -5,6 +5,7 @@ module Gargantext.Components.Graph
-- ) -- )
where where
import Prelude (bind, discard, pure, ($), unit, map) import Prelude (bind, discard, pure, ($), unit, map)
import Data.Either (Either(..))
import Data.Map as 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)
...@@ -52,14 +53,32 @@ graphCpt = R.hooksComponent "Graph" cpt ...@@ -52,14 +53,32 @@ graphCpt = R.hooksComponent "Graph" cpt
Sigmax.markSelectedNodes sigma (fst selectedNodeIds) nodesMap Sigmax.markSelectedNodes sigma (fst selectedNodeIds) nodesMap
R.useEffectOnce $ do R.useEffectOnce $ do
let mSigma = Sigmax.readSigma $ R.readRef props.sigmaRef let rSigma = R.readRef props.sigmaRef
Sigmax.startSigmaEff props.elRef props.sigmaRef props.sigmaSettings props.forceAtlas2Settings props.graph case Sigmax.readSigma rSigma of
Nothing -> do
eSigma <- Sigma.sigma {settings: props.sigmaSettings}
case eSigma of
Left err -> log2 "[graphCpt] error creating sigma" err
Right sig -> do
Sigmax.writeSigma rSigma $ Just sig
Sigmax.dependOnContainer props.elRef "[graphCpt] container not found" $ \c -> do
_ <- Sigma.addRenderer sig {
"type": "canvas"
, container: c
}
pure unit
Sigmax.refreshData sig $ Sigmax.sigmafy props.graph
Sigmax.setEdges sig false
Sigma.startForceAtlas2 sig props.forceAtlas2Settings
-- bind the click event only initially, when ref was empty -- bind the click event only initially, when ref was empty
case mSigma of Sigmax.bindSelectedNodesClick props.sigmaRef selectedNodeIds
Nothing -> Sigmax.bindSelectedNodesClick props.sigmaRef selectedNodeIds Just sig -> do
Just _ -> pure unit pure unit
delay unit $ \_ -> do delay unit $ \_ -> do
log "[GraphCpt] cleanup" log "[GraphCpt] cleanup"
......
...@@ -59,81 +59,6 @@ cleanupFirst :: Sigma -> Effect Unit -> Effect Unit ...@@ -59,81 +59,6 @@ cleanupFirst :: Sigma -> Effect Unit -> Effect Unit
cleanupFirst sigma = cleanupFirst sigma =
R.setRef sigma.cleanup <<< (flip Seq.cons) (R.readRef sigma.cleanup) R.setRef sigma.cleanup <<< (flip Seq.cons) (R.readRef sigma.cleanup)
startSigma :: forall settings faSettings n e. R.Ref (Nullable Element) -> R.Ref (Maybe Sigma) -> settings -> faSettings -> Graph n e -> R.Hooks Unit
startSigma ref sigmaRef settings forceAtlas2Settings graph = do
{sigma, isNew} <- useSigma settings sigmaRef
useCanvasRenderer ref sigma
if isNew then do
useData sigma graph
useForceAtlas2 sigma forceAtlas2Settings
else
pure unit
-- | Manages a sigma with the given settings
useSigma :: forall settings. settings -> R.Ref (Maybe Sigma) -> R.Hooks {sigma :: Sigma, isNew :: Boolean}
useSigma settings sigmaRef = do
sigma <- newSigma sigmaRef
let isNew = case (readSigma sigma) of
Just _ -> false
_ -> true
R.useEffect1 isNew $ do
log2 "isNew" isNew
log2 "sigmaRef" $ R.readRef sigmaRef
log2 "sigma" sigma
delay unit $ handleSigma sigma (readSigma sigma)
pure $ {sigma, isNew}
where
newSigma sigmaRef' = do
let mSigma = R.readRef sigmaRef'
case mSigma of
Just sigma -> pure sigma
Nothing -> do
s <- R2.nothingRef
c <- R.useRef Seq.empty
pure {sigma: s, cleanup: c}
handleSigma sigma (Just _) _ = do
pure R.nothing
handleSigma sigma Nothing _ = do
ret <- createSigma settings
traverse_ (writeSigma sigma <<< Just) ret
R.setRef sigmaRef $ Just sigma
--pure $ cleanupSigma sigma "useSigma"
pure $ R.nothing
-- | Manages a renderer for the sigma
useCanvasRenderer :: R.Ref (Nullable Element) -> Sigma -> R.Hooks Unit
useCanvasRenderer container sigma =
R.useEffect2' container sigma.sigma $
delay unit $ \_ ->
dependOnContainer container containerNotFoundMsg withContainer
where
withContainer c = dependOnSigma sigma sigmaNotFoundMsg withSigma
where -- close over c
withSigma sig = addRenderer sig renderer >>= handle
where -- close over sig
renderer = { "type": "canvas", container: c }
handle (Right _) = cleanupFirst sigma (Sigma.killRenderer sig renderer >>= logCleanup)
handle (Left e) =
log2 errorAddingMsg e *> cleanupSigma sigma "useCanvasRenderer"
logCleanup (Left e) = log2 errorKillingMsg e
logCleanup _ = log killedMsg
containerNotFoundMsg = "[useCanvasRenderer] Container not found, not adding renderer"
sigmaNotFoundMsg = "[useCanvasRenderer] Sigma not found, not adding renderer"
errorAddingMsg = "[useCanvasRenderer] Error adding canvas renderer: "
errorKillingMsg = "[useCanvasRenderer] Error killing renderer:"
killedMsg = "[useCanvasRenderer] Killed renderer"
createSigma :: forall settings err. settings -> Effect (Either err Sigma.Sigma)
createSigma settings = do
log2 "[useSigma] Initializing sigma with settings" settings
ret <- Sigma.sigma {settings}
ret <$ logStatus ret
where
logStatus (Left err) = log2 "[useSigma] Error during sigma creation:" err
logStatus (Right x) = log2 "[useSigma] Initialised sigma successfully:" x
cleanupSigma :: Sigma -> String -> Effect Unit cleanupSigma :: Sigma -> String -> Effect Unit
cleanupSigma sigma context = traverse_ kill (readSigma sigma) cleanupSigma sigma context = traverse_ kill (readSigma sigma)
where where
...@@ -147,23 +72,6 @@ cleanupSigma sigma context = traverse_ kill (readSigma sigma) ...@@ -147,23 +72,6 @@ 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"
addRenderer :: forall r err. Sigma.Sigma -> r -> Effect (Either err Unit)
addRenderer sigma renderer = do
ret <- Sigma.addRenderer sigma renderer
(const unit <$> ret) <$ report ret
where
report = either (log2 errorMsg) (\_ -> log successMsg)
errorMsg = "[addRenderer] Error adding renderer:"
successMsg = "[addRenderer] Added renderer successfully"
useData :: forall n e. Sigma -> Graph n e -> R.Hooks Unit
useData sigma graph =
R.useEffect2' sigma.sigma graph $
delay unit $ \_ -> dependOnSigma sigma sigmaNotFoundMsg withSigma
where
withSigma sig = refreshData sig (sigmafy graph)
sigmaNotFoundMsg = "[useData] Sigma not found, not adding data"
refreshData :: forall n e. Sigma.Sigma -> Sigma.Graph n e -> Effect Unit refreshData :: forall n e. Sigma.Sigma -> Sigma.Graph n e -> Effect Unit
refreshData sigma graph refreshData sigma graph
= log clearingMsg = log clearingMsg
...@@ -173,10 +81,10 @@ refreshData sigma graph ...@@ -173,10 +81,10 @@ refreshData sigma graph
>>= either (log2 errorMsg) refresh >>= either (log2 errorMsg) refresh
where where
refresh _ = log refreshingMsg *> Sigma.refresh sigma refresh _ = log refreshingMsg *> Sigma.refresh sigma
clearingMsg = "[useData] Clearing existing graph data" clearingMsg = "[refreshData] Clearing existing graph data"
readingMsg = "[useData] Reading graph data" readingMsg = "[refreshData] Reading graph data"
refreshingMsg = "[useData] Refreshing graph" refreshingMsg = "[refreshData] Refreshing graph"
errorMsg = "[useData] Error reading graph data:" errorMsg = "[refreshData] Error reading graph data:"
sigmafy :: forall n e. Graph n e -> Sigma.Graph n e sigmafy :: forall n e. Graph n e -> Sigma.Graph n e
sigmafy (Graph g) = {nodes,edges} sigmafy (Graph g) = {nodes,edges}
...@@ -184,19 +92,6 @@ sigmafy (Graph g) = {nodes,edges} ...@@ -184,19 +92,6 @@ sigmafy (Graph g) = {nodes,edges}
nodes = A.fromFoldable g.nodes nodes = A.fromFoldable g.nodes
edges = A.fromFoldable g.edges edges = A.fromFoldable g.edges
useForceAtlas2 :: forall settings. Sigma -> settings -> R.Hooks Unit
useForceAtlas2 sigma settings =
R.useEffect1' sigma.sigma (delay unit effect)
where
effect _ = dependOnSigma sigma sigmaNotFoundMsg withSigma
withSigma sig = do
log startingMsg
log sigma
Sigma.startForceAtlas2 sig settings
cleanupFirst sigma (Sigma.killForceAtlas2 sig)
startingMsg = "[Graph] Starting ForceAtlas2"
sigmaNotFoundMsg = "[Graph] Sigma not found, not initialising"
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
case readSigma sigma of case readSigma sigma of
...@@ -212,76 +107,6 @@ dependOnContainer container notFoundMsg f = do ...@@ -212,76 +107,6 @@ dependOnContainer container notFoundMsg f = do
-- Effectful versions of the above code -- Effectful versions of the above code
startSigmaEff :: forall settings faSettings n e. R.Ref (Nullable Element) -> R.Ref Sigma -> settings -> faSettings -> Graph n e -> Effect Unit
startSigmaEff ref sigmaRef settings forceAtlas2Settings graph = do
let rSigma = R.readRef sigmaRef
case readSigma rSigma of
Nothing -> do
sigma <- useSigmaEff settings sigmaRef
useCanvasRendererEff ref sigma
useDataEff sigma graph
useForceAtlas2Eff sigma forceAtlas2Settings
Just sig -> do
pure unit
useSigmaEff :: forall settings. settings -> R.Ref Sigma -> Effect Sigma
useSigmaEff settings sigmaRef = do
let sigma = R.readRef sigmaRef
handleSigma sigma (readSigma sigma)
pure sigma
where
handleSigma :: Sigma -> (Maybe Sigma.Sigma) -> Effect Unit
handleSigma sigma (Just _) = do
pure unit
handleSigma sigma Nothing = do
ret <- createSigma settings
traverse_ (writeSigma sigma <<< Just) ret
R.setRef sigmaRef sigma
pure unit
useDataEff :: forall n e. Sigma -> Graph n e -> Effect Unit
useDataEff sigma graph = dependOnSigma sigma sigmaNotFoundMsg withSigma
where
withSigma sig = refreshData sig (sigmafy graph)
sigmaNotFoundMsg = "[useDataEff] Sigma not found, not adding data"
useCanvasRendererEff :: R.Ref (Nullable Element) -> Sigma -> Effect Unit
useCanvasRendererEff container sigma =
delay unit $ \_ ->
dependOnContainer container containerNotFoundMsg withContainer
where
withContainer c = dependOnSigma sigma sigmaNotFoundMsg withSigma
where -- close over c
withSigma sig = addRenderer sig renderer >>= handle
where -- close over sig
renderer = { "type": "canvas", container: c }
handle _ = log "[useCanvasRendererEff] cleanup handle"
--handle (Right _) = cleanupFirst sigma (Sigma.killRenderer sig renderer >>= logCleanup)
--handle (Left e) =
-- log2 errorAddingMsg e *> cleanupSigma sigma "useCanvasRenderer"
logCleanup (Left e) = log2 errorKillingMsg e
logCleanup _ = log killedMsg
containerNotFoundMsg = "[useCanvasRendererEff] Container not found, not adding renderer"
sigmaNotFoundMsg = "[useCanvasRendererEff] Sigma not found, not adding renderer"
errorAddingMsg = "[useCanvasRendererEff] Error adding canvas renderer: "
errorKillingMsg = "[useCanvasRendererEff] Error killing renderer:"
killedMsg = "[useCanvasRendererEff] Killed renderer"
useForceAtlas2Eff :: forall settings. Sigma -> settings -> Effect Unit
useForceAtlas2Eff sigma settings = effect
where
effect = dependOnSigma sigma sigmaNotFoundMsg withSigma
withSigma sig = do
--log2 startingMsg sigma
setEdges sig false
Sigma.startForceAtlas2 sig settings
--cleanupFirst sigma (Sigma.killForceAtlas2 sig)
startingMsg = "[useForceAtlas2Eff] Starting ForceAtlas2"
sigmaNotFoundMsg = "[useForceAtlas2Eff] Sigma not found, not initialising"
-- | Effect for handling pausing FA via state changes. We need this because -- | Effect for handling pausing FA via state changes. We need this because
-- | pausing can be done not only via buttons but also from the initial -- | pausing can be done not only via buttons but also from the initial
-- | setTimer. -- | setTimer.
......
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