Commit 99c71876 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[graph] rewrite to use Effect

This also simplifies numerous useEffect calls.
Still needs work -- graph doesn't render currently, but the code
compiles at least.
parent 7e558a0b
......@@ -7,10 +7,14 @@ module Gargantext.Components.Graph
import Prelude (bind, discard, pure, ($))
import Data.Maybe (Maybe)
import Data.Nullable (null)
import Data.Sequence as Seq
import DOM.Simple.Console (log, log2)
import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Hooks.Sigmax
import Gargantext.Hooks.Sigmax.Types as Sigmax
import Gargantext.Utils.Reactix as R2
type OnProps = ()
......@@ -30,7 +34,7 @@ type Props sigma forceatlas2 =
( graph :: Graph
, forceAtlas2Settings :: forceatlas2
, sigmaSettings :: sigma
, sigmaRef :: R.Ref (Maybe Sigma)
, sigmaRef :: R.Ref Sigma
)
graph :: forall s fa2. Record (Props s fa2) -> R.Element
......@@ -41,7 +45,11 @@ graphCpt = R.hooksComponent "Graph" cpt
where
cpt props _ = do
ref <- R.useRef null
startSigma ref props.sigmaRef props.sigmaSettings props.forceAtlas2Settings props.graph
--startSigma ref props.sigmaRef props.sigmaSettings props.forceAtlas2Settings props.graph
R.useEffectOnce $ do
log "[graphCpt] calling startSigmaEff"
pure $ startSigmaEff ref props.sigmaRef props.sigmaSettings props.forceAtlas2Settings props.graph
pure $ RH.div { ref, style: {height: "95%"} } []
......
......@@ -87,9 +87,10 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
where
-- tree {treeId: Nothing} _ _ = RH.div { id: "tree" } []
tree _ {showTree: false /\ _} _ = RH.div { id: "tree" } []
tree {mCurrentRoute: route, treeId: root} _ showLogin=
tree {mCurrentRoute: route, treeId: root} _ showLogin =
RH.div {className: "col-md-2", style: {paddingTop: "60px"}}
[forest {sessions, route, frontends, showLogin}]
outer = RH.div { className: "col-md-12" }
inner = RH.div { className: "container-fluid", style: { paddingTop: "90px" } }
row1 = RH.div { className: "row", style: { paddingBottom: "10px", marginTop: "-24px" } }
......@@ -98,8 +99,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
pullLeft = RH.div { className: "pull-left" }
pullRight = RH.div { className: "pull-right" }
mGraph :: R.Ref (Maybe Sigma) -> {graphId :: GraphId, graph :: Maybe Graph.Graph} -> R.Element
mGraph :: R.Ref Sigma -> {graphId :: GraphId, graph :: Maybe Graph.Graph} -> R.Element
mGraph _ {graph: Nothing} = RH.div {} []
mGraph sigmaRef {graphId, graph: Just graph} = graphView sigmaRef {graphId, graph}
......@@ -126,7 +126,7 @@ type GraphProps = (
, graph :: Graph.Graph
)
graphView :: R.Ref (Maybe Sigma) -> Record GraphProps -> R.Element
graphView :: R.Ref Sigma -> Record GraphProps -> R.Element
--graphView sigmaRef props = R.createElement (R.memo el memoCmp) props []
graphView sigmaRef props = R.createElement el props []
where
......
......@@ -34,13 +34,13 @@ simpleButtonCpt = R.hooksComponent "SimpleButton" cpt
[ H.text text ]
]
centerButton :: R.Ref (Maybe Sigmax.Sigma) -> R.Element
centerButton :: R.Ref Sigmax.Sigma -> R.Element
centerButton sigmaRef = simpleButton {
onClick: \_ -> do
let mSigma = Sigmax.readSigma <$> R.readRef sigmaRef
let mSigma = Sigmax.readSigma $ R.readRef sigmaRef
log2 "[centerButton] mSigma" mSigma
case mSigma of
Just (Just s) -> Sigma.goToAllCameras s {x: 0.0, y: 0.0, ratio: 1.0, angle: 0.0}
_ -> pure unit
Just s -> Sigma.goToAllCameras s {x: 0.0, y: 0.0, ratio: 1.0, angle: 0.0}
_ -> pure unit
, text: "Center"
}
......@@ -34,7 +34,7 @@ type Controls =
, showControls :: R.State Boolean
, showSidePanel :: R.State Boolean
, showTree :: R.State Boolean
, sigmaRef :: R.Ref (Maybe Sigmax.Sigma)
, sigmaRef :: R.Ref Sigmax.Sigma
)
controlsToSigmaSettings :: Record Controls -> Record Graph.SigmaSettings
......@@ -105,7 +105,8 @@ useGraphControls = do
showControls <- R.useState' false
showSidePanel <- R.useState' false
showTree <- R.useState' false
sigmaRef <- R2.nothingRef
sigma <- Sigmax.initSigma
sigmaRef <- R.useRef sigma
pure { cursorSize
, multiNodeSelect
......
......@@ -34,7 +34,7 @@ rangeControlCpt = R.hooksComponent "RangeButton" cpt
, RS.rangeSlider sliderProps
]
edgeSizeControl :: R.Ref (Maybe Sigmax.Sigma) -> R.State Range.NumberRange -> R.Element
edgeSizeControl :: R.Ref Sigmax.Sigma -> R.State Range.NumberRange -> R.Element
edgeSizeControl sigmaRef (state /\ setState) =
rangeControl {
caption: "Edge Size"
......@@ -46,18 +46,18 @@ edgeSizeControl sigmaRef (state /\ setState) =
, width: 10.0
, height: 5.0
, onChange: \range@(Range.Closed {min, max}) -> do
let mSigma = Sigmax.readSigma <$> R.readRef sigmaRef
let mSigma = Sigmax.readSigma $ R.readRef sigmaRef
case mSigma of
Just (Just s) -> Sigma.setSettings s {
Just s -> Sigma.setSettings s {
minEdgeSize: min
, maxEdgeSize: max
}
_ -> pure unit
_ -> pure unit
setState $ const range
}
}
nodeSizeControl :: R.Ref (Maybe Sigmax.Sigma) -> R.State Range.NumberRange -> R.Element
nodeSizeControl :: R.Ref Sigmax.Sigma -> R.State Range.NumberRange -> R.Element
nodeSizeControl sigmaRef (state /\ setState) =
rangeControl {
caption: "Node Size"
......@@ -69,13 +69,13 @@ nodeSizeControl sigmaRef (state /\ setState) =
, width: 10.0
, height: 5.0
, onChange: \range@(Range.Closed {min, max}) -> do
let mSigma = Sigmax.readSigma <$> R.readRef sigmaRef
let mSigma = Sigmax.readSigma $ R.readRef sigmaRef
case mSigma of
Just (Just s) -> Sigma.setSettings s {
Just s -> Sigma.setSettings s {
minNodeSize: min
, maxNodeSize: max
}
_ -> pure unit
_ -> pure unit
setState $ const range
}
}
......@@ -56,7 +56,7 @@ cursorSizeButton state =
, onChange: \e -> snd state $ const $ readFloat $ R2.unsafeEventValue e
}
labelSizeButton :: R.Ref (Maybe Sigmax.Sigma) -> R.State Number -> R.Element
labelSizeButton :: R.Ref Sigmax.Sigma -> R.State Number -> R.Element
labelSizeButton sigmaRef state =
sizeButton {
state: state
......@@ -64,13 +64,13 @@ labelSizeButton sigmaRef state =
, min: 5.0
, max: 30.0
, onChange: \e -> do
let mSigma = Sigmax.readSigma <$> R.readRef sigmaRef
let mSigma = Sigmax.readSigma $ R.readRef sigmaRef
let newValue = readFloat $ R2.unsafeEventValue e
let (value /\ setValue) = state
case mSigma of
Just (Just s) -> Sigma.setSettings s {
Just s -> Sigma.setSettings s {
defaultLabelSize: newValue
}
_ -> pure unit
_ -> pure unit
setValue $ const newValue
}
......@@ -53,42 +53,42 @@ controlsToggleButton state =
, onClick: \_ -> snd state not
}
edgesToggleButton :: R.Ref (Maybe Sigmax.Sigma) -> R.State Boolean -> R.Element
edgesToggleButton :: R.Ref Sigmax.Sigma -> R.State Boolean -> R.Element
edgesToggleButton sigmaRef state =
toggleButton {
state: state
, onMessage: "Hide Edges"
, offMessage: "Show Edges"
, onClick: \_ -> do
let mSigma = Sigmax.readSigma <$> R.readRef sigmaRef
let mSigma = Sigmax.readSigma $ R.readRef sigmaRef
let (toggled /\ setToggled) = state
case mSigma of
Just (Just s) -> do
Just s -> do
let settings = {
drawEdges: not toggled
, drawEdgeLabels: not toggled
, hideEdgesOnMove: toggled
}
Sigma.setSettings s settings
_ -> pure unit
_ -> pure unit
setToggled not
}
pauseForceAtlasButton :: R.Ref (Maybe Sigmax.Sigma) -> R.State Boolean -> R.Element
pauseForceAtlasButton :: R.Ref Sigmax.Sigma -> R.State Boolean -> R.Element
pauseForceAtlasButton sigmaRef state =
toggleButton {
state: state
, onMessage: "Pause Force Atlas"
, offMessage: "Start Force Atlas"
, onClick: \_ -> do
let mSigma = Sigmax.readSigma <$> R.readRef sigmaRef
let mSigma = Sigmax.readSigma $ R.readRef sigmaRef
let (toggled /\ setToggled) = state
case mSigma of
Just (Just s) -> if toggled then
Just s -> if toggled then
Sigma.stopForceAtlas2 s
else
Sigma.restartForceAtlas2 s
_ -> pure unit
_ -> pure unit
setToggled not
}
......
......@@ -3,23 +3,23 @@ module Gargantext.Hooks.Sigmax
-- )
where
import Prelude (Unit, bind, const, discard, flip, pure, unit, ($), (*>), (<$), (<$>), (<<<), (<>), (>>=))
import DOM.Simple.Console (log, log2)
import DOM.Simple.Types (Element)
import Data.Array as A
import Data.Either (Either(..), either)
import Data.Foldable (sequence_)
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable)
import Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Traversable (traverse_)
import DOM.Simple.Console (log, log2)
import DOM.Simple.Types (Element)
import Effect (Effect)
import FFI.Simple (delay)
import Reactix as R
import Gargantext.Utils.Reactix as R2
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Hooks.Sigmax.Types (Graph(..))
import Gargantext.Utils.Reactix as R2
import Prelude (Unit, bind, const, discard, flip, pure, unit, ($), (*>), (<$), (<$>), (<<<), (<>), (>>=))
import Reactix as R
type Sigma =
{ sigma :: R.Ref (Maybe Sigma.Sigma)
......@@ -29,6 +29,12 @@ type Sigma =
type Data n e = { graph :: R.Ref (Graph n e) }
initSigma :: R.Hooks Sigma
initSigma = do
s <- R2.nothingRef
c <- R.useRef Seq.empty
pure { sigma: s, cleanup: c }
readSigma :: Sigma -> Maybe Sigma.Sigma
readSigma sigma = R.readRef sigma.sigma
......@@ -49,7 +55,7 @@ cleanupFirst sigma =
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 ref settings sigmaRef
{sigma, isNew} <- useSigma settings sigmaRef
useCanvasRenderer ref sigma
if isNew then do
......@@ -71,8 +77,8 @@ startSigma ref sigmaRef settings forceAtlas2Settings graph = do
pure $ pure unit
-- | Manages a sigma with the given settings
useSigma :: forall settings. R.Ref (Nullable Element) -> settings -> R.Ref (Maybe Sigma) -> R.Hooks {sigma :: Sigma, isNew :: Boolean}
useSigma container settings sigmaRef = do
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
......@@ -101,6 +107,55 @@ useSigma container settings sigmaRef = do
--pure $ cleanupSigma sigma "useSigma"
pure $ R.nothing
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
log "[startSigmaEff] calling useSigmaEff"
sigma <- useSigmaEff settings sigmaRef
log "[startSigmaEff] calling useCanvasRendererEff"
useCanvasRendererEff ref sigma
log "[startSigmaEff] calling useDataEff"
useDataEff sigma graph
log "[startSigmaEff] calling useForceAtlas2Eff"
useForceAtlas2Eff sigma forceAtlas2Settings
--handleRefresh sigma
where
handleRefresh :: Sigma -> Effect Unit
handleRefresh sigma = do
let rSigma = readSigma sigma
_ <- case rSigma of
Nothing -> log2 "[handleRefresh] can't refresh" sigma
Just s -> do
Sigma.refreshForceAtlas s
pure unit
useSigmaEff :: forall settings. settings -> R.Ref Sigma -> Effect Sigma
useSigmaEff settings sigmaRef = do
--sigma <- newSigma
--delay unit $ handleSigma sigma (readSigma sigma)
let sigma = R.readRef sigmaRef
handleSigma sigma (readSigma sigma)
pure sigma
where
--newSigma = do
-- s <- R2.nothingRef
-- c <- R.useRef Seq.empty
-- pure { sigma: s, cleanup: c }
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 $ cleanupSigma sigma "useSigma"
pure unit
-- | Manages a renderer for the sigma
useCanvasRenderer :: R.Ref (Nullable Element) -> Sigma -> R.Hooks Unit
useCanvasRenderer container sigma =
......@@ -124,6 +179,27 @@ useCanvasRenderer container sigma =
errorKillingMsg = "[useCanvasRenderer] Error killing renderer:"
killedMsg = "[useCanvasRenderer] Killed renderer"
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 (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
......@@ -163,6 +239,12 @@ useData sigma graph =
withSigma sig = refreshData sig (sigmafy graph)
sigmaNotFoundMsg = "[useData] Sigma not found, not adding data"
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 = "[useData] Sigma not found, not adding data"
refreshData :: forall n e. Sigma.Sigma -> Sigma.Graph n e -> Effect Unit
refreshData sigma graph
= log clearingMsg
......@@ -196,6 +278,18 @@ useForceAtlas2 sigma settings =
startingMsg = "[Graph] Starting ForceAtlas2"
sigmaNotFoundMsg = "[Graph] Sigma not found, not initialising"
useForceAtlas2Eff :: forall settings. Sigma -> settings -> Effect Unit
useForceAtlas2Eff sigma settings = 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 notFoundMsg f = do
case readSigma sigma of
......
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