Commit 122ccb24 authored by Alexandre Delanoë's avatar Alexandre Delanoë

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

parents bdcfafca 2794eb90
...@@ -4,13 +4,21 @@ module Gargantext.Components.Graph ...@@ -4,13 +4,21 @@ module Gargantext.Components.Graph
-- , forceAtlas2Settings, ForceAtlas2Settings, ForceAtlas2OptionalSettings -- , forceAtlas2Settings, ForceAtlas2Settings, ForceAtlas2OptionalSettings
-- ) -- )
where where
import Prelude (bind, discard, pure, ($)) import Prelude (bind, discard, pure, ($), unit)
import Data.Maybe (Maybe) import Data.Maybe (Maybe(..))
import Data.Nullable (null) import Data.Nullable (notNull, null, Nullable)
import Data.Sequence as Seq
import DOM.Simple (createElement, setAttr)
import DOM.Simple.Console (log, log2)
import DOM.Simple.Types (Element)
import Effect.Timer (setTimeout)
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
import Gargantext.Hooks.Sigmax.Types as Sigmax import Gargantext.Hooks.Sigmax.Types as Sigmax
import Gargantext.Utils.Reactix as R2
type OnProps = () type OnProps = ()
...@@ -27,10 +35,11 @@ type Edge = ( id :: String, source :: String, target :: String ) ...@@ -27,10 +35,11 @@ type Edge = ( id :: String, source :: String, target :: String )
type Graph = Sigmax.Graph Node Edge type Graph = Sigmax.Graph Node Edge
type Props sigma forceatlas2 = type Props sigma forceatlas2 =
( graph :: Graph ( elRef :: R.Ref (Nullable Element)
, forceAtlas2Settings :: forceatlas2 , forceAtlas2Settings :: forceatlas2
, graph :: Graph
, sigmaSettings :: sigma , sigmaSettings :: sigma
, sigmaRef :: R.Ref (Maybe Sigma) , sigmaRef :: R.Ref Sigma
) )
graph :: forall s fa2. Record (Props s fa2) -> R.Element graph :: forall s fa2. Record (Props s fa2) -> R.Element
...@@ -40,10 +49,36 @@ graphCpt :: forall s fa2. R.Component (Props s fa2) ...@@ -40,10 +49,36 @@ 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
ref <- R.useRef null -- R.useEffectOnce' $ do
startSigma ref props.sigmaRef props.sigmaSettings props.forceAtlas2Settings props.graph -- el <- case R.readNullableRef props.elRef of
-- 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
-- Nothing -> pure unit
-- Just parentEl -> R2.appendChild parentEl el
-- pure unit
R.useEffectOnce $ do
--log "[graphCpt] calling startSigmaEff"
startSigmaEff props.elRef props.sigmaRef props.sigmaSettings props.forceAtlas2Settings props.graph
delay unit $ \_ -> do
log "[GraphCpt] cleaning up"
pure $ pure unit
pure $ RH.div { ref, style: {height: "95%"} } [] -- NOTE: This div is not empty after sigma initializes.
-- When we change state, we make it empty though.
--pure $ RH.div { ref: props.elRef, style: {height: "95%"} } []
pure $ case R.readNullableRef props.elRef of
Nothing -> RH.div {} []
Just el -> R.createPortal [] el
type SigmaSettings = type SigmaSettings =
( animationsTime :: Number ( animationsTime :: Number
......
...@@ -6,9 +6,11 @@ import Data.FoldableWithIndex (foldMapWithIndex) ...@@ -6,9 +6,11 @@ import Data.FoldableWithIndex (foldMapWithIndex)
import Data.Foldable (foldMap) import Data.Foldable (foldMap)
import Data.Int (toNumber) import Data.Int (toNumber)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Nullable (null, Nullable)
import Data.Sequence as Seq import Data.Sequence as Seq
import Data.Tuple (fst,snd) import Data.Tuple (fst,snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Types (Element)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as RH import Reactix.DOM.HTML as RH
...@@ -38,7 +40,9 @@ type LayoutProps = ...@@ -38,7 +40,9 @@ type LayoutProps =
, frontends :: Frontends , frontends :: Frontends
) )
type Props = ( graph :: Maybe Graph.Graph | LayoutProps ) type Props = (
graph :: Maybe Graph.Graph | LayoutProps
)
-------------------------------------------------------------- --------------------------------------------------------------
explorerLayout :: Record LayoutProps -> R.Element explorerLayout :: Record LayoutProps -> R.Element
...@@ -47,10 +51,11 @@ explorerLayout props = R.createElement explorerLayoutCpt props [] ...@@ -47,10 +51,11 @@ explorerLayout props = R.createElement explorerLayoutCpt props []
explorerLayoutCpt :: R.Component LayoutProps explorerLayoutCpt :: R.Component LayoutProps
explorerLayoutCpt = R.hooksComponent "G.C.GraphExplorer.explorerLayout" cpt explorerLayoutCpt = R.hooksComponent "G.C.GraphExplorer.explorerLayout" cpt
where where
cpt {graphId, mCurrentRoute, treeId, session, sessions, frontends} _ = cpt {graphId, mCurrentRoute, treeId, session, sessions, frontends} _ = do
useLoader graphId (getNodes session) handler useLoader graphId (getNodes session) handler
where where
handler loaded = explorer {graphId, mCurrentRoute, treeId, session, sessions, graph, frontends} handler loaded =
explorer {graphId, mCurrentRoute, treeId, session, sessions, graph, frontends}
where graph = Just (convert loaded) where graph = Just (convert loaded)
-------------------------------------------------------------- --------------------------------------------------------------
...@@ -61,6 +66,7 @@ explorerCpt :: R.Component Props ...@@ -61,6 +66,7 @@ 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 {sessions, session, graphId, mCurrentRoute, treeId, graph, frontends} _ = do
graphRef <- R.useRef null
controls <- Controls.useGraphControls controls <- Controls.useGraphControls
state <- useExplorerState state <- useExplorerState
showLogin <- snd <$> R.useState' true showLogin <- snd <$> R.useState' true
...@@ -77,9 +83,11 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt ...@@ -77,9 +83,11 @@ 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
, mGraph controls.sigmaRef {graphId, graph} , RH.div { ref: graphRef, id: "graph-view", className: "col-md-12", style: {height: "95%"} } [] -- graph container
, mGraph graphRef controls.sigmaRef {graphId, graph}
, Sidebar.sidebar {showSidePanel: fst controls.showSidePanel} ] , Sidebar.sidebar {showSidePanel: fst controls.showSidePanel} ]
, row [ ] , row [
]
] ]
] ]
] ]
...@@ -87,9 +95,10 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt ...@@ -87,9 +95,10 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
where where
-- tree {treeId: Nothing} _ _ = RH.div { id: "tree" } [] -- tree {treeId: Nothing} _ _ = RH.div { id: "tree" } []
tree _ {showTree: false /\ _} _ = 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"}} RH.div {className: "col-md-2", style: {paddingTop: "60px"}}
[forest {sessions, route, frontends, showLogin}] [forest {sessions, route, frontends, showLogin}]
outer = RH.div { className: "col-md-12" } outer = RH.div { className: "col-md-12" }
inner = RH.div { className: "container-fluid", style: { paddingTop: "90px" } } inner = RH.div { className: "container-fluid", style: { paddingTop: "90px" } }
row1 = RH.div { className: "row", style: { paddingBottom: "10px", marginTop: "-24px" } } row1 = RH.div { className: "row", style: { paddingBottom: "10px", marginTop: "-24px" } }
...@@ -98,10 +107,9 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt ...@@ -98,10 +107,9 @@ 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 (Maybe Sigma) -> {graphId :: GraphId, graph :: Maybe Graph.Graph} -> 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 sigmaRef {graphId, graph: Just graph} = graphView sigmaRef {graphId, graph}
useExplorerState :: R.Hooks (Record GET.State) useExplorerState :: R.Hooks (Record GET.State)
useExplorerState = do pure {} useExplorerState = do pure {}
...@@ -126,23 +134,20 @@ type GraphProps = ( ...@@ -126,23 +134,20 @@ type GraphProps = (
, graph :: Graph.Graph , graph :: Graph.Graph
) )
graphView :: R.Ref (Maybe Sigma) -> Record GraphProps -> R.Element graphView :: R.Ref (Nullable Element) -> R.Ref Sigma -> Record GraphProps -> R.Element
--graphView sigmaRef props = R.createElement (R.memo el memoCmp) props [] --graphView sigmaRef props = R.createElement (R.memo el memoCmp) props []
graphView sigmaRef props = R.createElement el props [] 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} _children = do
pure $ pure $ Graph.graph {
RH.div { id: "graph-view", className: "col-md-12" } elRef
[ , forceAtlas2Settings: Graph.forceAtlas2Settings
Graph.graph { , graph
forceAtlas2Settings: Graph.forceAtlas2Settings , sigmaSettings: Graph.sigmaSettings
, graph , sigmaRef: sigmaRef
, sigmaSettings: Graph.sigmaSettings }
, sigmaRef: sigmaRef
}
]
convert :: GET.GraphData -> Graph.Graph convert :: GET.GraphData -> Graph.Graph
convert (GET.GraphData r) = Sigmax.Graph {nodes, edges} convert (GET.GraphData r) = Sigmax.Graph {nodes, edges}
......
...@@ -34,13 +34,11 @@ simpleButtonCpt = R.hooksComponent "SimpleButton" cpt ...@@ -34,13 +34,11 @@ simpleButtonCpt = R.hooksComponent "SimpleButton" cpt
[ H.text text ] [ H.text text ]
] ]
centerButton :: R.Ref (Maybe Sigmax.Sigma) -> R.Element centerButton :: R.Ref Sigmax.Sigma -> R.Element
centerButton sigmaRef = simpleButton { centerButton sigmaRef = simpleButton {
onClick: \_ -> do onClick: \_ -> do
let mSigma = Sigmax.readSigma <$> R.readRef sigmaRef let sigma = R.readRef sigmaRef
log2 "[centerButton] mSigma" mSigma Sigmax.dependOnSigma sigma "[centerButton] sigma: Nothing" $ \s ->
case mSigma of Sigma.goToAllCameras s {x: 0.0, y: 0.0, ratio: 1.0, angle: 0.0}
Just (Just s) -> Sigma.goToAllCameras s {x: 0.0, y: 0.0, ratio: 1.0, angle: 0.0}
_ -> pure unit
, text: "Center" , text: "Center"
} }
...@@ -11,9 +11,11 @@ module Gargantext.Components.GraphExplorer.Controls ...@@ -11,9 +11,11 @@ module Gargantext.Components.GraphExplorer.Controls
, getMultiNodeSelect, setMultiNodeSelect , getMultiNodeSelect, setMultiNodeSelect
) where ) where
import Data.Maybe (Maybe) import Data.Maybe (Maybe(..))
import DOM.Simple.Console (log, log2)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Timer (clearTimeout, setTimeout)
import Prelude import Prelude
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as RH import Reactix.DOM.HTML as RH
...@@ -24,6 +26,7 @@ import Gargantext.Components.GraphExplorer.RangeControl (edgeSizeControl, nodeSi ...@@ -24,6 +26,7 @@ import Gargantext.Components.GraphExplorer.RangeControl (edgeSizeControl, nodeSi
import Gargantext.Components.GraphExplorer.SlideButton (cursorSizeButton, labelSizeButton) import Gargantext.Components.GraphExplorer.SlideButton (cursorSizeButton, labelSizeButton)
import Gargantext.Components.GraphExplorer.ToggleButton (edgesToggleButton, pauseForceAtlasButton) import Gargantext.Components.GraphExplorer.ToggleButton (edgesToggleButton, pauseForceAtlasButton)
import Gargantext.Hooks.Sigmax as Sigmax import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Utils.Range as Range import Gargantext.Utils.Range as Range
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -34,7 +37,7 @@ type Controls = ...@@ -34,7 +37,7 @@ type Controls =
, showControls :: R.State Boolean , showControls :: R.State Boolean
, showSidePanel :: R.State Boolean , showSidePanel :: R.State Boolean
, showTree :: R.State Boolean , showTree :: R.State Boolean
, sigmaRef :: R.Ref (Maybe Sigmax.Sigma) , sigmaRef :: R.Ref Sigmax.Sigma
) )
controlsToSigmaSettings :: Record Controls -> Record Graph.SigmaSettings controlsToSigmaSettings :: Record Controls -> Record Graph.SigmaSettings
...@@ -72,6 +75,24 @@ controlsCpt = R.hooksComponent "GraphControls" cpt ...@@ -72,6 +75,24 @@ controlsCpt = R.hooksComponent "GraphControls" cpt
where where
cpt props _ = do cpt props _ = do
localControls <- initialLocalControls localControls <- initialLocalControls
-- ref to track automatic FA pausing
-- If user pauses FA before auto is triggered, clear the timeoutId
-- TODO: mFAPauseRef needs to be set higher up the tree
--mFAPauseRef <- R.useRef Nothing
--R.useEffect $ handleForceAtlasPause props.sigmaRef localControls.pauseForceAtlas mFAPauseRef
R.useEffect' $ Sigmax.handleForceAtlas2Pause props.sigmaRef localControls.pauseForceAtlas
R.useEffectOnce' $ do
timeoutId <- setTimeout 2000 $ do
--R.setRef mFAPauseRef Nothing
let (toggled /\ setToggled) = localControls.pauseForceAtlas
if toggled then
setToggled $ const false
else
pure unit
--R.setRef mFAPauseRef $ Just timeoutId
pure unit
pure $ case getShowControls props of pure $ case getShowControls props of
false -> RH.div {} [] false -> RH.div {} []
...@@ -105,7 +126,8 @@ useGraphControls = do ...@@ -105,7 +126,8 @@ useGraphControls = do
showControls <- R.useState' false showControls <- R.useState' false
showSidePanel <- R.useState' false showSidePanel <- R.useState' false
showTree <- R.useState' false showTree <- R.useState' false
sigmaRef <- R2.nothingRef sigma <- Sigmax.initSigma
sigmaRef <- R.useRef sigma
pure { cursorSize pure { cursorSize
, multiNodeSelect , multiNodeSelect
......
...@@ -34,7 +34,7 @@ rangeControlCpt = R.hooksComponent "RangeButton" cpt ...@@ -34,7 +34,7 @@ rangeControlCpt = R.hooksComponent "RangeButton" cpt
, RS.rangeSlider sliderProps , 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) = edgeSizeControl sigmaRef (state /\ setState) =
rangeControl { rangeControl {
caption: "Edge Size" caption: "Edge Size"
...@@ -46,18 +46,17 @@ edgeSizeControl sigmaRef (state /\ setState) = ...@@ -46,18 +46,17 @@ edgeSizeControl sigmaRef (state /\ setState) =
, width: 10.0 , width: 10.0
, height: 5.0 , height: 5.0
, onChange: \range@(Range.Closed {min, max}) -> do , onChange: \range@(Range.Closed {min, max}) -> do
let mSigma = Sigmax.readSigma <$> R.readRef sigmaRef let sigma = R.readRef sigmaRef
case mSigma of Sigmax.dependOnSigma sigma "[edgeSizeControl] sigma: Nothing" $ \s -> do
Just (Just s) -> Sigma.setSettings s { Sigma.setSettings s {
minEdgeSize: min minEdgeSize: min
, maxEdgeSize: max , maxEdgeSize: max
} }
_ -> pure unit
setState $ const range 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) = nodeSizeControl sigmaRef (state /\ setState) =
rangeControl { rangeControl {
caption: "Node Size" caption: "Node Size"
...@@ -69,13 +68,12 @@ nodeSizeControl sigmaRef (state /\ setState) = ...@@ -69,13 +68,12 @@ nodeSizeControl sigmaRef (state /\ setState) =
, width: 10.0 , width: 10.0
, height: 5.0 , height: 5.0
, onChange: \range@(Range.Closed {min, max}) -> do , onChange: \range@(Range.Closed {min, max}) -> do
let mSigma = Sigmax.readSigma <$> R.readRef sigmaRef let sigma = R.readRef sigmaRef
case mSigma of Sigmax.dependOnSigma sigma "[nodeSizeControl] sigma: Nothing" $ \s -> do
Just (Just s) -> Sigma.setSettings s { Sigma.setSettings s {
minNodeSize: min minNodeSize: min
, maxNodeSize: max , maxNodeSize: max
} }
_ -> pure unit
setState $ const range setState $ const range
} }
} }
...@@ -56,7 +56,7 @@ cursorSizeButton state = ...@@ -56,7 +56,7 @@ cursorSizeButton state =
, onChange: \e -> snd state $ const $ readFloat $ R2.unsafeEventValue e , 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 = labelSizeButton sigmaRef state =
sizeButton { sizeButton {
state: state state: state
...@@ -64,13 +64,12 @@ labelSizeButton sigmaRef state = ...@@ -64,13 +64,12 @@ labelSizeButton sigmaRef state =
, min: 5.0 , min: 5.0
, max: 30.0 , max: 30.0
, onChange: \e -> do , onChange: \e -> do
let mSigma = Sigmax.readSigma <$> R.readRef sigmaRef let sigma = R.readRef sigmaRef
let newValue = readFloat $ R2.unsafeEventValue e let newValue = readFloat $ R2.unsafeEventValue e
let (value /\ setValue) = state let (value /\ setValue) = state
case mSigma of Sigmax.dependOnSigma sigma "[labelSizeButton] sigma: Nothing" $ \s -> do
Just (Just s) -> Sigma.setSettings s { Sigma.setSettings s {
defaultLabelSize: newValue defaultLabelSize: newValue
} }
_ -> pure unit
setValue $ const newValue setValue $ const newValue
} }
...@@ -53,42 +53,33 @@ controlsToggleButton state = ...@@ -53,42 +53,33 @@ controlsToggleButton state =
, onClick: \_ -> snd state not , 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 = edgesToggleButton sigmaRef state =
toggleButton { toggleButton {
state: state state: state
, onMessage: "Hide Edges" , onMessage: "Hide Edges"
, offMessage: "Show Edges" , offMessage: "Show Edges"
, onClick: \_ -> do , onClick: \_ -> do
let mSigma = Sigmax.readSigma <$> R.readRef sigmaRef let sigma = R.readRef sigmaRef
let (toggled /\ setToggled) = state let (toggled /\ setToggled) = state
case mSigma of Sigmax.dependOnSigma sigma "[edgesToggleButton] sigma: Nothing" $ \s -> do
Just (Just s) -> do let settings = {
let settings = { drawEdges: not toggled
drawEdges: not toggled , drawEdgeLabels: not toggled
, drawEdgeLabels: not toggled , hideEdgesOnMove: toggled
, hideEdgesOnMove: toggled }
} Sigma.setSettings s settings
Sigma.setSettings s settings
_ -> pure unit
setToggled not 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 = pauseForceAtlasButton sigmaRef state =
toggleButton { toggleButton {
state: state state: state
, onMessage: "Pause Force Atlas" , onMessage: "Pause Force Atlas"
, offMessage: "Start Force Atlas" , offMessage: "Start Force Atlas"
, onClick: \_ -> do , onClick: \_ -> do
let mSigma = Sigmax.readSigma <$> R.readRef sigmaRef let (_ /\ setToggled) = state
let (toggled /\ setToggled) = state
case mSigma of
Just (Just s) -> if toggled then
Sigma.stopForceAtlas2 s
else
Sigma.restartForceAtlas2 s
_ -> pure unit
setToggled not setToggled not
} }
......
...@@ -3,23 +3,25 @@ module Gargantext.Hooks.Sigmax ...@@ -3,23 +3,25 @@ module Gargantext.Hooks.Sigmax
-- ) -- )
where 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.Array as A
import Data.Either (Either(..), either) import Data.Either (Either(..), either)
import Data.Foldable (sequence_) import Data.Foldable (sequence_)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable) import Data.Nullable (Nullable)
import Data.Sequence as Seq
import Data.Sequence (Seq) import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Traversable (traverse_) import Data.Traversable (traverse_)
import DOM.Simple.Console (log, log2) import Data.Tuple (Tuple(..))
import DOM.Simple.Types (Element) import Data.Tuple.Nested((/\))
import Effect (Effect) import Effect (Effect)
import FFI.Simple (delay) 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.Sigma as Sigma
import Gargantext.Hooks.Sigmax.Types (Graph(..)) 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 = type Sigma =
{ sigma :: R.Ref (Maybe Sigma.Sigma) { sigma :: R.Ref (Maybe Sigma.Sigma)
...@@ -29,6 +31,12 @@ type Sigma = ...@@ -29,6 +31,12 @@ type Sigma =
type Data n e = { graph :: R.Ref (Graph n e) } 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 -> Maybe Sigma.Sigma
readSigma sigma = R.readRef sigma.sigma readSigma sigma = R.readRef sigma.sigma
...@@ -49,7 +57,7 @@ cleanupFirst sigma = ...@@ -49,7 +57,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 :: 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 startSigma ref sigmaRef settings forceAtlas2Settings graph = do
{sigma, isNew} <- useSigma ref settings sigmaRef {sigma, isNew} <- useSigma settings sigmaRef
useCanvasRenderer ref sigma useCanvasRenderer ref sigma
if isNew then do if isNew then do
...@@ -62,17 +70,12 @@ startSigma ref sigmaRef settings forceAtlas2Settings graph = do ...@@ -62,17 +70,12 @@ startSigma ref sigmaRef settings forceAtlas2Settings graph = do
delay unit $ handleRefresh sigma delay unit $ handleRefresh sigma
where where
handleRefresh sigma _ = do handleRefresh sigma _ = pure $
let rSigma = readSigma sigma dependOnSigma sigma "[handleRefresh] can't refresh" Sigma.refreshForceAtlas
_ <- case rSigma of
Nothing -> log2 "[handleRefresh] can't refresh" sigma
Just s -> do
Sigma.refreshForceAtlas s
pure $ pure unit
-- | Manages a sigma with the given settings -- | 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 :: forall settings. settings -> R.Ref (Maybe Sigma) -> R.Hooks {sigma :: Sigma, isNew :: Boolean}
useSigma container settings sigmaRef = do useSigma settings sigmaRef = do
sigma <- newSigma sigmaRef sigma <- newSigma sigmaRef
let isNew = case (readSigma sigma) of let isNew = case (readSigma sigma) of
Just _ -> false Just _ -> false
...@@ -101,6 +104,7 @@ useSigma container settings sigmaRef = do ...@@ -101,6 +104,7 @@ useSigma container settings sigmaRef = do
--pure $ cleanupSigma sigma "useSigma" --pure $ cleanupSigma sigma "useSigma"
pure $ R.nothing pure $ R.nothing
-- | Manages a renderer for the sigma -- | Manages a renderer for the sigma
useCanvasRenderer :: R.Ref (Nullable Element) -> Sigma -> R.Hooks Unit useCanvasRenderer :: R.Ref (Nullable Element) -> Sigma -> R.Hooks Unit
useCanvasRenderer container sigma = useCanvasRenderer container sigma =
...@@ -152,8 +156,8 @@ addRenderer sigma renderer = do ...@@ -152,8 +156,8 @@ addRenderer sigma renderer = do
(const unit <$> ret) <$ report ret (const unit <$> ret) <$ report ret
where where
report = either (log2 errorMsg) (\_ -> log successMsg) report = either (log2 errorMsg) (\_ -> log successMsg)
errorMsg = "[useRenderer] Error adding renderer:" errorMsg = "[addRenderer] Error adding renderer:"
successMsg = "[useRenderer] Added renderer successfully" successMsg = "[addRenderer] Added renderer successfully"
useData :: forall n e. Sigma -> Graph n e -> R.Hooks Unit useData :: forall n e. Sigma -> Graph n e -> R.Hooks Unit
useData sigma graph = useData sigma graph =
...@@ -208,3 +212,117 @@ dependOnContainer container notFoundMsg f = do ...@@ -208,3 +212,117 @@ dependOnContainer container notFoundMsg f = do
Nothing -> log notFoundMsg Nothing -> log notFoundMsg
Just c -> f c Just c -> f c
-- 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
--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
Just sig -> do
--log "[startSigmaEff] sigma initialized already"
--Sigma.swapRendererContainer ref sig
--dependOnContainer ref "[startSigmaEff] no container" $ Sigma.setRendererContainer sig
--useCanvasRendererEff ref rSigma
--useDataEff rSigma graph
--useForceAtlas2Eff rSigma forceAtlas2Settings
--log "[startSigmaEff] refreshForceAtlas"
--Sigma.refreshForceAtlas sig
--if isFARunning then
-- Sigma.restartForceAtlas2 sig
--else
-- Sigma.stopForceAtlas2 sig
pure unit
--handleRefresh sigma
where
handleRefresh :: Sigma -> Effect Unit
handleRefresh sigma = dependOnSigma sigma "[handleRefresh] can't refresh" $ \s -> do
Sigma.refreshForceAtlas s
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
Sigma.startForceAtlas2 sig settings
--cleanupFirst sigma (Sigma.killForceAtlas2 sig)
startingMsg = "[useForceAtlas2Eff] Starting ForceAtlas2"
sigmaNotFoundMsg = "[useForceAtlas2Eff] Sigma not found, not initialising"
--handleForceAtlasPause sigmaRef (toggled /\ setToggled) mFAPauseRef = do
handleForceAtlas2Pause :: R.Ref Sigma -> R.State Boolean -> Effect Unit
handleForceAtlas2Pause sigmaRef (toggled /\ setToggled) = do
let sigma = R.readRef sigmaRef
dependOnSigma sigma "[handleForceAtlas2Pause] sigma: Nothing" $ \s -> do
--log2 "[handleForceAtlas2Pause] mSigma: Just " s
--log2 "[handleForceAtlas2Pause] toggled: " toggled
isFARunning <- Sigma.isForceAtlas2Running s
--log2 "[handleForceAtlas2Pause] isFARunning: " isFARunning
case Tuple toggled isFARunning of
Tuple true false -> Sigma.restartForceAtlas2 s
Tuple false true -> Sigma.stopForceAtlas2 s
_ -> pure unit
-- handle case when user pressed pause/start fa button before timeout fired
--case R.readRef mFAPauseRef of
-- Nothing -> pure unit
-- Just timeoutId -> do
-- R.setRef mFAPauseRef Nothing
-- clearTimeout timeoutId
...@@ -39,6 +39,12 @@ function killRenderer(left, right, sigma, renderer) { ...@@ -39,6 +39,12 @@ function killRenderer(left, right, sigma, renderer) {
return left(e); return left(e);
} }
} }
function getRendererContainer(sigma) {
return sigma.renderers[0].container;
}
function setRendererContainer(sigma, el) {
sigma.renderers[0].container = el;
}
function killSigma(left, right, sigma) { function killSigma(left, right, sigma) {
try { try {
sigma.kill() sigma.kill()
...@@ -69,6 +75,8 @@ exports._graphRead = graphRead; ...@@ -69,6 +75,8 @@ exports._graphRead = graphRead;
exports._refresh = refresh; exports._refresh = refresh;
exports._addRenderer = addRenderer; exports._addRenderer = addRenderer;
exports._killRenderer = killRenderer; exports._killRenderer = killRenderer;
exports._getRendererContainer = getRendererContainer;
exports._setRendererContainer = setRendererContainer;
exports._killSigma = killSigma exports._killSigma = killSigma
exports._clear = clear; exports._clear = clear;
exports._bind = bind; exports._bind = bind;
......
...@@ -2,11 +2,14 @@ module Gargantext.Hooks.Sigmax.Sigma where ...@@ -2,11 +2,14 @@ module Gargantext.Hooks.Sigmax.Sigma where
import Prelude import Prelude
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Nullable (null) import Data.Nullable (notNull, null, Nullable)
import DOM.Simple.Console (log, log2)
import DOM.Simple.Types (Element)
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
foreign import data Sigma :: Type foreign import data Sigma :: Type
...@@ -53,19 +56,6 @@ refresh = runEffectFn1 _refresh ...@@ -53,19 +56,6 @@ refresh = runEffectFn1 _refresh
foreign import _refresh :: EffectFn1 Sigma Unit foreign import _refresh :: EffectFn1 Sigma Unit
refreshForceAtlas :: Sigma -> Effect Unit
refreshForceAtlas sigma = do
isRunning <- isForceAtlas2Running sigma
if isRunning then
pure unit
else do
_ <- setTimeout 100 $ do
restartForceAtlas2 sigma
_ <- setTimeout 100 $
stopForceAtlas2 sigma
pure unit
pure unit
addRenderer :: forall r err. Sigma -> r -> Effect (Either err Unit) addRenderer :: forall r err. Sigma -> r -> Effect (Either err Unit)
addRenderer = runEffectFn4 _addRenderer Left Right addRenderer = runEffectFn4 _addRenderer Left Right
...@@ -88,6 +78,24 @@ foreign import _killRenderer ...@@ -88,6 +78,24 @@ foreign import _killRenderer
r r
(Either err Unit) (Either err Unit)
getRendererContainer :: Sigma -> Effect Element
getRendererContainer sigma = runEffectFn1 _getRendererContainer sigma
foreign import _getRendererContainer
:: EffectFn1 Sigma Element
swapRendererContainer :: R.Ref (Nullable Element) -> Sigma -> Effect Unit
swapRendererContainer ref sigma = do
el <- getRendererContainer sigma
log2 "[swapRendererContainer] el" el
R.setRef ref $ notNull el
setRendererContainer :: Sigma -> Element -> Effect Unit
setRendererContainer sigma el = runEffectFn2 _setRendererContainer sigma el
foreign import _setRendererContainer
:: EffectFn2 Sigma Element Unit
killSigma :: forall err. Sigma -> Effect (Either err Unit) killSigma :: forall err. Sigma -> Effect (Either err Unit)
killSigma = runEffectFn3 _killSigma Left Right killSigma = runEffectFn3 _killSigma Left Right
...@@ -135,6 +143,19 @@ foreign import _stopForceAtlas2 :: EffectFn1 Sigma Unit ...@@ -135,6 +143,19 @@ foreign import _stopForceAtlas2 :: EffectFn1 Sigma Unit
foreign import _killForceAtlas2 :: EffectFn1 Sigma Unit foreign import _killForceAtlas2 :: EffectFn1 Sigma Unit
foreign import _isForceAtlas2Running :: EffectFn1 Sigma Boolean foreign import _isForceAtlas2Running :: EffectFn1 Sigma Boolean
refreshForceAtlas :: Sigma -> Effect Unit
refreshForceAtlas sigma = do
isRunning <- isForceAtlas2Running sigma
if isRunning then
pure unit
else do
_ <- setTimeout 100 $ do
restartForceAtlas2 sigma
_ <- setTimeout 100 $
stopForceAtlas2 sigma
pure unit
pure unit
newtype SigmaEasing = SigmaEasing String newtype SigmaEasing = SigmaEasing String
sigmaEasing :: { linear :: SigmaEasing sigmaEasing :: { linear :: SigmaEasing
......
'use strict';
function addRootElement(rootElem) {
document.body.insertBefore(
rootElem,
document.body.lastElementChild.nextElementSibling
);
}
exports._addRootElement = addRootElement;
...@@ -6,14 +6,16 @@ import Data.Nullable (Nullable, null, toMaybe) ...@@ -6,14 +6,16 @@ import Data.Nullable (Nullable, null, toMaybe)
import Data.Tuple (Tuple) import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple as DOM import DOM.Simple as DOM
import DOM.Simple.Console (log, log2)
import DOM.Simple.Document (document) import DOM.Simple.Document (document)
import DOM.Simple.Event as DE import DOM.Simple.Event as DE
import DOM.Simple.Element as Element import DOM.Simple.Element as Element
import DOM.Simple.Types (class IsNode)
import Effect (Effect) import Effect (Effect)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Aff (Aff, launchAff, launchAff_, killFiber) import Effect.Aff (Aff, launchAff, launchAff_, killFiber)
import Effect.Exception (error) import Effect.Exception (error)
import Effect.Uncurried (EffectFn1, mkEffectFn1, mkEffectFn2) import Effect.Uncurried (EffectFn1, runEffectFn1, mkEffectFn1, mkEffectFn2)
import FFI.Simple ((...), defineProperty, delay, args2, args3) import FFI.Simple ((...), defineProperty, delay, args2, args3)
import React (class ReactPropFields, Children, ReactClass, ReactElement) import React (class ReactPropFields, Children, ReactClass, ReactElement)
import React as React import React as React
...@@ -167,3 +169,21 @@ useReductor' r = useReductor r pure ...@@ -167,3 +169,21 @@ useReductor' r = useReductor r pure
render :: R.Element -> DOM.Element -> Effect Unit render :: R.Element -> DOM.Element -> Effect Unit
render e d = delay unit $ \_ -> pure $ R.reactDOM ... "render" $ args2 e d render e d = delay unit $ \_ -> pure $ R.reactDOM ... "render" $ args2 e d
addRootElement :: DOM.Element -> Effect Unit
addRootElement = runEffectFn1 _addRootElement
foreign import _addRootElement
:: EffectFn1 DOM.Element Unit
appendChild :: forall n m. IsNode n => IsNode m => n -> m -> Effect Unit
appendChild n c = delay unit $ \_ -> pure $ n ... "appendChild" $ [c]
appendChildToParentId :: forall c. IsNode c => String -> c -> Effect Unit
appendChildToParentId ps c = delay unit $ \_ -> do
parentEl <- getElementById ps
log2 "[appendChildToParentId] ps" ps
log2 "[appendChildToParentId] parentEl" parentEl
case parentEl of
Nothing -> pure unit
Just el -> appendChild el c
...@@ -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.3: purescript@^0.13.4:
version "0.13.3" version "0.13.4"
resolved "https://registry.yarnpkg.com/purescript/-/purescript-0.13.3.tgz#18e0a8c0a21332fc16b02218a8b136a699d444bb" resolved "https://registry.yarnpkg.com/purescript/-/purescript-0.13.4.tgz#8f61e54d8fb3be80e3666f443a463bec1a7a28b7"
integrity sha512-YFznjWSFrl6pbds0JxWXJ/ztzyGgUsR5pvdF/wH1i1BqSqxpFtWgREUIOCCkzmuc+X9U2Ntf5DMQ56RxawE3gQ== integrity sha512-wVvmdHpBJaxkqigkCNEmxvKElech8V+NWQtj0hQdL0Vhcd3SUFKbdIul9sN4ABOsfYIobKk/foI1VZbUuTJZEw==
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