Commit 1b753ff9 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[toestand] more refactoring work

parent 7d5673d3
...@@ -76,8 +76,7 @@ forestCpt = here.component "forest" cpt where ...@@ -76,8 +76,7 @@ forestCpt = here.component "forest" cpt where
-- NOTE: this is a hack to reload the forest on demand -- NOTE: this is a hack to reload the forest on demand
tasks' <- GAT.useTasks reloadRoot reloadForest tasks' <- GAT.useTasks reloadRoot reloadForest
R.useEffect' $ do R.useEffect' $ do
_ <- T.write (Just tasks') tasks T2.write_ (Just tasks') tasks
pure unit
handed' <- T.useLive T.unequal handed handed' <- T.useLive T.unequal handed
reloadForest' <- T.useLive T.unequal reloadForest reloadForest' <- T.useLive T.unequal reloadForest
reloadRoot' <- T.useLive T.unequal reloadRoot reloadRoot' <- T.useLive T.unequal reloadRoot
...@@ -124,8 +123,7 @@ plus handed showLogin backend = H.div { className: "row" } ...@@ -124,8 +123,7 @@ plus handed showLogin backend = H.div { className: "row" }
where where
click _ = do click _ = do
-- _ <- T.modify (const Nothing) backend -- _ <- T.modify (const Nothing) backend
_ <- T.write true showLogin T2.write_ true showLogin
pure unit
title = "Add or remove connections to the server(s)." title = "Add or remove connections to the server(s)."
divClass = "fa fa-universal-access" divClass = "fa fa-universal-access"
buttonClass = buttonClass =
......
...@@ -172,7 +172,7 @@ performAction (DeleteNode nt) p@{ forestOpen ...@@ -172,7 +172,7 @@ performAction (DeleteNode nt) p@{ forestOpen
GT.NodePublic GT.FolderPublic -> void $ deleteNode session nt id GT.NodePublic GT.FolderPublic -> void $ deleteNode session nt id
GT.NodePublic _ -> void $ unpublishNode session parent_id id GT.NodePublic _ -> void $ unpublishNode session parent_id id
_ -> void $ deleteNode session nt id _ -> void $ deleteNode session nt id
_ <- liftEffect $ T.modify (Set.delete (mkNodeId session id)) forestOpen liftEffect $ T2.modify_ (Set.delete (mkNodeId session id)) forestOpen
performAction RefreshTree p performAction RefreshTree p
performAction (DoSearch task) p@{ tasks performAction (DoSearch task) p@{ tasks
, tree: (NTree (LNode {id}) _) } = liftEffect $ do , tree: (NTree (LNode {id}) _) } = liftEffect $ do
...@@ -198,14 +198,14 @@ performAction (ShareTeam username) p@{ tree: (NTree (LNode {id}) _)} = ...@@ -198,14 +198,14 @@ performAction (ShareTeam username) p@{ tree: (NTree (LNode {id}) _)} =
performAction (SharePublic { params }) p@{ forestOpen } = traverse_ f params where performAction (SharePublic { params }) p@{ forestOpen } = traverse_ f params where
f (SubTreeOut { in: inId, out }) = do f (SubTreeOut { in: inId, out }) = do
void $ Share.shareReq p.session inId $ Share.SharePublicParams { node_id: out } void $ Share.shareReq p.session inId $ Share.SharePublicParams { node_id: out }
_ <- liftEffect $ T.modify (Set.insert (mkNodeId p.session out)) forestOpen liftEffect $ T2.modify_ (Set.insert (mkNodeId p.session out)) forestOpen
performAction RefreshTree p performAction RefreshTree p
performAction (AddContact params) p@{ tree: (NTree (LNode {id}) _) } = performAction (AddContact params) p@{ tree: (NTree (LNode {id}) _) } =
void $ Contact.contactReq p.session id params void $ Contact.contactReq p.session id params
performAction (AddNode name nodeType) p@{ forestOpen performAction (AddNode name nodeType) p@{ forestOpen
, tree: (NTree (LNode { id }) _) } = do , tree: (NTree (LNode { id }) _) } = do
task <- addNode p.session id $ AddNodeValue {name, nodeType} task <- addNode p.session id $ AddNodeValue {name, nodeType}
_ <- liftEffect $ T.modify (Set.insert (mkNodeId p.session id)) forestOpen liftEffect $ T2.modify_ (Set.insert (mkNodeId p.session id)) forestOpen
performAction RefreshTree p performAction RefreshTree p
performAction (UploadFile nodeType fileType mName blob) p@{ tasks performAction (UploadFile nodeType fileType mName blob) p@{ tasks
, tree: (NTree (LNode { id }) _) } = do , tree: (NTree (LNode { id }) _) } = do
...@@ -230,7 +230,7 @@ performAction (MoveNode {params}) p@{ forestOpen ...@@ -230,7 +230,7 @@ performAction (MoveNode {params}) p@{ forestOpen
, session } = traverse_ f params where , session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do f (SubTreeOut { in: in', out }) = do
void $ moveNodeReq p.session in' out void $ moveNodeReq p.session in' out
_ <- liftEffect $ T.modify (Set.insert (mkNodeId session out)) forestOpen liftEffect $ T2.modify_ (Set.insert (mkNodeId session out)) forestOpen
performAction RefreshTree p performAction RefreshTree p
performAction (MergeNode { params }) p = traverse_ f params where performAction (MergeNode { params }) p = traverse_ f params where
f (SubTreeOut { in: in', out }) = do f (SubTreeOut { in: in', out }) = do
......
...@@ -210,7 +210,7 @@ folderIconCpt = here.component "folderIcon" cpt ...@@ -210,7 +210,7 @@ folderIconCpt = here.component "folderIcon" cpt
where where
cpt { folderOpen, nodeType } _ = do cpt { folderOpen, nodeType } _ = do
open <- T.read folderOpen open <- T.read folderOpen
pure $ H.a { className: "folder-icon", on: { click: \_ -> T.modify not folderOpen } } pure $ H.a { className: "folder-icon", on: { click: \_ -> T2.modify_ not folderOpen } }
[ H.i { className: GT.fldr nodeType open } [] ] [ H.i { className: GT.fldr nodeType open } [] ]
type ChevronIconProps = ( type ChevronIconProps = (
...@@ -231,7 +231,7 @@ chevronIconCpt = here.component "chevronIcon" cpt ...@@ -231,7 +231,7 @@ chevronIconCpt = here.component "chevronIcon" cpt
cpt { folderOpen, handed, isLeaf: false, nodeType } _ = do cpt { folderOpen, handed, isLeaf: false, nodeType } _ = do
open <- T.read folderOpen open <- T.read folderOpen
pure $ H.a { className: "chevron-icon" pure $ H.a { className: "chevron-icon"
, on: { click: \_ -> T.modify not folderOpen } , on: { click: \_ -> T2.modify_ not folderOpen }
} }
[ H.i { className: if open [ H.i { className: if open
then "fa fa-chevron-down" then "fa fa-chevron-down"
......
...@@ -19,6 +19,7 @@ import Gargantext.Sessions (Session, post) ...@@ -19,6 +19,7 @@ import Gargantext.Sessions (Session, post)
import Gargantext.Types (ID) import Gargantext.Types (ID)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Contact" here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Contact"
...@@ -69,7 +70,7 @@ textInputBoxCpt = here.component "textInputBox" cpt where ...@@ -69,7 +70,7 @@ textInputBoxCpt = here.component "textInputBox" cpt where
click _ = do click _ = do
firstname <- T.read first firstname <- T.read first
lastname <- T.read last lastname <- T.read last
_ <- T.write false isOpen T2.write_ false isOpen
launchAff $ launchAff $
dispatch (boxAction $ AddContactParams { firstname, lastname }) dispatch (boxAction $ AddContactParams { firstname, lastname })
cancelBtn = cancelBtn =
...@@ -77,4 +78,4 @@ textInputBoxCpt = here.component "textInputBox" cpt where ...@@ -77,4 +78,4 @@ textInputBoxCpt = here.component "textInputBox" cpt where
{ className: "btn text-danger glyphitem fa fa-remove col-md-2 pull-left" { className: "btn text-danger glyphitem fa fa-remove col-md-2 pull-left"
, on: { click }, title: "Cancel", type: "button" , on: { click }, title: "Cancel", type: "button"
} [] where } [] where
click _ = void $ T.write false isOpen click _ = T2.write_ false isOpen
...@@ -81,7 +81,7 @@ nodePopupCpt = here.component "nodePopupView" cpt where ...@@ -81,7 +81,7 @@ nodePopupCpt = here.component "nodePopupView" cpt where
editIcon _ true = H.div {} [] editIcon _ true = H.div {} []
editIcon isOpen false = editIcon isOpen false =
H.a { className: glyphicon "pencil", id: "rename1" H.a { className: glyphicon "pencil", id: "rename1"
, title : "Rename", on: { click: \_ -> void $ T.write true isOpen } } [] , title : "Rename", on: { click: \_ -> T2.write_ true isOpen } } []
panelBody :: T.Cursor (Maybe NodeAction) -> Record NodePopupProps -> R.Element panelBody :: T.Cursor (Maybe NodeAction) -> Record NodePopupProps -> R.Element
panelBody nodePopupState {dispatch: d, nodeType} = panelBody nodePopupState {dispatch: d, nodeType} =
let (SettingsBox { edit, doc, buttons }) = settingsBox nodeType in let (SettingsBox { edit, doc, buttons }) = settingsBox nodeType in
...@@ -134,7 +134,7 @@ buttonClickCpt = here.component "buttonClick" cpt where ...@@ -134,7 +134,7 @@ buttonClickCpt = here.component "buttonClick" cpt where
action <- T.useLive T.unequal state action <- T.useLive T.unequal state
let className = glyphiconActive (glyphiconNodeAction todo) (action == (Just todo)) let className = glyphiconActive (glyphiconNodeAction todo) (action == (Just todo))
let style = iconAStyle nodeType todo let style = iconAStyle nodeType todo
let click _ = T.write (if action == Just todo then Nothing else Just todo) state let click _ = T2.write_ (if action == Just todo then Nothing else Just todo) state
pure $ H.div { className: "col-1" } pure $ H.div { className: "col-1" }
[ H.a { style, className, id: show todo, title: show todo, on: { click } } [] ] [ H.a { style, className, id: show todo, title: show todo, on: { click } } [] ]
-- | Open the help indications if selected already -- | Open the help indications if selected already
......
...@@ -26,6 +26,7 @@ import Gargantext.Types as GT ...@@ -26,6 +26,7 @@ import Gargantext.Types as GT
import Gargantext.Utils (glyphicon, toggleSet) import Gargantext.Utils (glyphicon, toggleSet)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.ReactTooltip as ReactTooltip import Gargantext.Utils.ReactTooltip as ReactTooltip
import Gargantext.Utils.Toestand as T2
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools" here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools"
...@@ -81,8 +82,8 @@ textInputBoxCpt = here.component "textInputBox" cpt where ...@@ -81,8 +82,8 @@ textInputBoxCpt = here.component "textInputBox" cpt where
, className: "text-danger col-2 " <> glyphicon "times" } [] ] , className: "text-danger col-2 " <> glyphicon "times" } [] ]
submit ref _ = do submit ref _ = do
launchAff_ $ dispatch (boxAction $ R.readRef ref) launchAff_ $ dispatch (boxAction $ R.readRef ref)
void $ T.write false isOpen T2.write_ false isOpen
click _ = void $ T.write false isOpen click _ = T2.write_ false isOpen
type DefaultText = String type DefaultText = String
...@@ -223,7 +224,7 @@ nodeLinkCpt = here.component "nodeLink" cpt where ...@@ -223,7 +224,7 @@ nodeLinkCpt = here.component "nodeLink" cpt where
-- NOTE Don't toggle tree if it is not selected -- NOTE Don't toggle tree if it is not selected
-- click on closed -> open -- click on closed -> open
-- click on open -> ? -- click on open -> ?
click _ = when (not isSelected) (void $ T.write true folderOpen) click _ = when (not isSelected) (T2.write_ true folderOpen)
tooltipId = "node-link-" <> show id tooltipId = "node-link-" <> show id
href = url frontends $ GT.NodePath (sessionId session) nodeType (Just id) href = url frontends $ GT.NodePath (sessionId session) nodeType (Just id)
......
...@@ -4,17 +4,20 @@ module Gargantext.Components.Graph ...@@ -4,17 +4,20 @@ module Gargantext.Components.Graph
-- , forceAtlas2Settings, ForceAtlas2Settings, ForceAtlas2OptionalSettings -- , forceAtlas2Settings, ForceAtlas2Settings, ForceAtlas2OptionalSettings
-- ) -- )
where where
import Prelude (bind, const, discard, not, pure, unit, ($))
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable) import Data.Nullable (Nullable)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log, log2) import DOM.Simple.Console (log, log2)
import DOM.Simple.Types (Element) import DOM.Simple.Types (Element)
import FFI.Simple (delay) 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 Record as Record
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Hooks.Sigmax as Sigmax import Gargantext.Hooks.Sigmax as Sigmax
...@@ -22,40 +25,58 @@ import Gargantext.Hooks.Sigmax.Types as SigmaxTypes ...@@ -22,40 +25,58 @@ import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Hooks.Sigmax.Sigma as Sigma import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Graph" here = R2.here "Gargantext.Components.Graph"
type OnProps = () type OnProps = ()
data Stage = Init | Ready | Cleanup data Stage = Init | Ready | Cleanup
derive instance genericStage :: Generic Stage _
derive instance eqStage :: Eq Stage
type Props sigma forceatlas2 = ( type Props sigma forceatlas2 = (
elRef :: R.Ref (Nullable Element) elRef :: R.Ref (Nullable Element)
, forceAtlas2Settings :: forceatlas2 , forceAtlas2Settings :: forceatlas2
, graph :: SigmaxTypes.SGraph , graph :: SigmaxTypes.SGraph
, mCamera :: Maybe GET.Camera , mCamera :: Maybe GET.Camera
, multiSelectEnabledRef :: R.Ref Boolean , multiSelectEnabledRef :: R.Ref Boolean
, selectedNodeIds :: R.State SigmaxTypes.NodeIds , selectedNodeIds :: T.Cursor SigmaxTypes.NodeIds
, showEdges :: R.State SigmaxTypes.ShowEdgesState , showEdges :: T.Cursor SigmaxTypes.ShowEdgesState
, sigmaRef :: R.Ref Sigmax.Sigma , sigmaRef :: R.Ref Sigmax.Sigma
, sigmaSettings :: sigma , sigmaSettings :: sigma
, stage :: R.State Stage , stage :: T.Cursor Stage
, startForceAtlas :: Boolean , startForceAtlas :: Boolean
, transformedGraph :: SigmaxTypes.SGraph , transformedGraph :: SigmaxTypes.SGraph
) )
graph :: forall s fa2. Record (Props s fa2) -> R.Element graph :: forall s fa2. R2.Component (Props s fa2)
graph props = R.createElement graphCpt props [] graph = R.createElement graphCpt
graphCpt :: forall s fa2. R.Component (Props s fa2) graphCpt :: forall s fa2. R.Component (Props s fa2)
graphCpt = here.component "graph" cpt graphCpt = here.component "graph" cpt
where where
cpt props _ = do cpt props@{ elRef
stageHooks props , forceAtlas2Settings
, graph
, mCamera
, multiSelectEnabledRef
, selectedNodeIds
, showEdges
, sigmaRef
, sigmaSettings
, stage
, startForceAtlas
, transformedGraph } _ = do
showEdges' <- T.useLive T.unequal showEdges
stage' <- T.useLive T.unequal stage
stageHooks (Record.merge { showEdges', stage' } props)
R.useEffectOnce $ do R.useEffectOnce $ do
pure $ do pure $ do
log "[graphCpt (Cleanup)]" log "[graphCpt (Cleanup)]"
Sigmax.dependOnSigma (R.readRef props.sigmaRef) "[graphCpt (Cleanup)] no sigma" $ \sigma -> do Sigmax.dependOnSigma (R.readRef sigmaRef) "[graphCpt (Cleanup)] no sigma" $ \sigma -> do
Sigma.stopForceAtlas2 sigma Sigma.stopForceAtlas2 sigma
log2 "[graphCpt (Cleanup)] forceAtlas stopped for" sigma log2 "[graphCpt (Cleanup)] forceAtlas stopped for" sigma
Sigma.kill sigma Sigma.kill sigma
...@@ -63,24 +84,32 @@ graphCpt = here.component "graph" cpt ...@@ -63,24 +84,32 @@ graphCpt = here.component "graph" cpt
-- NOTE: This div is not empty after sigma initializes. -- NOTE: This div is not empty after sigma initializes.
-- When we change state, we make it empty though. -- When we change state, we make it empty though.
--pure $ RH.div { ref: props.elRef, style: {height: "95%"} } [] --pure $ RH.div { ref: elRef, style: {height: "95%"} } []
pure $ case R.readNullableRef props.elRef of pure $ case R.readNullableRef elRef of
Nothing -> RH.div {} [] Nothing -> RH.div {} []
Just el -> R.createPortal [] el Just el -> R.createPortal [] el
stageHooks props@{multiSelectEnabledRef, selectedNodeIds, sigmaRef, stage: (Init /\ setStage)} = do stageHooks { elRef
, graph
, mCamera
, multiSelectEnabledRef
, selectedNodeIds
, sigmaRef
, stage
, stage': Init
, startForceAtlas } = do
R.useEffectOnce' $ do R.useEffectOnce' $ do
let rSigma = R.readRef props.sigmaRef let rSigma = R.readRef sigmaRef
case Sigmax.readSigma rSigma of case Sigmax.readSigma rSigma of
Nothing -> do Nothing -> do
eSigma <- Sigma.sigma {settings: props.sigmaSettings} eSigma <- Sigma.sigma {settings: sigmaSettings}
case eSigma of case eSigma of
Left err -> log2 "[graphCpt] error creating sigma" err Left err -> log2 "[graphCpt] error creating sigma" err
Right sig -> do Right sig -> do
Sigmax.writeSigma rSigma $ Just sig Sigmax.writeSigma rSigma $ Just sig
Sigmax.dependOnContainer props.elRef "[graphCpt (Ready)] container not found" $ \c -> do Sigmax.dependOnContainer elRef "[graphCpt (Ready)] container not found" $ \c -> do
_ <- Sigma.addRenderer sig { _ <- Sigma.addRenderer sig {
"type": "canvas" "type": "canvas"
, container: c , container: c
...@@ -88,7 +117,7 @@ graphCpt = here.component "graph" cpt ...@@ -88,7 +117,7 @@ graphCpt = here.component "graph" cpt
} }
pure unit pure unit
Sigmax.refreshData sig $ Sigmax.sigmafy props.graph Sigmax.refreshData sig $ Sigmax.sigmafy graph
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
...@@ -98,13 +127,13 @@ graphCpt = here.component "graph" cpt ...@@ -98,13 +127,13 @@ graphCpt = here.component "graph" cpt
Sigmax.setEdges sig false Sigmax.setEdges sig false
-- log2 "[graph] startForceAtlas" props.startForceAtlas -- log2 "[graph] startForceAtlas" startForceAtlas
if props.startForceAtlas then if startForceAtlas then
Sigma.startForceAtlas2 sig props.forceAtlas2Settings Sigma.startForceAtlas2 sig forceAtlas2Settings
else else
Sigma.stopForceAtlas2 sig Sigma.stopForceAtlas2 sig
case props.mCamera of case mCamera of
Nothing -> pure unit Nothing -> pure unit
Just (GET.Camera { ratio, x, y }) -> do Just (GET.Camera { ratio, x, y }) -> do
Sigma.updateCamera sig { ratio, x, y } Sigma.updateCamera sig { ratio, x, y }
...@@ -113,9 +142,12 @@ graphCpt = here.component "graph" cpt ...@@ -113,9 +142,12 @@ graphCpt = here.component "graph" cpt
Just sig -> do Just sig -> do
pure unit pure unit
setStage $ const Ready T.write Ready stage
stageHooks props@{ showEdges: (showEdges /\ _), sigmaRef, stage: (Ready /\ setStage), transformedGraph } = do stageHooks { showEdges'
, sigmaRef
, stage': Ready
, transformedGraph } = do
let tEdgesMap = SigmaxTypes.edgesGraphMap transformedGraph let tEdgesMap = SigmaxTypes.edgesGraphMap transformedGraph
let tNodesMap = SigmaxTypes.nodesGraphMap transformedGraph let tNodesMap = SigmaxTypes.nodesGraphMap transformedGraph
...@@ -125,7 +157,7 @@ graphCpt = here.component "graph" cpt ...@@ -125,7 +157,7 @@ graphCpt = here.component "graph" cpt
Sigmax.performDiff sigma transformedGraph Sigmax.performDiff sigma transformedGraph
Sigmax.updateEdges sigma tEdgesMap Sigmax.updateEdges sigma tEdgesMap
Sigmax.updateNodes sigma tNodesMap Sigmax.updateNodes sigma tNodesMap
Sigmax.setEdges sigma (not $ SigmaxTypes.edgeStateHidden showEdges) Sigmax.setEdges sigma (not $ SigmaxTypes.edgeStateHidden showEdges')
stageHooks _ = pure unit stageHooks _ = pure unit
......
...@@ -11,7 +11,7 @@ import Data.Maybe (Maybe(..), fromJust, maybe) ...@@ -11,7 +11,7 @@ import Data.Maybe (Maybe(..), fromJust, maybe)
import Data.Nullable (null, Nullable) import Data.Nullable (null, Nullable)
import Data.Sequence as Seq import Data.Sequence as Seq
import Data.Set as Set import Data.Set as Set
import Data.Tuple (fst, snd, Tuple(..)) import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Math (log) import Math (log)
...@@ -126,10 +126,12 @@ explorerCpt = here.component "explorer" cpt ...@@ -126,10 +126,12 @@ explorerCpt = here.component "explorer" cpt
, graph , graph
, graphId , graphId
, hyperdataGraph , hyperdataGraph
, session
, reloadForest: \_ -> GUR.bumpCursor reloadForest , reloadForest: \_ -> GUR.bumpCursor reloadForest
, session
} }
multiSelectEnabledRef <- R.useRef $ fst controls.multiSelectEnabled multiSelectEnabled' <- T.useLive T.unequal controls.multiSelectEnabled
showTree' <- T.useLive T.unequal controls.showTree
multiSelectEnabledRef <- R.useRef multiSelectEnabled'
forestOpen <- T2.useCursed $ Set.empty forestOpen <- T2.useCursed $ Set.empty
...@@ -145,21 +147,21 @@ explorerCpt = here.component "explorer" cpt ...@@ -145,21 +147,21 @@ explorerCpt = here.component "explorer" cpt
R.setRef dataRef graph R.setRef dataRef graph
R.setRef graphVersionRef (GUR.value graphVersion) R.setRef graphVersionRef (GUR.value graphVersion)
-- Reinitialize bunch of state as well. -- Reinitialize bunch of state as well.
snd controls.removedNodeIds $ const SigmaxT.emptyNodeIds T2.write_ SigmaxT.emptyNodeIds controls.removedNodeIds
snd controls.selectedNodeIds $ const SigmaxT.emptyNodeIds T2.write_ SigmaxT.emptyNodeIds controls.selectedNodeIds
snd controls.showEdges $ const SigmaxT.EShow T2.write_ SigmaxT.EShow controls.showEdges
snd controls.forceAtlasState $ const forceAtlasS T2.write_ forceAtlasS controls.forceAtlasState
snd controls.graphStage $ const Graph.Init T2.write_ Graph.Init controls.graphStage
snd controls.showSidePanel $ const GET.InitialClosed T2.write_ GET.InitialClosed controls.showSidePanel
pure $ pure $
RH.div { className: "graph-meta-container" } [ RH.div { className: "graph-meta-container" } [
RH.div { className: "fixed-top navbar navbar-expand-lg" RH.div { className: "fixed-top navbar navbar-expand-lg"
, id: "graph-explorer" } , id: "graph-explorer" }
[ rowToggle [ rowToggle
[ col [ spaces [ Toggle.treeToggleButton controls.showTree ]] [ col [ spaces [ Toggle.treeToggleButton { state: controls.showTree } [] ]]
, col [ spaces [ Toggle.controlsToggleButton controls.showControls ]] , col [ spaces [ Toggle.controlsToggleButton { state: controls.showControls } [] ]]
, col [ spaces [ Toggle.sidebarToggleButton controls.showSidePanel ]] , col [ spaces [ Toggle.sidebarToggleButton { state: controls.showSidePanel } [] ]]
] ]
] ]
, RH.div { className: "graph-container" } [ , RH.div { className: "graph-container" } [
...@@ -174,7 +176,7 @@ explorerCpt = here.component "explorer" cpt ...@@ -174,7 +176,7 @@ explorerCpt = here.component "explorer" cpt
, route , route
, reloadForest , reloadForest
, sessions , sessions
, show: fst controls.showTree , show: showTree'
, showLogin: showLogin , showLogin: showLogin
, tasks , tasks
} }
...@@ -267,10 +269,10 @@ type MSidebarProps = ...@@ -267,10 +269,10 @@ type MSidebarProps =
, graphId :: GET.GraphId , graphId :: GET.GraphId
, graphVersion :: GUR.ReloadS , graphVersion :: GUR.ReloadS
, reloadForest :: T.Cursor T2.Reload , reloadForest :: T.Cursor T2.Reload
, removedNodeIds :: R.State SigmaxT.NodeIds , removedNodeIds :: T.Cursor SigmaxT.NodeIds
, selectedNodeIds :: R.State SigmaxT.NodeIds , selectedNodeIds :: T.Cursor SigmaxT.NodeIds
, session :: Session , session :: Session
, showSidePanel :: R.State GET.SidePanelState , showSidePanel :: T.Cursor GET.SidePanelState
) )
type GraphProps = ( type GraphProps = (
...@@ -297,19 +299,33 @@ graphViewCpt = here.component "graphView" cpt ...@@ -297,19 +299,33 @@ graphViewCpt = here.component "graphView" cpt
, hyperdataGraph: GET.HyperdataGraph { mCamera } , hyperdataGraph: GET.HyperdataGraph { mCamera }
, mMetaData , mMetaData
, multiSelectEnabledRef } _children = do , multiSelectEnabledRef } _children = do
edgeConfluence' <- T.useLive T.unequal controls.edgeConfluence
edgeWeight' <- T.useLive T.unequal controls.edgeWeight
multiSelectEnabled' <- T.useLive T.unequal controls.multiSelectEnabled
nodeSize' <- T.useLive T.unequal controls.nodeSize
removedNodeIds' <- T.useLive T.unequal controls.removedNodeIds
selectedNodeIds' <- T.useLive T.unequal controls.selectedNodeIds
showEdges' <- T.useLive T.unequal controls.showEdges
showLouvain' <- T.useLive T.unequal controls.showLouvain
-- TODO Cache this? -- TODO Cache this?
let louvainGraph = let louvainGraph =
if (fst controls.showLouvain) then if showLouvain' then
let louvain = Louvain.louvain unit in let louvain = Louvain.louvain unit in
let cluster = Louvain.init louvain (SigmaxT.louvainNodes graph) (SigmaxT.louvainEdges graph) in let cluster = Louvain.init louvain (SigmaxT.louvainNodes graph) (SigmaxT.louvainEdges graph) in
SigmaxT.louvainGraph graph cluster SigmaxT.louvainGraph graph cluster
else else
graph graph
let transformedGraph = transformGraph controls louvainGraph let transformedGraph = transformGraph louvainGraph { edgeConfluence'
, edgeWeight'
, nodeSize'
, removedNodeIds'
, selectedNodeIds'
, showEdges' }
let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas }) -> startForceAtlas) mMetaData let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas }) -> startForceAtlas) mMetaData
R.useEffect1' (fst controls.multiSelectEnabled) $ do R.useEffect1' multiSelectEnabled' $ do
R.setRef multiSelectEnabledRef $ fst controls.multiSelectEnabled R.setRef multiSelectEnabledRef multiSelectEnabled'
pure $ Graph.graph { elRef pure $ Graph.graph { elRef
, forceAtlas2Settings: Graph.forceAtlas2Settings , forceAtlas2Settings: Graph.forceAtlas2Settings
...@@ -323,7 +339,7 @@ graphViewCpt = here.component "graphView" cpt ...@@ -323,7 +339,7 @@ graphViewCpt = here.component "graphView" cpt
, 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}
...@@ -384,17 +400,30 @@ getNodes session graphVersion graphId = ...@@ -384,17 +400,30 @@ getNodes session graphVersion graphId =
(Just graphId) (Just graphId)
("?version=" <> (show $ GUR.value graphVersion)) ("?version=" <> (show $ GUR.value graphVersion))
type LiveProps = (
edgeConfluence' :: Range.NumberRange
, edgeWeight' :: Range.NumberRange
, nodeSize' :: Range.NumberRange
, removedNodeIds' :: SigmaxT.NodeIds
, selectedNodeIds' :: SigmaxT.NodeIds
, showEdges' :: SigmaxT.ShowEdgesState
)
transformGraph :: Record Controls.Controls -> SigmaxT.SGraph -> SigmaxT.SGraph transformGraph :: SigmaxT.SGraph -> Record LiveProps -> SigmaxT.SGraph
transformGraph controls graph = SigmaxT.Graph {nodes: newNodes, edges: newEdges} transformGraph graph { edgeConfluence'
, edgeWeight'
, nodeSize'
, removedNodeIds'
, selectedNodeIds'
, showEdges' } = SigmaxT.Graph {nodes: newNodes, edges: newEdges}
where where
edges = SigmaxT.graphEdges graph edges = SigmaxT.graphEdges graph
nodes = SigmaxT.graphNodes graph nodes = SigmaxT.graphNodes graph
selectedEdgeIds = selectedEdgeIds =
Set.fromFoldable Set.fromFoldable
$ Seq.map _.id $ Seq.map _.id
$ SigmaxT.neighbouringEdges graph (fst controls.selectedNodeIds) $ SigmaxT.neighbouringEdges graph selectedNodeIds'
hasSelection = not $ Set.isEmpty (fst controls.selectedNodeIds) hasSelection = not $ Set.isEmpty selectedNodeIds'
newEdges' = Seq.filter edgeFilter $ Seq.map ( newEdges' = Seq.filter edgeFilter $ Seq.map (
edgeHideWeight <<< edgeHideConfluence <<< edgeShowFilter <<< edgeMarked edgeHideWeight <<< edgeHideConfluence <<< edgeShowFilter <<< edgeMarked
...@@ -406,32 +435,32 @@ transformGraph controls graph = SigmaxT.Graph {nodes: newNodes, edges: newEdges} ...@@ -406,32 +435,32 @@ transformGraph controls graph = SigmaxT.Graph {nodes: newNodes, edges: newEdges}
nodeFilter n = nodeRemovedFilter n nodeFilter n = nodeRemovedFilter n
nodeSizeFilter :: Record SigmaxT.Node -> Boolean nodeSizeFilter :: Record SigmaxT.Node -> Boolean
nodeSizeFilter node@{ size } = Range.within (fst controls.nodeSize) size nodeSizeFilter node@{ size } = Range.within nodeSize' size
nodeRemovedFilter node@{ id } = not $ Set.member id $ fst controls.removedNodeIds nodeRemovedFilter node@{ id } = not $ Set.member id removedNodeIds'
edgeConfluenceFilter :: Record SigmaxT.Edge -> Boolean edgeConfluenceFilter :: Record SigmaxT.Edge -> Boolean
edgeConfluenceFilter edge@{ confluence } = Range.within (fst controls.edgeConfluence) confluence edgeConfluenceFilter edge@{ confluence } = Range.within edgeConfluence' confluence
edgeWeightFilter :: Record SigmaxT.Edge -> Boolean edgeWeightFilter :: Record SigmaxT.Edge -> Boolean
edgeWeightFilter edge@{ weightIdx } = Range.within (fst controls.edgeWeight) $ toNumber weightIdx edgeWeightFilter edge@{ weightIdx } = Range.within edgeWeight' $ toNumber weightIdx
edgeHideConfluence :: Record SigmaxT.Edge -> Record SigmaxT.Edge edgeHideConfluence :: Record SigmaxT.Edge -> Record SigmaxT.Edge
edgeHideConfluence edge@{ confluence } = edgeHideConfluence edge@{ confluence } =
if Range.within (fst controls.edgeConfluence) confluence then if Range.within edgeConfluence' confluence then
edge edge
else else
edge { hidden = true } edge { hidden = true }
edgeHideWeight :: Record SigmaxT.Edge -> Record SigmaxT.Edge edgeHideWeight :: Record SigmaxT.Edge -> Record SigmaxT.Edge
edgeHideWeight edge@{ weightIdx } = edgeHideWeight edge@{ weightIdx } =
if Range.within (fst controls.edgeWeight) $ toNumber weightIdx then if Range.within edgeWeight' $ toNumber weightIdx then
edge edge
else else
edge { hidden = true } edge { hidden = true }
edgeShowFilter :: Record SigmaxT.Edge -> Record SigmaxT.Edge edgeShowFilter :: Record SigmaxT.Edge -> Record SigmaxT.Edge
edgeShowFilter edge = edgeShowFilter edge =
if (SigmaxT.edgeStateHidden $ fst controls.showEdges) then if SigmaxT.edgeStateHidden showEdges' then
edge { hidden = true } edge { hidden = true }
else else
edge edge
...@@ -450,14 +479,14 @@ transformGraph controls graph = SigmaxT.Graph {nodes: newNodes, edges: newEdges} ...@@ -450,14 +479,14 @@ transformGraph controls graph = SigmaxT.Graph {nodes: newNodes, edges: newEdges}
nodeMarked :: Record SigmaxT.Node -> Record SigmaxT.Node nodeMarked :: Record SigmaxT.Node -> Record SigmaxT.Node
nodeMarked node@{ id } = nodeMarked node@{ id } =
if Set.member id (fst controls.selectedNodeIds) then if Set.member id selectedNodeIds' then
node { borderColor = "#000", type = "selected" } node { borderColor = "#000", type = "selected" }
else else
node node
nodeHideSize :: Record SigmaxT.Node -> Record SigmaxT.Node nodeHideSize :: Record SigmaxT.Node -> Record SigmaxT.Node
nodeHideSize node@{ size } = nodeHideSize node@{ size } =
if Range.within (fst controls.nodeSize) size then if Range.within nodeSize' size then
node node
else else
node { hidden = true } node { hidden = true }
...@@ -3,8 +3,8 @@ module Gargantext.Components.GraphExplorer.Controls ...@@ -3,8 +3,8 @@ module Gargantext.Components.GraphExplorer.Controls
, useGraphControls , useGraphControls
, controls , controls
, controlsCpt , controlsCpt
, getShowTree, setShowTree , setShowTree
, getShowControls, setShowControls , setShowControls
) where ) where
import Data.Array as A import Data.Array as A
...@@ -81,7 +81,30 @@ controls props = R.createElement controlsCpt props [] ...@@ -81,7 +81,30 @@ controls props = R.createElement controlsCpt props []
controlsCpt :: R.Component Controls controlsCpt :: R.Component Controls
controlsCpt = here.component "controls" cpt controlsCpt = here.component "controls" cpt
where where
cpt props _ = do cpt { edgeConfluence
, edgeWeight
, forceAtlasState
, graph
, graphId
, graphStage
, hyperdataGraph
, multiSelectEnabled
, nodeSize
, reloadForest
, selectedNodeIds
, session
, showControls
, showEdges
, showLouvain
, showSidePanel
, showTree
, sigmaRef } _ = do
forceAtlasState' <- T.useLive T.unequal forceAtlasState
graphStage' <- T.useLive T.unequal graphStage
selectedNodeIds' <- T.useLive T.unequal selectedNodeIds
showControls' <- T.useLive T.unequal showControls
showSidePanel' <- T.useLive T.unequal showSidePanel
localControls <- initialLocalControls localControls <- initialLocalControls
-- ref to track automatic FA pausing -- ref to track automatic FA pausing
-- If user pauses FA before auto is triggered, clear the timeoutId -- If user pauses FA before auto is triggered, clear the timeoutId
...@@ -90,32 +113,32 @@ controlsCpt = here.component "controls" cpt ...@@ -90,32 +113,32 @@ controlsCpt = here.component "controls" cpt
-- When graph is changed, cleanup the mFAPauseRef so that forceAtlas -- When graph is changed, cleanup the mFAPauseRef so that forceAtlas
-- timeout is retriggered. -- timeout is retriggered.
R.useEffect' $ do R.useEffect' $ do
case fst props.graphStage of case graphStage' of
Graph.Init -> R.setRef mFAPauseRef Nothing Graph.Init -> R.setRef mFAPauseRef Nothing
_ -> pure unit _ -> pure unit
-- Handle case when FA is paused from outside events, eg. the automatic timer. -- Handle case when FA is paused from outside events, eg. the automatic timer.
R.useEffect' $ Sigmax.handleForceAtlas2Pause props.sigmaRef props.forceAtlasState mFAPauseRef R.useEffect' $ Sigmax.handleForceAtlas2Pause sigmaRef forceAtlasState mFAPauseRef
-- Handle automatic edge hiding when FA is running (to prevent flickering). -- Handle automatic edge hiding when FA is running (to prevent flickering).
R.useEffect2' props.sigmaRef props.forceAtlasState $ R.useEffect2' sigmaRef forceAtlasState' $ do
snd props.showEdges $ SigmaxT.forceAtlasEdgeState (fst props.forceAtlasState) T2.modify_ (SigmaxT.forceAtlasEdgeState forceAtlasState') showEdges
-- Automatic opening of sidebar when a node is selected (but only first time). -- Automatic opening of sidebar when a node is selected (but only first time).
R.useEffect' $ do R.useEffect' $ do
if fst props.showSidePanel == GET.InitialClosed && (not Set.isEmpty $ fst props.selectedNodeIds) then if showSidePanel' == GET.InitialClosed && (not Set.isEmpty selectedNodeIds') then
snd props.showSidePanel $ \_ -> GET.Opened GET.SideTabData T2.write_ (GET.Opened GET.SideTabData) showSidePanel
else else
pure unit pure unit
-- Timer to turn off the initial FA. This is because FA eats up lot of -- Timer to turn off the initial FA. This is because FA eats up lot of
-- CPU, has memory leaks etc. -- CPU, has memory leaks etc.
R.useEffect1' (fst props.forceAtlasState) $ do R.useEffect1' forceAtlasState' $ do
if (fst props.forceAtlasState) == SigmaxT.InitialRunning then do if forceAtlasState' == SigmaxT.InitialRunning then do
timeoutId <- setTimeout 9000 $ do timeoutId <- setTimeout 9000 $ do
let (toggled /\ setToggled) = props.forceAtlasState case forceAtlasState' of
case toggled of SigmaxT.InitialRunning ->
SigmaxT.InitialRunning -> setToggled $ const SigmaxT.Paused T2.write_ SigmaxT.Paused forceAtlasState
_ -> pure unit _ -> pure unit
R.setRef mFAPauseRef Nothing R.setRef mFAPauseRef Nothing
R.setRef mFAPauseRef $ Just timeoutId R.setRef mFAPauseRef $ Just timeoutId
...@@ -123,83 +146,87 @@ controlsCpt = here.component "controls" cpt ...@@ -123,83 +146,87 @@ controlsCpt = here.component "controls" cpt
else else
pure unit pure unit
let edgesConfluenceSorted = A.sortWith (_.confluence) $ Seq.toUnfoldable $ SigmaxT.graphEdges props.graph let edgesConfluenceSorted = A.sortWith (_.confluence) $ Seq.toUnfoldable $ SigmaxT.graphEdges graph
let edgeConfluenceMin = maybe 0.0 _.confluence $ A.head edgesConfluenceSorted let edgeConfluenceMin = maybe 0.0 _.confluence $ A.head edgesConfluenceSorted
let edgeConfluenceMax = maybe 100.0 _.confluence $ A.last edgesConfluenceSorted let edgeConfluenceMax = maybe 100.0 _.confluence $ A.last edgesConfluenceSorted
let edgeConfluenceRange = Range.Closed { min: edgeConfluenceMin, max: edgeConfluenceMax } let edgeConfluenceRange = Range.Closed { min: edgeConfluenceMin, max: edgeConfluenceMax }
--let edgesWeightSorted = A.sortWith (_.weight) $ Seq.toUnfoldable $ SigmaxT.graphEdges props.graph --let edgesWeightSorted = A.sortWith (_.weight) $ Seq.toUnfoldable $ SigmaxT.graphEdges graph
--let edgeWeightMin = maybe 0.0 _.weight $ A.head edgesWeightSorted --let edgeWeightMin = maybe 0.0 _.weight $ A.head edgesWeightSorted
--let edgeWeightMax = maybe 100.0 _.weight $ A.last edgesWeightSorted --let edgeWeightMax = maybe 100.0 _.weight $ A.last edgesWeightSorted
--let edgeWeightRange = Range.Closed { min: edgeWeightMin, max: edgeWeightMax } --let edgeWeightRange = Range.Closed { min: edgeWeightMin, max: edgeWeightMax }
let edgeWeightRange = Range.Closed { let edgeWeightRange = Range.Closed {
min: 0.0 min: 0.0
, max: I.toNumber $ Seq.length $ SigmaxT.graphEdges props.graph , max: I.toNumber $ Seq.length $ SigmaxT.graphEdges graph
} }
let nodesSorted = A.sortWith (_.size) $ Seq.toUnfoldable $ SigmaxT.graphNodes props.graph let nodesSorted = A.sortWith (_.size) $ Seq.toUnfoldable $ SigmaxT.graphNodes graph
let nodeSizeMin = maybe 0.0 _.size $ A.head nodesSorted let nodeSizeMin = maybe 0.0 _.size $ A.head nodesSorted
let nodeSizeMax = maybe 100.0 _.size $ A.last nodesSorted let nodeSizeMax = maybe 100.0 _.size $ A.last nodesSorted
let nodeSizeRange = Range.Closed { min: nodeSizeMin, max: nodeSizeMax } let nodeSizeRange = Range.Closed { min: nodeSizeMin, max: nodeSizeMax }
pure $ case getShowControls props of pure $ case showControls' of
false -> RH.div {} [] false -> RH.div {} []
-- true -> R2.menu { id: "toolbar" } [ -- true -> R2.menu { id: "toolbar" } [
true -> RH.nav { className: "navbar navbar-expand-lg" } true -> RH.nav { className: "navbar navbar-expand-lg" }
[ RH.ul { className: "navbar-nav mx-auto" } [ -- change type button (?) [ RH.ul { className: "navbar-nav mx-auto" } [ -- change type button (?)
RH.li { className: "nav-item" } [ centerButton props.sigmaRef ] RH.li { className: "nav-item" } [ centerButton sigmaRef ]
, RH.li { className: "nav-item" } [ pauseForceAtlasButton {state: props.forceAtlasState} ] , RH.li { className: "nav-item" } [ pauseForceAtlasButton { state: forceAtlasState } [] ]
, RH.li { className: "nav-item" } [ edgesToggleButton {state: props.showEdges} ] , RH.li { className: "nav-item" } [ edgesToggleButton { state: showEdges } [] ]
, RH.li { className: "nav-item" } [ louvainToggleButton props.showLouvain ] , RH.li { className: "nav-item" } [ louvainToggleButton { state: showLouvain } [] ]
, RH.li { className: "nav-item" } [ edgeConfluenceControl edgeConfluenceRange props.edgeConfluence ] , RH.li { className: "nav-item" } [ edgeConfluenceControl { range: edgeConfluenceRange
, RH.li { className: "nav-item" } [ edgeWeightControl edgeWeightRange props.edgeWeight ] , state: edgeConfluence } [] ]
, RH.li { className: "nav-item" } [ edgeWeightControl { range: edgeWeightRange
, state: edgeWeight } [] ]
-- change level -- change level
-- file upload -- file upload
-- run demo -- run demo
-- search button -- search button
-- search topics -- search topics
, RH.li { className: "nav-item" } [ labelSizeButton props.sigmaRef localControls.labelSize ] -- labels size: 1-4 , RH.li { className: "nav-item" } [ labelSizeButton sigmaRef localControls.labelSize ] -- labels size: 1-4
, RH.li { className: "nav-item" } [ nodeSizeControl nodeSizeRange props.nodeSize ] , RH.li { className: "nav-item" } [ nodeSizeControl { range: nodeSizeRange
, state: nodeSize } [] ]
-- zoom: 0 -100 - calculate ratio -- zoom: 0 -100 - calculate ratio
, RH.li { className: "nav-item" } [ multiSelectEnabledButton props.multiSelectEnabled ] -- toggle multi node selection , RH.li { className: "nav-item" } [ multiSelectEnabledButton { state: multiSelectEnabled } [] ] -- toggle multi node selection
-- save button -- save button
, RH.li { className: "nav-item" } [ nodeSearchControl { graph: props.graph , RH.li { className: "nav-item" }
, multiSelectEnabled: props.multiSelectEnabled [ nodeSearchControl { graph: graph
, selectedNodeIds: props.selectedNodeIds } ] , multiSelectEnabled: multiSelectEnabled
, RH.li { className: "nav-item" } [ mouseSelectorSizeButton props.sigmaRef localControls.mouseSelectorSize ] , selectedNodeIds: selectedNodeIds } [] ]
, RH.li { className: "nav-item" } [ cameraButton { id: props.graphId , RH.li { className: "nav-item" } [ mouseSelectorSizeButton sigmaRef localControls.mouseSelectorSize ]
, hyperdataGraph: props.hyperdataGraph , RH.li { className: "nav-item" } [ cameraButton { id: graphId
, session: props.session , hyperdataGraph: hyperdataGraph
, sigmaRef: props.sigmaRef , session: session
, reloadForest: props.reloadForest } ] , sigmaRef: sigmaRef
, reloadForest: reloadForest } ]
] ]
] ]
-- RH.ul {} [ -- change type button (?) -- RH.ul {} [ -- change type button (?)
-- RH.li {} [ centerButton props.sigmaRef ] -- RH.li {} [ centerButton sigmaRef ]
-- , RH.li {} [ pauseForceAtlasButton {state: props.forceAtlasState} ] -- , RH.li {} [ pauseForceAtlasButton {state: forceAtlasState} ]
-- , RH.li {} [ edgesToggleButton {state: props.showEdges} ] -- , RH.li {} [ edgesToggleButton {state: showEdges} ]
-- , RH.li {} [ louvainToggleButton props.showLouvain ] -- , RH.li {} [ louvainToggleButton showLouvain ]
-- , RH.li {} [ edgeConfluenceControl edgeConfluenceRange props.edgeConfluence ] -- , RH.li {} [ edgeConfluenceControl edgeConfluenceRange edgeConfluence ]
-- , RH.li {} [ edgeWeightControl edgeWeightRange props.edgeWeight ] -- , RH.li {} [ edgeWeightControl edgeWeightRange edgeWeight ]
-- -- change level -- -- change level
-- -- file upload -- -- file upload
-- -- run demo -- -- run demo
-- -- search button -- -- search button
-- -- search topics -- -- search topics
-- , RH.li {} [ labelSizeButton props.sigmaRef localControls.labelSize ] -- labels size: 1-4 -- , RH.li {} [ labelSizeButton sigmaRef localControls.labelSize ] -- labels size: 1-4
-- , RH.li {} [ nodeSizeControl nodeSizeRange props.nodeSize ] -- , RH.li {} [ nodeSizeControl nodeSizeRange nodeSize ]
-- -- zoom: 0 -100 - calculate ratio -- -- zoom: 0 -100 - calculate ratio
-- , RH.li {} [ multiSelectEnabledButton props.multiSelectEnabled ] -- toggle multi node selection -- , RH.li {} [ multiSelectEnabledButton multiSelectEnabled ] -- toggle multi node selection
-- -- save button -- -- save button
-- , RH.li {} [ nodeSearchControl { graph: props.graph -- , RH.li {} [ nodeSearchControl { graph: graph
-- , multiSelectEnabled: props.multiSelectEnabled -- , multiSelectEnabled: multiSelectEnabled
-- , selectedNodeIds: props.selectedNodeIds } ] -- , selectedNodeIds: selectedNodeIds } ]
-- , RH.li {} [ mouseSelectorSizeButton props.sigmaRef localControls.mouseSelectorSize ] -- , RH.li {} [ mouseSelectorSizeButton sigmaRef localControls.mouseSelectorSize ]
-- , RH.li {} [ cameraButton { id: props.graphId -- , RH.li {} [ cameraButton { id: graphId
-- , hyperdataGraph: props.hyperdataGraph -- , hyperdataGraph: hyperdataGraph
-- , session: props.session -- , session: session
-- , sigmaRef: props.sigmaRef -- , sigmaRef: sigmaRef
-- , reloadForest: props.reloadForest } ] -- , reloadForest: reloadForest } ]
-- ] -- ]
-- ] -- ]
...@@ -256,14 +283,8 @@ useGraphControls { forceAtlasS ...@@ -256,14 +283,8 @@ useGraphControls { forceAtlasS
, reloadForest , reloadForest
} }
getShowControls :: Record Controls -> Boolean
getShowControls { showControls: ( should /\ _ ) } = should
getShowTree :: Record Controls -> Boolean
getShowTree { showTree: ( should /\ _ ) } = should
setShowControls :: Record Controls -> Boolean -> Effect Unit setShowControls :: Record Controls -> Boolean -> Effect Unit
setShowControls { showControls: ( _ /\ set ) } v = set $ const v setShowControls { showControls } v = T2.write_ v showControls
setShowTree :: Record Controls -> Boolean -> Effect Unit setShowTree :: Record Controls -> Boolean -> Effect Unit
setShowTree { showTree: ( _ /\ set ) } v = set $ not <<< const v setShowTree { showTree } v = T2.write_ (not v) showTree
...@@ -10,11 +10,14 @@ import Prelude ...@@ -10,11 +10,14 @@ import Prelude
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.RangeSlider as RS import Gargantext.Components.RangeSlider as RS
import Gargantext.Utils.Range as Range import Gargantext.Utils.Range as Range
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.RangeControl" here = R2.here "Gargantext.Components.GraphExplorer.RangeControl"
type Props = ( type Props = (
...@@ -22,8 +25,8 @@ type Props = ( ...@@ -22,8 +25,8 @@ type Props = (
, sliderProps :: Record RS.Props , sliderProps :: Record RS.Props
) )
rangeControl :: Record Props -> R.Element rangeControl :: R2.Component Props
rangeControl props = R.createElement rangeControlCpt props [] rangeControl = R.createElement rangeControlCpt
rangeControlCpt :: R.Component Props rangeControlCpt :: R.Component Props
rangeControlCpt = here.component "rangeButton" cpt rangeControlCpt = here.component "rangeButton" cpt
...@@ -35,47 +38,86 @@ rangeControlCpt = here.component "rangeButton" cpt ...@@ -35,47 +38,86 @@ rangeControlCpt = here.component "rangeButton" cpt
, RS.rangeSlider sliderProps , RS.rangeSlider sliderProps
] ]
edgeConfluenceControl :: Range.NumberRange -> R.State Range.NumberRange -> R.Element type EdgeConfluenceControlProps = (
edgeConfluenceControl (Range.Closed { min, max }) (state /\ setState) = range :: Range.NumberRange
rangeControl { , state :: T.Cursor Range.NumberRange
caption: "Edge Confluence Weight" )
, sliderProps: {
bounds: Range.Closed { min, max } edgeConfluenceControl :: R2.Component EdgeConfluenceControlProps
, initialValue: state edgeConfluenceControl = R.createElement edgeConfluenceControlCpt
, epsilon: 0.01
, step: 1.0 edgeConfluenceControlCpt :: R.Component EdgeConfluenceControlProps
, width: 10.0 edgeConfluenceControlCpt = here.component "edgeConfluenceControl" cpt
, height: 5.0 where
, onChange: setState <<< const cpt { range: Range.Closed { min, max }
} , state } _ = do
} state' <- T.useLive T.unequal state
edgeWeightControl :: Range.NumberRange -> R.State Range.NumberRange -> R.Element pure $ rangeControl {
edgeWeightControl (Range.Closed { min, max }) (state /\ setState) = caption: "Edge Confluence Weight"
rangeControl { , sliderProps: {
caption: "Edge Weight" bounds: Range.Closed { min, max }
, sliderProps: { , initialValue: state'
bounds: Range.Closed { min, max } , epsilon: 0.01
, initialValue: state , step: 1.0
, epsilon: 1.0 , width: 10.0
, step: 1.0 , height: 5.0
, width: 10.0 , onChange: \rng -> T2.write_ rng state
, height: 5.0 }
, onChange: setState <<< const } []
}
} type EdgeWeightControlProps = (
range :: Range.NumberRange
nodeSizeControl :: Range.NumberRange -> R.State Range.NumberRange -> R.Element , state :: T.Cursor Range.NumberRange
nodeSizeControl (Range.Closed { min, max }) (state /\ setState) = )
rangeControl {
caption: "Node Size" edgeWeightControl :: R2.Component EdgeWeightControlProps
, sliderProps: { edgeWeightControl = R.createElement edgeWeightControlCpt
bounds: Range.Closed { min, max }
, initialValue: state edgeWeightControlCpt :: R.Component EdgeWeightControlProps
, epsilon: 0.1 edgeWeightControlCpt = here.component "edgeWeightControl" cpt
, step: 1.0 where
, width: 10.0 cpt { range: Range.Closed { min, max }
, height: 5.0 , state } _ = do
, onChange: setState <<< const state' <- T.useLive T.unequal state
}
} pure $ rangeControl {
caption: "Edge Weight"
, sliderProps: {
bounds: Range.Closed { min, max }
, initialValue: state'
, epsilon: 1.0
, step: 1.0
, width: 10.0
, height: 5.0
, onChange: \rng -> T2.write_ rng state
}
} []
type NodeSideControlProps = (
range :: Range.NumberRange
, state :: T.Cursor Range.NumberRange
)
nodeSizeControl :: R2.Component NodeSideControlProps
nodeSizeControl = R.createElement nodeSizeControlCpt
nodeSizeControlCpt :: R.Component NodeSideControlProps
nodeSizeControlCpt = here.component "nodeSizeControl" cpt
where
cpt { range: Range.Closed { min, max }
, state } _ = do
state' <- T.useLive T.unequal state
pure $ rangeControl {
caption: "Node Size"
, sliderProps: {
bounds: Range.Closed { min, max }
, initialValue: state'
, epsilon: 0.1
, step: 1.0
, width: 10.0
, height: 5.0
, onChange: \rng -> T2.write_ rng state
}
} []
...@@ -11,18 +11,21 @@ import DOM.Simple.Console (log2) ...@@ -11,18 +11,21 @@ import DOM.Simple.Console (log2)
import Effect (Effect) import Effect (Effect)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.InputWithAutocomplete (inputWithAutocomplete) import Gargantext.Components.InputWithAutocomplete (inputWithAutocomplete)
import Gargantext.Hooks.Sigmax.Types as SigmaxT import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Utils (queryMatchesLabel) import Gargantext.Utils (queryMatchesLabel)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.Search" here = R2.here "Gargantext.Components.GraphExplorer.Search"
type Props = ( type Props = (
graph :: SigmaxT.SGraph graph :: SigmaxT.SGraph
, multiSelectEnabled :: R.State Boolean , multiSelectEnabled :: T.Cursor Boolean
, selectedNodeIds :: R.State SigmaxT.NodeIds , selectedNodeIds :: T.Cursor SigmaxT.NodeIds
) )
-- | Whether a node matches a search string -- | Whether a node matches a search string
...@@ -33,24 +36,25 @@ searchNodes :: String -> Seq.Seq (Record SigmaxT.Node) -> Seq.Seq (Record Sigmax ...@@ -33,24 +36,25 @@ searchNodes :: String -> Seq.Seq (Record SigmaxT.Node) -> Seq.Seq (Record Sigmax
searchNodes "" _ = Seq.empty searchNodes "" _ = Seq.empty
searchNodes s nodes = Seq.filter (nodeMatchesSearch s) nodes searchNodes s nodes = Seq.filter (nodeMatchesSearch s) nodes
nodeSearchControl :: Record Props -> R.Element nodeSearchControl :: R2.Component Props
nodeSearchControl props = R.createElement sizeButtonCpt props [] nodeSearchControl = R.createElement sizeButtonCpt
sizeButtonCpt :: R.Component Props sizeButtonCpt :: R.Component Props
sizeButtonCpt = here.component "nodeSearchControl" cpt sizeButtonCpt = here.component "nodeSearchControl" cpt
where where
cpt {graph, multiSelectEnabled, selectedNodeIds} _ = do cpt { graph, multiSelectEnabled, selectedNodeIds } _ = do
search@(search' /\ setSearch) <- R.useState' "" search@(search' /\ setSearch) <- R.useState' ""
multiSelectEnabled' <- T.useLive T.unequal multiSelectEnabled
pure $ pure $
H.div { className: "form-group" } H.div { className: "form-group" }
[ H.div { className: "input-group" } [ H.div { className: "input-group" }
[ inputWithAutocomplete { autocompleteSearch: autocompleteSearch graph [ inputWithAutocomplete { autocompleteSearch: autocompleteSearch graph
, onAutocompleteClick: \s -> triggerSearch graph s multiSelectEnabled selectedNodeIds , onAutocompleteClick: \s -> triggerSearch graph s multiSelectEnabled' selectedNodeIds
, onEnterPress: \s -> triggerSearch graph s multiSelectEnabled selectedNodeIds , onEnterPress: \s -> triggerSearch graph s multiSelectEnabled' selectedNodeIds
, state: search } , state: search }
, H.div { className: "btn input-group-addon" , H.div { className: "btn input-group-addon"
, on: { click: \_ -> triggerSearch graph search' multiSelectEnabled selectedNodeIds } , on: { click: \_ -> triggerSearch graph search' multiSelectEnabled' selectedNodeIds }
} }
[ H.span { className: "fa fa-search" } [] ] [ H.span { className: "fa fa-search" } [] ]
] ]
...@@ -63,14 +67,14 @@ autocompleteSearch graph s = Seq.toUnfoldable $ (_.label) <$> searchNodes s node ...@@ -63,14 +67,14 @@ autocompleteSearch graph s = Seq.toUnfoldable $ (_.label) <$> searchNodes s node
triggerSearch :: SigmaxT.SGraph triggerSearch :: SigmaxT.SGraph
-> String -> String
-> R.State Boolean -> Boolean
-> R.State SigmaxT.NodeIds -> T.Cursor SigmaxT.NodeIds
-> Effect Unit -> Effect Unit
triggerSearch graph search (multiSelectEnabled /\ _) (_ /\ setNodeIds) = do triggerSearch graph search multiSelectEnabled selectedNodeIds = do
let graphNodes = SigmaxT.graphNodes graph let graphNodes = SigmaxT.graphNodes graph
let matching = Set.fromFoldable $ (_.id) <$> searchNodes search graphNodes let matching = Set.fromFoldable $ (_.id) <$> searchNodes search graphNodes
log2 "[triggerSearch] search" search log2 "[triggerSearch] search" search
setNodeIds $ \nodes -> T2.modify_ (\nodes ->
Set.union matching $ if multiSelectEnabled then nodes else SigmaxT.emptyNodeIds Set.union matching $ if multiSelectEnabled then nodes else SigmaxT.emptyNodeIds) selectedNodeIds
...@@ -18,6 +18,8 @@ import Partial.Unsafe (unsafePartial) ...@@ -18,6 +18,8 @@ import Partial.Unsafe (unsafePartial)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as RH import Reactix.DOM.HTML as RH
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RX
import Toestand as T import Toestand as T
import Gargantext.Prelude import Gargantext.Prelude
...@@ -34,7 +36,7 @@ import Gargantext.Data.Array (mapMaybe) ...@@ -34,7 +36,7 @@ import Gargantext.Data.Array (mapMaybe)
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Sigmax.Types as SigmaxT import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType, TabSubType(..), TabType(..), TermList(..), modeTabType) import Gargantext.Types (CTabNgramType, NodeID, TabSubType(..), TabType(..), TermList(..), modeTabType)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR import Gargantext.Utils.Reload as GUR
import Gargantext.Utils.Toestand as T2 import Gargantext.Utils.Toestand as T2
...@@ -42,17 +44,21 @@ import Gargantext.Utils.Toestand as T2 ...@@ -42,17 +44,21 @@ import Gargantext.Utils.Toestand as T2
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.Sidebar" here = R2.here "Gargantext.Components.GraphExplorer.Sidebar"
type Props = ( type Common = (
frontends :: Frontends graphId :: NodeID
, graph :: SigmaxT.SGraph
, graphId :: Int
, graphVersion :: GUR.ReloadS
, metaData :: GET.MetaData , metaData :: GET.MetaData
, reloadForest :: T.Cursor T2.Reload , reloadForest :: T.Cursor T2.Reload
, removedNodeIds :: T.Cursor SigmaxT.NodeIds , removedNodeIds :: T.Cursor SigmaxT.NodeIds
, selectedNodeIds :: T.Cursor SigmaxT.NodeIds , selectedNodeIds :: T.Cursor SigmaxT.NodeIds
, session :: Session , session :: Session
)
type Props = (
frontends :: Frontends
, graph :: SigmaxT.SGraph
, graphVersion :: GUR.ReloadS
, showSidePanel :: T.Cursor GET.SidePanelState , showSidePanel :: T.Cursor GET.SidePanelState
| Common
) )
sidebar :: Record Props -> R.Element sidebar :: Record Props -> R.Element
...@@ -61,15 +67,26 @@ sidebar props = R.createElement sidebarCpt props [] ...@@ -61,15 +67,26 @@ sidebar props = R.createElement sidebarCpt props []
sidebarCpt :: R.Component Props sidebarCpt :: R.Component Props
sidebarCpt = here.component "sidebar" cpt sidebarCpt = here.component "sidebar" cpt
where where
cpt {showSidePanel: (GET.Closed /\ _)} _children = do cpt props@{ metaData, showSidePanel } _ = do
pure $ RH.div {} [] showSidePanel' <- T.useLive T.unequal showSidePanel
cpt {showSidePanel: (GET.InitialClosed /\ _)} _children = do
pure $ RH.div {} [] case showSidePanel' of
cpt props@{metaData, showSidePanel} _children = do GET.Closed -> pure $ RH.div {} []
pure $ RH.div { id: "sp-container" } GET.InitialClosed -> pure $ RH.div {} []
[ sideTabNav showSidePanel [SideTabLegend, SideTabData, SideTabCommunity] GET.Opened sideTabT -> do
, sideTab (fst showSidePanel) props let sideTab' = case sideTabT of
] SideTabLegend -> sideTabLegend sideTabProps []
SideTabData -> sideTabData sideTabProps []
SideTabCommunity -> sideTabCommunity sideTabProps []
_ -> H.div {} []
pure $ RH.div { id: "sp-container" }
[ sideTabNav { sidePanel: showSidePanel
, sideTabs: [SideTabLegend, SideTabData, SideTabCommunity] } []
, sideTab'
]
where
sideTabProps = RX.pick props :: Record SideTabProps
type SideTabNavProps = ( type SideTabNavProps = (
sidePanel :: T.Cursor GET.SidePanelState sidePanel :: T.Cursor GET.SidePanelState
...@@ -101,142 +118,217 @@ sideTabNavCpt = here.component "sideTabNav" cpt ...@@ -101,142 +118,217 @@ sideTabNavCpt = here.component "sideTabNav" cpt
} }
} [ H.text $ show tab ] } [ H.text $ show tab ]
type SideTabProps = ( type SideTabProps = Props
frontends :: Frontends
, metaData :: GET.MetaData
)
sideTab :: SidePanelState -> Record Props -> R.Element sideTabLegend :: R2.Component SideTabProps
sideTab (Opened SideTabLegend) props@{metaData} = sideTabLegend = R.createElement sideTabLegendCpt
H.div {} [ let (GET.MetaData {legend}) = metaData
in Legend.legend { items: Seq.fromFoldable legend}
, documentation EN
]
sideTab (Opened SideTabData) props = sideTabLegendCpt :: R.Component SideTabProps
RH.div {} [ selectedNodes props (SigmaxT.nodesGraphMap props.graph) sideTabLegendCpt = here.component "sideTabLegend" cpt
, neighborhood props where
, RH.div { className: "col-md-12", id: "query" } cpt props@{ metaData: GET.MetaData { legend } } _ = do
[ query SearchDoc pure $ H.div {}
props.frontends [ Legend.legend { items: Seq.fromFoldable legend }
props.metaData , documentation EN
props.session ]
(SigmaxT.nodesGraphMap props.graph)
selectedNodeIds' sideTabData :: R2.Component SideTabProps
] sideTabData = R.createElement sideTabDataCpt
]
where
checkbox text = sideTabDataCpt :: R.Component SideTabProps
RH.li {} sideTabDataCpt = here.component "sideTabData" cpt
[ RH.span {} [ RH.text text ] where
, RH.input { type: "checkbox" cpt props _ = do
, className: "checkbox" selectedNodeIds' <- T.useLive T.unequal props.selectedNodeIds
, defaultChecked: true
, title: "Mark as completed" } ] pure $ RH.div {}
[ selectedNodes (Record.merge { nodesMap: SigmaxT.nodesGraphMap props.graph } props) []
, neighborhood props []
, RH.div { className: "col-md-12", id: "query" }
[ query SearchDoc
props.frontends
props.metaData
props.session
(SigmaxT.nodesGraphMap props.graph)
selectedNodeIds'
]
]
where
checkbox text = RH.li {}
[ RH.span {} [ RH.text text ]
, RH.input { type: "checkbox"
, className: "checkbox"
, defaultChecked: true
, title: "Mark as completed" } ]
sideTab (Opened SideTabCommunity) props = sideTabCommunity :: R2.Component SideTabProps
RH.div { className: "col-md-12", id: "query" } sideTabCommunity = R.createElement sideTabCommunityCpt
[ selectedNodes props (SigmaxT.nodesGraphMap props.graph)
, neighborhood props
, query SearchContact
props.frontends
props.metaData
props.session
(SigmaxT.nodesGraphMap props.graph)
props.selectedNodeIds
]
sideTab _ _ = H.div {} [] sideTabCommunityCpt :: R.Component SideTabProps
sideTabCommunityCpt = here.component "sideTabCommunity" cpt
where
cpt props _ = do
selectedNodeIds' <- T.useLive T.unequal props.selectedNodeIds
pure $ RH.div { className: "col-md-12", id: "query" }
[ selectedNodes (Record.merge { nodesMap: SigmaxT.nodesGraphMap props.graph } props) []
, neighborhood props []
, query SearchContact
props.frontends
props.metaData
props.session
(SigmaxT.nodesGraphMap props.graph)
selectedNodeIds'
]
------------------------------------------- -------------------------------------------
-- TODO -- TODO
-- selectedNodes :: Record Props -> Map.Map String Nodes -> R.Element -- selectedNodes :: Record Props -> Map.Map String Nodes -> R.Element
selectedNodes props nodesMap =
R2.row [ R2.col 12 type SelectedNodesProps = (
nodesMap :: SigmaxT.NodesMap
| Props
)
selectedNodes :: R2.Component SelectedNodesProps
selectedNodes = R.createElement selectedNodesCpt
selectedNodesCpt :: R.Component SelectedNodesProps
selectedNodesCpt = here.component "selectedNodes" cpt
where
cpt props@{ graph
, nodesMap
, selectedNodeIds } _ = do
selectedNodeIds' <- T.useLive T.unequal selectedNodeIds
pure $ R2.row
[ R2.col 12
[ RH.ul { className: "nav nav-tabs d-flex justify-content-center" [ RH.ul { className: "nav nav-tabs d-flex justify-content-center"
, id: "myTab" , id: "myTab"
, role: "tablist" } , role: "tablist" }
[ RH.div { className: "tab-content" } [ RH.div { className: "tab-content" }
[ RH.div { className: "d-flex flex-wrap justify-content-center" [ RH.div { className: "d-flex flex-wrap justify-content-center"
, role: "tabpanel" } , role: "tabpanel" }
( Seq.toUnfoldable ( Seq.toUnfoldable
$ ( Seq.map (badge props.selectedNodeIds) $ ( Seq.map (badge selectedNodeIds)
(badges props.graph props.selectedNodeIds) (badges graph selectedNodeIds')
) )
) )
, H.br {} , H.br {}
] ]
] ]
, RH.div { className: "tab-content flex-space-between" } , RH.div { className: "tab-content flex-space-between" }
[ removeButton "primary" "Move as candidate" CandidateTerm props nodesMap [ removeButton (Record.merge { buttonType: "primary"
, H.br {} , rType: CandidateTerm
, removeButton "danger" "Move as stop" StopTerm props nodesMap , nodesMap
] , text: "Move as candidate" } commonProps) []
] , H.br {}
] , removeButton (Record.merge { buttonType: "danger"
neighborhood props = RH.div { className: "tab-content", id: "myTabContent" } , nodesMap
[ RH.div { -- className: "flex-space-around d-flex justify-content-center" , rType: StopTerm
className: "d-flex flex-wrap flex-space-around" , text: "Move as stop" } commonProps) []
, id: "home" ]
, role: "tabpanel" ]
} ]
(Seq.toUnfoldable $ Seq.map (badge props.selectedNodeIds) where
$ neighbourBadges props.graph props.selectedNodeIds commonProps = RX.pick props :: Record Common
)
] neighborhood :: R2.Component Props
neighborhood = R.createElement neighborhoodCpt
removeButton btnType text rType props' nodesMap' = neighborhoodCpt :: R.Component Props
if Set.isEmpty $ fst props'.selectedNodeIds then neighborhoodCpt = here.component "neighborhood" cpt
RH.div {} [] where
else cpt { graph
RH.button { className: "btn btn-sm btn-" <> btnType , selectedNodeIds } _ = do
, on: { click: onClickRemove rType props' nodesMap' } selectedNodeIds' <- T.useLive T.unequal selectedNodeIds
}
[ RH.text text ] pure $ RH.div { className: "tab-content", id: "myTabContent" }
[ RH.div { -- className: "flex-space-around d-flex justify-content-center"
onClickRemove rType props' nodesMap' e = do className: "d-flex flex-wrap flex-space-around"
let nodes = mapMaybe (\id -> Map.lookup id nodesMap') , id: "home"
$ Set.toUnfoldable $ fst props'.selectedNodeIds , role: "tabpanel"
deleteNodes { graphId: props'.graphId }
, metaData: props'.metaData (Seq.toUnfoldable $ Seq.map (badge selectedNodeIds)
, nodes $ neighbourBadges graph selectedNodeIds'
, session: props'.session )
, termList: rType ]
, reloadForest: props'.reloadForest }
snd props'.removedNodeIds $ const $ fst props'.selectedNodeIds
snd props'.selectedNodeIds $ const SigmaxT.emptyNodeIds type RemoveButtonProps = (
buttonType :: String
, nodesMap :: SigmaxT.NodesMap
, rType :: TermList
, text :: String
| Common
)
removeButton :: R2.Component RemoveButtonProps
removeButton = R.createElement removeButtonCpt
removeButtonCpt :: R.Component RemoveButtonProps
removeButtonCpt = here.component "removeButton" cpt
where
cpt { buttonType
, graphId
, metaData
, nodesMap
, reloadForest
, removedNodeIds
, rType
, selectedNodeIds
, session
, text } _ = do
selectedNodeIds' <- T.useLive T.unequal selectedNodeIds
pure $ if Set.isEmpty selectedNodeIds' then
RH.div {} []
else
RH.button { className: "btn btn-sm btn-" <> buttonType
, on: { click: onClickRemove selectedNodeIds' }
} [ RH.text text ]
where
onClickRemove selectedNodeIds' e = do
let nodes = mapMaybe (\id -> Map.lookup id nodesMap)
$ Set.toUnfoldable selectedNodeIds'
deleteNodes { graphId: graphId
, metaData: metaData
, nodes
, session: session
, termList: rType
, reloadForest }
T2.write_ selectedNodeIds' removedNodeIds
T2.write_ SigmaxT.emptyNodeIds selectedNodeIds
badge :: T.Cursor SigmaxT.NodeIds -> Record SigmaxT.Node -> R.Element badge :: T.Cursor SigmaxT.NodeIds -> Record SigmaxT.Node -> R.Element
badge (_ /\ setNodeIds) {id, label} = badge selectedNodeIds {id, label} =
RH.a { className: "badge badge-pill badge-light" RH.a { className: "badge badge-pill badge-light"
, on: { click: onClick } , on: { click: onClick }
} [ RH.h6 {} [ RH.text label ] ] } [ RH.h6 {} [ RH.text label ] ]
where where
onClick e = do onClick e = do
setNodeIds $ const $ Set.singleton id T2.write_ (Set.singleton id) selectedNodeIds
badges :: SigmaxT.SGraph -> T.Cursor SigmaxT.NodeIds -> Seq.Seq (Record SigmaxT.Node) badges :: SigmaxT.SGraph -> SigmaxT.NodeIds -> Seq.Seq (Record SigmaxT.Node)
badges graph (selectedNodeIds /\ _) = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds badges graph selectedNodeIds = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
neighbourBadges :: SigmaxT.SGraph -> T.Cursor SigmaxT.NodeIds -> Seq.Seq (Record SigmaxT.Node) neighbourBadges :: SigmaxT.SGraph -> SigmaxT.NodeIds -> Seq.Seq (Record SigmaxT.Node)
neighbourBadges graph (selectedNodeIds /\ _) = SigmaxT.neighbours graph selectedNodes neighbourBadges graph selectedNodeIds = SigmaxT.neighbours graph selectedNodes
where where
selectedNodes = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds selectedNodes = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
type DeleteNodes = type DeleteNodes =
( graphId :: Int ( graphId :: NodeID
, metaData :: GET.MetaData , metaData :: GET.MetaData
, nodes :: Array (Record SigmaxT.Node) , nodes :: Array (Record SigmaxT.Node)
, session :: Session , reloadForest :: T.Cursor T2.Reload
, termList :: TermList , session :: Session
, reloadForest :: GUR.ReloadS , termList :: TermList
) )
deleteNodes :: Record DeleteNodes -> Effect Unit deleteNodes :: Record DeleteNodes -> Effect Unit
...@@ -247,7 +339,7 @@ deleteNodes { graphId, metaData, nodes, session, termList, reloadForest } = do ...@@ -247,7 +339,7 @@ deleteNodes { graphId, metaData, nodes, session, termList, reloadForest } = do
case mPatch of case mPatch of
Nothing -> pure unit Nothing -> pure unit
Just (NTC.Versioned patch) -> do Just (NTC.Versioned patch) -> do
liftEffect $ GUR.bump reloadForest liftEffect $ GUR.bumpCursor reloadForest
-- Why is this called delete node? -- Why is this called delete node?
deleteNode :: TermList deleteNode :: TermList
...@@ -260,7 +352,7 @@ deleteNode termList session (GET.MetaData metaData) node = do ...@@ -260,7 +352,7 @@ deleteNode termList session (GET.MetaData metaData) node = do
task <- NTC.postNgramsChartsAsync coreParams -- TODO add task task <- NTC.postNgramsChartsAsync coreParams -- TODO add task
pure ret pure ret
where where
nodeId :: Int nodeId :: NodeID
nodeId = unsafePartial $ fromJust $ fromString node.id nodeId = unsafePartial $ fromJust $ fromString node.id
versioned :: NTC.VersionedNgramsPatches versioned :: NTC.VersionedNgramsPatches
......
...@@ -11,19 +11,22 @@ import Data.Tuple.Nested ((/\)) ...@@ -11,19 +11,22 @@ import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Hooks.Sigmax as Sigmax import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as Sigma import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.SlideButton" here = R2.here "Gargantext.Components.GraphExplorer.SlideButton"
type Props = ( type Props = (
state :: R.State Number caption :: String
, caption :: String , min :: Number
, min :: Number , max :: Number
, max :: Number
, onChange :: forall e. e -> Effect Unit , onChange :: forall e. e -> Effect Unit
, state :: T.Cursor Number
) )
sizeButton :: Record Props -> R.Element sizeButton :: Record Props -> R.Element
...@@ -33,7 +36,7 @@ sizeButtonCpt :: R.Component Props ...@@ -33,7 +36,7 @@ sizeButtonCpt :: R.Component Props
sizeButtonCpt = here.component "sizeButton" cpt sizeButtonCpt = here.component "sizeButton" cpt
where where
cpt {state, caption, min, max, onChange} _ = do cpt {state, caption, min, max, onChange} _ = do
let (value /\ setValue) = state state' <- T.useLive T.unequal state
pure $ pure $
H.span { class: "range-simple" } H.span { class: "range-simple" }
[ H.label {} [ R2.small {} [ H.text caption ] ] [ H.label {} [ R2.small {} [ H.text caption ] ]
...@@ -41,12 +44,12 @@ sizeButtonCpt = here.component "sizeButton" cpt ...@@ -41,12 +44,12 @@ sizeButtonCpt = here.component "sizeButton" cpt
, className: "form-control" , className: "form-control"
, min: show min , min: show min
, max: show max , max: show max
, defaultValue: value , defaultValue: state'
, on: {input: onChange} , on: {input: onChange}
} }
] ]
labelSizeButton :: R.Ref Sigmax.Sigma -> R.State Number -> R.Element labelSizeButton :: R.Ref Sigmax.Sigma -> T.Cursor Number -> R.Element
labelSizeButton sigmaRef state = labelSizeButton sigmaRef state =
sizeButton { sizeButton {
state state
...@@ -56,7 +59,6 @@ labelSizeButton sigmaRef state = ...@@ -56,7 +59,6 @@ labelSizeButton sigmaRef state =
, onChange: \e -> do , onChange: \e -> do
let sigma = R.readRef sigmaRef let sigma = R.readRef sigmaRef
let newValue = readFloat $ R.unsafeEventValue e let newValue = readFloat $ R.unsafeEventValue e
let (_ /\ setValue) = state
Sigmax.dependOnSigma sigma "[labelSizeButton] sigma: Nothing" $ \s -> do Sigmax.dependOnSigma sigma "[labelSizeButton] sigma: Nothing" $ \s -> do
Sigma.setSettings s { Sigma.setSettings s {
defaultLabelSize: newValue defaultLabelSize: newValue
...@@ -64,10 +66,10 @@ labelSizeButton sigmaRef state = ...@@ -64,10 +66,10 @@ labelSizeButton sigmaRef state =
, maxNodeSize: newValue / 2.5 , maxNodeSize: newValue / 2.5
--, labelSizeRatio: newValue / 2.5 --, labelSizeRatio: newValue / 2.5
} }
setValue $ const newValue T2.write_ newValue state
} }
mouseSelectorSizeButton :: R.Ref Sigmax.Sigma -> R.State Number -> R.Element mouseSelectorSizeButton :: R.Ref Sigmax.Sigma -> T.Cursor Number -> R.Element
mouseSelectorSizeButton sigmaRef state = mouseSelectorSizeButton sigmaRef state =
sizeButton { sizeButton {
state state
...@@ -76,11 +78,10 @@ mouseSelectorSizeButton sigmaRef state = ...@@ -76,11 +78,10 @@ mouseSelectorSizeButton sigmaRef state =
, max: 50.0 , max: 50.0
, onChange: \e -> do , onChange: \e -> do
let sigma = R.readRef sigmaRef let sigma = R.readRef sigmaRef
let (_ /\ setValue) = state
let newValue = readFloat $ R.unsafeEventValue e let newValue = readFloat $ R.unsafeEventValue e
Sigmax.dependOnSigma sigma "[mouseSelectorSizeButton] sigma: Nothing" $ \s -> do Sigmax.dependOnSigma sigma "[mouseSelectorSizeButton] sigma: Nothing" $ \s -> do
Sigma.setSettings s { Sigma.setSettings s {
mouseSelectorSize: newValue mouseSelectorSize: newValue
} }
setValue $ const newValue T2.write_ newValue state
} }
...@@ -16,64 +16,83 @@ import Prelude ...@@ -16,64 +16,83 @@ import Prelude
import Data.Tuple (snd) import Data.Tuple (snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R import Gargantext.Utils.Toestand as T2
import Reactix.DOM.HTML as H
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.ToggleButton" here = R2.here "Gargantext.Components.GraphExplorer.ToggleButton"
type Props = ( type Props = (
state :: R.State Boolean state :: T.Cursor Boolean
, onMessage :: String , onMessage :: String
, offMessage :: String , offMessage :: String
, style :: String , style :: String
, onClick :: forall e. e -> Effect Unit , onClick :: forall e. e -> Effect Unit
) )
toggleButton :: Record Props -> R.Element toggleButton :: R2.Component Props
toggleButton props = R.createElement toggleButtonCpt props [] toggleButton = R.createElement toggleButtonCpt
toggleButtonCpt :: R.Component Props toggleButtonCpt :: R.Component Props
toggleButtonCpt = here.component "toggleButton" cpt toggleButtonCpt = here.component "toggleButton" cpt
where where
cpt {state, onMessage, offMessage, onClick, style} _ = do cpt { state
let (toggled /\ _) = state , onMessage
, offMessage
pure $ H.button { className: "btn btn-outline-" <> style <> " " <> cls toggled , onClick
, style } _ = do
state' <- T.useLive T.unequal state
pure $ H.button { className: "btn btn-outline-" <> style <> " " <> cls state'
, on: {click: onClick} , on: {click: onClick}
} [ R2.small {} [ H.text (text onMessage offMessage toggled) ] ] } [ R2.small {} [ H.text (text onMessage offMessage state') ] ]
cls true = "active" cls true = "active"
cls false = "" cls false = ""
text on _off true = on text on _off true = on
text _on off false = off text _on off false = off
controlsToggleButton :: R.State Boolean -> R.Element type ControlsToggleButtonProps = (
controlsToggleButton state = state :: T.Cursor Boolean
toggleButton { )
state: state
, onMessage: "Hide Controls" controlsToggleButton :: R2.Component ControlsToggleButtonProps
, offMessage: "Show Controls" controlsToggleButton = R.createElement controlsToggleButtonCpt
, onClick: \_ -> snd state not
, style: "light" controlsToggleButtonCpt :: R.Component ControlsToggleButtonProps
} controlsToggleButtonCpt = here.component "controlsToggleButton" cpt
where
cpt { state } _ = do
pure $ toggleButton {
state: state
, onMessage: "Hide Controls"
, offMessage: "Show Controls"
, onClick: \_ -> T2.modify_ not state
, style: "light"
} []
type EdgesButtonProps = ( type EdgesButtonProps = (
state :: R.State SigmaxTypes.ShowEdgesState state :: T.Cursor SigmaxTypes.ShowEdgesState
) )
edgesToggleButton :: Record EdgesButtonProps -> R.Element edgesToggleButton :: R2.Component EdgesButtonProps
edgesToggleButton props = R.createElement edgesToggleButtonCpt props [] edgesToggleButton = R.createElement edgesToggleButtonCpt
edgesToggleButtonCpt :: R.Component EdgesButtonProps edgesToggleButtonCpt :: R.Component EdgesButtonProps
edgesToggleButtonCpt = here.component "edgesToggleButton" cpt edgesToggleButtonCpt = here.component "edgesToggleButton" cpt
where where
cpt {state: (state /\ setState)} _ = do cpt { state } _ = do
pure $ H.button { className: "btn btn-outline-primary " <> cls state state' <- T.useLive T.unequal state
, on: { click: onClick setState }
} [ R2.small {} [ H.text (text state) ] ] pure $ H.button { className: "btn btn-outline-primary " <> cls state'
, on: { click: onClick state }
} [ R2.small {} [ H.text (text state') ] ]
text s = if SigmaxTypes.edgeStateHidden s then "Show edges" else "Hide edges" text s = if SigmaxTypes.edgeStateHidden s then "Show edges" else "Hide edges"
...@@ -81,42 +100,62 @@ edgesToggleButtonCpt = here.component "edgesToggleButton" cpt ...@@ -81,42 +100,62 @@ edgesToggleButtonCpt = here.component "edgesToggleButton" cpt
cls _ = "active" cls _ = "active"
-- TODO: Move this to Graph.purs to the R.useEffect handler which renders nodes/edges -- TODO: Move this to Graph.purs to the R.useEffect handler which renders nodes/edges
onClick setState _ = setState SigmaxTypes.toggleShowEdgesState onClick state _ = T2.modify_ SigmaxTypes.toggleShowEdgesState state
louvainToggleButton :: R.State Boolean -> R.Element type LouvainToggleButtonProps = (
louvainToggleButton state = state :: T.Cursor Boolean
toggleButton { )
state: state
, onMessage: "Louvain off" louvainToggleButton :: R2.Component LouvainToggleButtonProps
, offMessage: "Louvain on" louvainToggleButton = R.createElement louvainToggleButtonCpt
, onClick: \_ -> snd state not
, style: "primary" louvainToggleButtonCpt :: R.Component LouvainToggleButtonProps
} louvainToggleButtonCpt = here.component "louvainToggleButton" cpt
where
multiSelectEnabledButton :: R.State Boolean -> R.Element cpt { state } _ = do
multiSelectEnabledButton state = pure $ toggleButton {
toggleButton { state: state
state: state , onMessage: "Louvain off"
, onMessage: "Single-node" , offMessage: "Louvain on"
, offMessage: "Multi-node" , onClick: \_ -> T2.modify_ not state
, onClick: \_ -> snd state not , style: "primary"
, style : "primary" } []
}
type MultiSelectEnabledButtonProps = (
state :: T.Cursor Boolean
)
multiSelectEnabledButton :: R2.Component MultiSelectEnabledButtonProps
multiSelectEnabledButton = R.createElement multiSelectEnabledButtonCpt
multiSelectEnabledButtonCpt :: R.Component MultiSelectEnabledButtonProps
multiSelectEnabledButtonCpt = here.component "lmultiSelectEnabledButton" cpt
where
cpt { state } _ = do
pure $ toggleButton {
state: state
, onMessage: "Single-node"
, offMessage: "Multi-node"
, onClick: \_ -> T2.modify_ not state
, style : "primary"
} []
type ForceAtlasProps = ( type ForceAtlasProps = (
state :: R.State SigmaxTypes.ForceAtlasState state :: T.Cursor SigmaxTypes.ForceAtlasState
) )
pauseForceAtlasButton :: Record ForceAtlasProps -> R.Element pauseForceAtlasButton :: R2.Component ForceAtlasProps
pauseForceAtlasButton props = R.createElement pauseForceAtlasButtonCpt props [] pauseForceAtlasButton = R.createElement pauseForceAtlasButtonCpt
pauseForceAtlasButtonCpt :: R.Component ForceAtlasProps pauseForceAtlasButtonCpt :: R.Component ForceAtlasProps
pauseForceAtlasButtonCpt = here.component "forceAtlasToggleButton" cpt pauseForceAtlasButtonCpt = here.component "forceAtlasToggleButton" cpt
where where
cpt {state: (state /\ setState)} _ = do cpt { state } _ = do
pure $ H.button { className: "btn btn-outline-primary " <> cls state state' <- T.useLive T.unequal state
, on: { click: onClick setState }
} [ R2.small {} [ H.text (text state) ] ] pure $ H.button { className: "btn btn-outline-primary " <> cls state'
, on: { click: onClick state }
} [ R2.small {} [ H.text (text state') ] ]
cls SigmaxTypes.InitialRunning = "active" cls SigmaxTypes.InitialRunning = "active"
cls SigmaxTypes.Running = "active" cls SigmaxTypes.Running = "active"
...@@ -127,26 +166,43 @@ pauseForceAtlasButtonCpt = here.component "forceAtlasToggleButton" cpt ...@@ -127,26 +166,43 @@ pauseForceAtlasButtonCpt = here.component "forceAtlasToggleButton" cpt
text SigmaxTypes.Running = "Pause Force Atlas" text SigmaxTypes.Running = "Pause Force Atlas"
text SigmaxTypes.Paused = "Start Force Atlas" text SigmaxTypes.Paused = "Start Force Atlas"
onClick setState _ = setState SigmaxTypes.toggleForceAtlasState onClick state _ = T2.modify_ SigmaxTypes.toggleForceAtlasState state
treeToggleButton :: R.State Boolean -> R.Element type TreeToggleButtonProps = (
treeToggleButton state = state :: T.Cursor Boolean
toggleButton { )
state: state
, onMessage: "Hide Tree" treeToggleButton :: R2.Component TreeToggleButtonProps
, offMessage: "Show Tree" treeToggleButton = R.createElement treeToggleButtonCpt
, onClick: \_ -> snd state not
, style: "light"
}
sidebarToggleButton :: R.State GET.SidePanelState -> R.Element treeToggleButtonCpt :: R.Component TreeToggleButtonProps
sidebarToggleButton (state /\ setState) = R.createElement el {} [] treeToggleButtonCpt = here.component "treeToggleButton" cpt
where where
el = here.component "sidebarToggleButton" cpt cpt { state } _ = do
cpt {} _ = do pure $ toggleButton {
pure $ H.button { className: "btn btn-outline-light " <> cls state state: state
, on: { click: onClick} , onMessage: "Hide Tree"
} [ R2.small {} [ H.text (text onMessage offMessage state) ] ] , offMessage: "Show Tree"
, onClick: \_ -> T2.modify_ not state
, style: "light"
} []
type SidebarToggleButtonProps = (
state :: T.Cursor GET.SidePanelState
)
sidebarToggleButton :: R2.Component SidebarToggleButtonProps
sidebarToggleButton = R.createElement sidebarToggleButtonCpt
sidebarToggleButtonCpt :: R.Component SidebarToggleButtonProps
sidebarToggleButtonCpt = here.component "sidebarToggleButton" cpt
where
cpt { state } _ = do
state' <- T.useLive T.unequal state
pure $ H.button { className: "btn btn-outline-light " <> cls state'
, on: { click: onClick state }
} [ R2.small {} [ H.text (text onMessage offMessage state') ] ]
cls (GET.Opened _) = "active" cls (GET.Opened _) = "active"
cls _ = "" cls _ = ""
...@@ -157,8 +213,8 @@ sidebarToggleButton (state /\ setState) = R.createElement el {} [] ...@@ -157,8 +213,8 @@ sidebarToggleButton (state /\ setState) = R.createElement el {} []
text _on off GET.InitialClosed = off text _on off GET.InitialClosed = off
text _on off GET.Closed = off text _on off GET.Closed = off
onClick = \_ -> do onClick state = \_ ->
setState $ \s -> case s of T2.modify_ (\s -> case s of
GET.InitialClosed -> GET.Opened GET.SideTabLegend GET.InitialClosed -> GET.Opened GET.SideTabLegend
GET.Closed -> GET.Opened GET.SideTabLegend GET.Closed -> GET.Opened GET.SideTabLegend
(GET.Opened _) -> GET.Closed (GET.Opened _) -> GET.Closed) state
...@@ -21,6 +21,7 @@ import Gargantext.Hooks.Loader as GHL ...@@ -21,6 +21,7 @@ import Gargantext.Hooks.Loader as GHL
import Gargantext.Sessions (Session, Sessions, Action(Logout), unSessions) import Gargantext.Sessions (Session, Sessions, Action(Logout), unSessions)
import Gargantext.Sessions as Sessions import Gargantext.Sessions as Sessions
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Login" here = R2.here "Gargantext.Components.Login"
...@@ -109,7 +110,7 @@ renderBackend cursor backend@(Backend {name}) = ...@@ -109,7 +110,7 @@ renderBackend cursor backend@(Backend {name}) =
, H.td {} [ H.a { on: { click }} [ H.text (backendLabel name) ]] , H.td {} [ H.a { on: { click }} [ H.text (backendLabel name) ]]
, H.td {} [ H.text $ "garg://" <> name ]] where , H.td {} [ H.text $ "garg://" <> name ]] where
className = "fa fa-hand-o-right" -- "glyphitem fa fa-log-in" className = "fa fa-hand-o-right" -- "glyphitem fa fa-log-in"
click _ = T.write (Just backend) cursor click _ = T2.write_ (Just backend) cursor
backendLabel :: String -> String backendLabel :: String -> String
backendLabel = backendLabel =
......
...@@ -111,10 +111,10 @@ docViewCpt = here.component "docView" cpt ...@@ -111,10 +111,10 @@ docViewCpt = here.component "docView" cpt
NodePoly {hyperdata: Document doc} = document NodePoly {hyperdata: Document doc} = document
type LayoutProps = type LayoutProps =
( listId :: ListId ( listId :: ListId
, corpusId :: Maybe NodeID , mCorpusId :: Maybe NodeID
, nodeId :: NodeID , nodeId :: NodeID
, session :: R.Context Session , session :: R.Context Session
) )
documentMainLayout :: R2.Component LayoutProps documentMainLayout :: R2.Component LayoutProps
...@@ -129,14 +129,14 @@ documentLayout = R.createElement documentLayoutCpt ...@@ -129,14 +129,14 @@ documentLayout = R.createElement documentLayoutCpt
documentLayoutCpt :: R.Component LayoutProps documentLayoutCpt :: R.Component LayoutProps
documentLayoutCpt = here.component "documentLayout" cpt where documentLayoutCpt = here.component "documentLayout" cpt where
cpt { listId, corpusId, nodeId, session } children = cp <$> R.useContext session where cpt { listId, mCorpusId, nodeId, session } children = cp <$> R.useContext session where
cp s = documentLayoutWithKey { key, listId, corpusId, nodeId, session: s } children where cp s = documentLayoutWithKey { key, listId, mCorpusId, nodeId, session: s } children where
key = show (sessionId s) <> "-" <> show nodeId key = show (sessionId s) <> "-" <> show nodeId
type KeyLayoutProps = type KeyLayoutProps =
( key :: String ( key :: String
, listId :: ListId , listId :: ListId
, corpusId :: Maybe NodeID , mCorpusId :: Maybe NodeID
, nodeId :: NodeID , nodeId :: NodeID
, session :: Session , session :: Session
) )
...@@ -147,12 +147,12 @@ documentLayoutWithKey = R.createElement documentLayoutWithKeyCpt ...@@ -147,12 +147,12 @@ documentLayoutWithKey = R.createElement documentLayoutWithKeyCpt
documentLayoutWithKeyCpt :: R.Component KeyLayoutProps documentLayoutWithKeyCpt :: R.Component KeyLayoutProps
documentLayoutWithKeyCpt = here.component "documentLayoutWithKey" cpt documentLayoutWithKeyCpt = here.component "documentLayoutWithKey" cpt
where where
cpt { listId, corpusId, nodeId, session } _ = do cpt { listId, mCorpusId, nodeId, session } _ = do
useLoader path loadData $ \loaded -> useLoader path loadData $ \loaded ->
docViewWrapper { loaded, path } [] docViewWrapper { loaded, path } []
where where
tabType = TabDocument (TabNgramType CTabTerms) tabType = TabDocument (TabNgramType CTabTerms)
path = { listIds: [listId], corpusId, nodeId, session, tabType } path = { listIds: [listId], mCorpusId, nodeId, session, tabType }
------------------------------------------------------------------------ ------------------------------------------------------------------------
......
...@@ -12,12 +12,12 @@ import Gargantext.Components.NgramsTable.Core (CoreState, Versioned(..) , Versio ...@@ -12,12 +12,12 @@ import Gargantext.Components.NgramsTable.Core (CoreState, Versioned(..) , Versio
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (ListId, NodeID, TabType) import Gargantext.Types (ListId, NodeID, TabType)
type DocPath = type DocPath = {
{ listIds :: Array ListId listIds :: Array ListId
, corpusId :: Maybe NodeID , mCorpusId :: Maybe NodeID
, nodeId :: NodeID , nodeId :: NodeID
, session :: Session , session :: Session
, tabType :: TabType , tabType :: TabType
} }
type NodeDocument = NodePoly Document type NodeDocument = NodePoly Document
......
...@@ -37,8 +37,8 @@ here :: R2.Here ...@@ -37,8 +37,8 @@ here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Texts" here = R2.here "Gargantext.Components.Nodes.Texts"
-------------------------------------------------------- --------------------------------------------------------
type TextsWithForest a = type TextsWithForest = (
( forestProps :: Record (Forest.LayoutProps a) forestProps :: Record Forest.LayoutProps
, textsProps :: Record CommonProps , textsProps :: Record CommonProps
) )
...@@ -77,34 +77,37 @@ topBarCpt = here.component "topBar" cpt ...@@ -77,34 +77,37 @@ topBarCpt = here.component "topBar" cpt
type CommonProps = type CommonProps = (
( frontends :: Frontends frontends :: Frontends
, nodeId :: Int , nodeId :: NodeID
, session :: R.Context Session , session :: Session
) )
type Props = ( controls :: Record TextsLayoutControls | CommonProps ) type Props = ( controls :: Record TextsLayoutControls | CommonProps )
type KeyProps =
( key :: String
, controls :: Record TextsLayoutControls
, frontends :: Frontends
, nodeId :: Int
, session :: Session
)
textsLayout :: R2.Component Props textsLayout :: R2.Component Props
textsLayout = R.createElement textsLayoutCpt textsLayout = R.createElement textsLayoutCpt
textsLayoutCpt :: R.Component Props textsLayoutCpt :: R.Component Props
textsLayoutCpt = here.component "textsLayout" cpt where textsLayoutCpt = here.component "textsLayout" cpt where
cpt { controls, frontends, nodeId, session, sessionUpdate } children = do cpt { controls, frontends, nodeId, session } children = do
session' <- R.useContext session pure $ textsLayoutWithKey { controls
pure $ , frontends
textsLayoutWithKey , key
{ controls, frontends, key, nodeId, session: session' } children where , nodeId
key = show sid <> "-" <> show nodeId where , session } children
sid = sessionId session where
key = show sid <> "-" <> show nodeId
where
sid = sessionId session
type KeyProps = (
key :: String
, controls :: Record TextsLayoutControls
, frontends :: Frontends
, nodeId :: NodeID
, session :: Session
)
textsLayoutWithKey :: R2.Component KeyProps textsLayoutWithKey :: R2.Component KeyProps
textsLayoutWithKey = R.createElement textsLayoutWithKeyCpt textsLayoutWithKey = R.createElement textsLayoutWithKeyCpt
...@@ -112,7 +115,7 @@ textsLayoutWithKey = R.createElement textsLayoutWithKeyCpt ...@@ -112,7 +115,7 @@ textsLayoutWithKey = R.createElement textsLayoutWithKeyCpt
textsLayoutWithKeyCpt :: R.Component KeyProps textsLayoutWithKeyCpt :: R.Component KeyProps
textsLayoutWithKeyCpt = here.component "textsLayoutWithKey" cpt textsLayoutWithKeyCpt = here.component "textsLayoutWithKey" cpt
where where
cpt { controls, frontends, nodeId, session, sessionUpdate } _children = do cpt { controls, frontends, nodeId, session } _children = do
cacheState <- R.useState' $ getCacheState NT.CacheOff session nodeId cacheState <- R.useState' $ getCacheState NT.CacheOff session nodeId
pure $ loader { nodeId, session } loadCorpusWithChild $ pure $ loader { nodeId, session } loadCorpusWithChild $
...@@ -121,16 +124,27 @@ textsLayoutWithKeyCpt = here.component "textsLayoutWithKey" cpt ...@@ -121,16 +124,27 @@ textsLayoutWithKeyCpt = here.component "textsLayoutWithKey" cpt
CorpusInfo { authors, desc, query } = getCorpusInfo h.fields CorpusInfo { authors, desc, query } = getCorpusInfo h.fields
title = "Corpus " <> name title = "Corpus " <> name
R.fragment R.fragment
[ Table.tableHeaderLayout [ Table.tableHeaderLayout { afterCacheStateChange
{ afterCacheStateChange, cacheState, date, desc, query, title, user: authors , cacheState
, key: "textsLayoutWithKey-" <> (show $ fst cacheState) } , date
, tabs { cacheState, corpusData, corpusId, frontends, session , desc
, query
, title
, user: authors
, key: "textsLayoutWithKey-" <> (show $ fst cacheState) }
, tabs { cacheState
, corpusData
, corpusId
, frontends
, session
, sidePanelTriggers: controls.triggers } , sidePanelTriggers: controls.triggers }
] ]
where where
afterCacheStateChange cacheState = do afterCacheStateChange cacheState = do
launchAff_ $ clearCache unit launchAff_ $ clearCache unit
sessionUpdate $ setCacheState session nodeId cacheState -- TODO
--sessionUpdate $ setCacheState session nodeId cacheState
--_ <- setCacheState session nodeId cacheState
data Mode = MoreLikeFav | MoreLikeTrash data Mode = MoreLikeFav | MoreLikeTrash
...@@ -148,7 +162,7 @@ modeTabType MoreLikeTrash = CTabSources -- TODO ...@@ -148,7 +162,7 @@ modeTabType MoreLikeTrash = CTabSources -- TODO
type TabsProps = type TabsProps =
( cacheState :: R.State NT.CacheState ( cacheState :: R.State NT.CacheState
, corpusData :: CorpusData , corpusData :: CorpusData
, corpusId :: Int , corpusId :: NodeID
, frontends :: Frontends , frontends :: Frontends
, session :: Session , session :: Session
, sidePanelTriggers :: Record SidePanelTriggers , sidePanelTriggers :: Record SidePanelTriggers
...@@ -391,9 +405,9 @@ sidePanelCpt = here.component "sidePanel" cpt ...@@ -391,9 +405,9 @@ sidePanelCpt = here.component "sidePanel" cpt
] ]
type SidePanelDocView = ( type SidePanelDocView = (
corpusId :: Maybe NodeID mCorpusId :: Maybe NodeID
, listId :: Maybe ListId , mListId :: Maybe ListId
, nodeId :: Maybe NodeID , mNodeId :: Maybe NodeID
, session :: Session , session :: Session
) )
...@@ -403,15 +417,16 @@ sidePanelDocView = R.createElement sidePanelDocViewCpt ...@@ -403,15 +417,16 @@ sidePanelDocView = R.createElement sidePanelDocViewCpt
sidePanelDocViewCpt :: R.Component SidePanelDocView sidePanelDocViewCpt :: R.Component SidePanelDocView
sidePanelDocViewCpt = here.component "sidePanelDocView" cpt sidePanelDocViewCpt = here.component "sidePanelDocView" cpt
where where
cpt { listId: Nothing } _ = do cpt { mListId: Nothing } _ = do
pure $ H.div {} [] pure $ H.div {} []
cpt { nodeId: Nothing } _ = do cpt { mNodeId: Nothing } _ = do
pure $ H.div {} [] pure $ H.div {} []
cpt { corpusId cpt { mCorpusId
, listId: Just listId , mListId: Just listId
, nodeId: Just nodeId , mNodeId: Just nodeId
, session } _ = do , session } _ = do
let session' = R.createContext session
pure $ D.documentLayout { listId pure $ D.documentLayout { listId
, corpusId , mCorpusId
, nodeId , nodeId
, session } [] , session: session' } []
...@@ -23,11 +23,13 @@ import Effect.Uncurried (mkEffectFn1) ...@@ -23,11 +23,13 @@ import Effect.Uncurried (mkEffectFn1)
import Math as M import Math as M
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Utils.Math (roundToMultiple) import Gargantext.Utils.Math (roundToMultiple)
import Gargantext.Utils.Range as Range import Gargantext.Utils.Range as Range
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.RangeSlider" here = R2.here "Gargantext.Components.RangeSlider"
-- data Axis = X | Y -- data Axis = X | Y
......
...@@ -4,9 +4,12 @@ import Data.Array (fromFoldable) ...@@ -4,9 +4,12 @@ import Data.Array (fromFoldable)
import Data.Maybe (Maybe(..), maybe') import Data.Maybe (Maybe(..), maybe')
import Reactix as R import Reactix as R
import Toestand as T import Toestand as T
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.App.Data (Cursors, Views)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (Cursors)
import Gargantext.Components.Footer (footer) import Gargantext.Components.Footer (footer)
import Gargantext.Components.Forest (forestLayout, forestLayoutWithTopBar) import Gargantext.Components.Forest (forestLayout, forestLayoutWithTopBar)
import Gargantext.Components.GraphExplorer (explorerLayout) import Gargantext.Components.GraphExplorer (explorerLayout)
...@@ -23,10 +26,12 @@ import Gargantext.Components.Nodes.Frame (frameLayout) ...@@ -23,10 +26,12 @@ import Gargantext.Components.Nodes.Frame (frameLayout)
import Gargantext.Components.Nodes.Home (homeLayout) import Gargantext.Components.Nodes.Home (homeLayout)
import Gargantext.Components.Nodes.Lists as Lists import Gargantext.Components.Nodes.Lists as Lists
import Gargantext.Components.Nodes.Texts as Texts import Gargantext.Components.Nodes.Texts as Texts
import Gargantext.Components.SessionLoader (sessionWrapper)
import Gargantext.Components.SimpleLayout (simpleLayout) import Gargantext.Components.SimpleLayout (simpleLayout)
import Gargantext.Config (defaultFrontends, defaultBackends, publicBackend) import Gargantext.Config (defaultFrontends, defaultBackends, publicBackend)
import Gargantext.Routes (AppRoute(..)) import Gargantext.Routes (AppRoute(..))
import Gargantext.Types (NodeType(..)) import Gargantext.Routes as GR
import Gargantext.Types (CorpusId, ListId, NodeID, NodeType(..), SessionId(..))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2 import Gargantext.Utils.Toestand as T2
...@@ -34,43 +39,43 @@ here :: R2.Here ...@@ -34,43 +39,43 @@ here :: R2.Here
here = R2.here "Gargantext.Components.Router" here = R2.here "Gargantext.Components.Router"
type Props = ( type Props = (
cursors :: App.Cursors cursors :: Cursors
, tasks :: T.Cursor (Maybe GAT.Reductor) , tasks :: T.Cursor (Maybe GAT.Reductor)
, views :: App.Views , views :: App.Views
) )
router :: R2.Leaf Props router :: R2.Leaf Props
router props = R.createComponent routerCpt props [] router props = R.createElement routerCpt props []
routerCpt :: R.Component Props routerCpt :: R.Component Props
routerCpt = here.component "root" cpt where routerCpt = here.component "root" cpt where
cpt props@{ cursors, views, tasks } _ = do cpt props@{ cursors, views, tasks } _ = do
let session = R.createContext (unsafeCoerce {}) let session = R.createContext (unsafeCoerce {})
showLogin <- T.useLive (T2.ne) views.showLogin showLogin <- T.useLive T.unequal views.showLogin
route <- T.useLive (T.changed notEq) views.route route <- T.useLive (T.changed notEq) views.route
if showLogin then login' cursors views if showLogin then login' cursors views
else case route of else case route of
Annuaire s n -> annuaire props s n GR.Annuaire s n -> annuaire props s n
Corpus s n -> corpus props s n GR.Corpus s n -> corpus props s n
CorpusDocument s c l n -> corpusDocument props s c l n GR.CorpusDocument s c l n -> corpusDocument props s c l n
Dashboard s n -> dashboard props s n GR.Dashboard s n -> dashboard props s n
Document s l n -> document props s l n GR.Document s l n -> document props s l n
Folder s n -> corpus props s n GR.Folder s n -> corpus props s n
FolderPrivate s n -> corpus props s n GR.FolderPrivate s n -> corpus props s n
FolderPublic s n -> corpus props s n GR.FolderPublic s n -> corpus props s n
FolderShared s n -> corpus props s n GR.FolderShared s n -> corpus props s n
Home -> home props GR.Home -> home props
Lists s n -> lists props s n GR.Lists s n -> lists props s n
Login -> login' cursors GR.Login -> login' cursors
PGraphExplorer s g -> graphExplorer props s g GR.PGraphExplorer s g -> graphExplorer props s g
RouteFile s n -> routeFile props s n GR.RouteFile s n -> routeFile props s n
RouteFrameCalc s n -> routeFrame props s n NodeFrameCalc GR.RouteFrameCalc s n -> routeFrame props s n NodeFrameCalc
RouteFrameCode s n -> routeFrame props s n NodeFrameNotebook GR.RouteFrameCode s n -> routeFrame props s n NodeFrameNotebook
RouteFrameWrite s n -> routeFrame props s n NodeFrameWrite GR.RouteFrameWrite s n -> routeFrame props s n NodeFrameWrite
Team s n -> team props s n GR.Team s n -> team props s n
Texts s n -> texts props s n GR.Texts s n -> texts props s n
UserPage s n -> user props s n GR.UserPage s n -> user props s n
ContactPage s a n -> contact props s a n GR.ContactPage s a n -> contact props s a n
forested :: Record Props -> Array R.Element -> R.Element forested :: Record Props -> Array R.Element -> R.Element
forested { tasks, views: { route, handed, sessions } forested { tasks, views: { route, handed, sessions }
...@@ -86,31 +91,31 @@ authed props@{ cursors: { session }, views: views@{ sessions } ...@@ -86,31 +91,31 @@ authed props@{ cursors: { session }, views: views@{ sessions }
sessionWrapper { sessionId, session, sessions, fallback: home props } sessionWrapper { sessionId, session, sessions, fallback: home props }
[ content, footer { session: views.session } ] [ content, footer { session: views.session } ]
annuaire :: Record Props -> SessionId -> NodeId -> R.Element annuaire :: Record Props -> SessionId -> NodeID -> R.Element
annuaire props@{ tasks, cursors, views: { session } } sessionId nodeId = annuaire props@{ tasks, cursors, views: { session } } sessionId nodeId =
authed props sessionId $ authed props sessionId $
forested props [ annuaireLayout { nodeId, frontends, session } ] forested props [ annuaireLayout { nodeId, frontends, session } ]
where frontends = defaultFrontends where frontends = defaultFrontends
corpus :: Record Props -> SessionId -> NodeId -> R.Element corpus :: Record Props -> SessionId -> NodeID -> R.Element
corpus props@{ tasks, cursors, views } sessionId nodeId = corpus props@{ tasks, cursors, views } sessionId nodeId =
authed props sessionId $ authed props sessionId $
forested props forested props
[ corpusLayout { nodeId, session: views.session } ] [ corpusLayout { nodeId, session: views.session } ]
corpusDocument :: Record Props -> SessionId -> CorpusId -> ListId -> NodeId -> R.Element corpusDocument :: Record Props -> SessionId -> CorpusId -> ListId -> NodeID -> R.Element
corpusDocument props@{ tasks, cursors, views } sessionId corpusId' listId nodeId = corpusDocument props@{ tasks, cursors, views } sessionId corpusId' listId nodeId =
authed props sessionId $ authed props sessionId $
forested props forested props
[ documentMainLayout { listId, nodeId, corpusId, sessionId, session } [] ] [ documentMainLayout { listId, nodeId, corpusId, sessionId, session: views.session } [] ]
where corpusId = Just corpusId' where corpusId = Just corpusId'
dashboard :: Record Props -> SessionId -> NodeId -> R.Element dashboard :: Record Props -> SessionId -> NodeID -> R.Element
dashboard props@{ tasks, cursors, views: { session } } sessionId nodeId = dashboard props@{ tasks, cursors, views: { session } } sessionId nodeId =
authed props sessionId $ authed props sessionId $
forested props [ dashboardLayout { nodeId, session } [] ] forested props [ dashboardLayout { nodeId, session } [] ]
document :: Record Props -> SessionId -> ListId -> NodeId -> R.Element document :: Record Props -> SessionId -> ListId -> NodeID -> R.Element
document props@{ tasks, cursors, views: { session } } sessionId listId nodeId = document props@{ tasks, cursors, views: { session } } sessionId listId nodeId =
authed props sessionId $ authed props sessionId $
forested props forested props
...@@ -121,7 +126,7 @@ home :: Record Props -> R.Element ...@@ -121,7 +126,7 @@ home :: Record Props -> R.Element
home props@{ cursors: { backend, showLogin }, views: { sessions } } = home props@{ cursors: { backend, showLogin }, views: { sessions } } =
forested props [ homeLayout { sessions, backend, showLogin, lang: LL_EN } ] forested props [ homeLayout { sessions, backend, showLogin, lang: LL_EN } ]
lists :: Record Props -> SessionId -> NodeId -> R.Element lists :: Record Props -> SessionId -> NodeID -> R.Element
lists props@{ tasks lists props@{ tasks
, cursors: { reloadForest, reloadRoot, session, showLogin } , cursors: { reloadForest, reloadRoot, session, showLogin }
, views: { backend, route, handed, sessions } } sessionId nodeId = , views: { backend, route, handed, sessions } } sessionId nodeId =
...@@ -154,19 +159,19 @@ graphExplorer props@{ views: { backend, route, handed, session, sessions } ...@@ -154,19 +159,19 @@ graphExplorer props@{ views: { backend, route, handed, session, sessions }
, handed, session, sessions, showLogin } ] , handed, session, sessions, showLogin } ]
where frontends = defaultFrontends where frontends = defaultFrontends
routeFile :: Record Props -> SessionId -> NodeId -> R.Element routeFile :: Record Props -> SessionId -> NodeID -> R.Element
routeFile props@{ views: { session } } sessionId nodeId = routeFile props@{ views: { session } } sessionId nodeId =
authed props sessionId $ forested props [ fileLayout { nodeId, session } ] authed props sessionId $ forested props [ fileLayout { nodeId, session } ]
routeFrame :: Record Props -> SessionId -> NodeId -> NodeType -> R.Element routeFrame :: Record Props -> SessionId -> NodeID -> NodeType -> R.Element
routeFrame Type props@{ views: { session } } sessionId nodeId nodeType = routeFrame props@{ views: { session } } sessionId nodeId nodeType =
authed props sessionId $ forested props [ frameLayout { nodeId, nodeType, session } ] authed props sessionId $ forested props [ frameLayout { nodeId, nodeType, session } ]
team :: Record Props -> SessionId -> NodeId -> R.Element team :: Record Props -> SessionId -> NodeID -> R.Element
team props@{ tasks, cursors, views: { session } } sessionId nodeId = team props@{ tasks, cursors, views: { session } } sessionId nodeId =
authed props sessionId $ forested props [ corpusLayout { nodeId, session } ] authed props sessionId $ forested props [ corpusLayout { nodeId, session } ]
texts :: Record Props -> SessionId -> NodeId -> R.Element texts :: Record Props -> SessionId -> NodeID -> R.Element
texts props@{ cursors: { backend, reloadForest, reloadRoot, showLogin } texts props@{ cursors: { backend, reloadForest, reloadRoot, showLogin }
, views: { route, handed, session, sessions } , views: { route, handed, session, sessions }
, tasks } sessionId nodeId = , tasks } sessionId nodeId =
...@@ -177,14 +182,14 @@ texts props@{ cursors: { backend, reloadForest, reloadRoot, showLogin } ...@@ -177,14 +182,14 @@ texts props@{ cursors: { backend, reloadForest, reloadRoot, showLogin }
, textsProps: { frontends, nodeId, session } } , textsProps: { frontends, nodeId, session } }
[] where frontends = defaultFrontends [] where frontends = defaultFrontends
user :: Record Props -> SessionId -> NodeId -> R.Element user :: Record Props -> SessionId -> NodeID -> R.Element
user props@props sessionId nodeId = user props@{ cursors: { reloadRoot }, tasks, views } sessionId nodeId =
authed { tasks, cursors: { reloadRoot }, views: { session } } sessionId $ authed props sessionId $
forested props forested props
[ userLayout { tasks, nodeId, session, reloadRoot, frontends } ] [ userLayout { tasks, nodeId, session: views.session, reloadRoot, frontends } ]
where frontends = defaultFrontends where frontends = defaultFrontends
contact :: Record Props -> SessionId -> NodeId -> R.Element contact :: Record Props -> SessionId -> NodeID -> R.Element
contact props@{ tasks, cursors: { reloadRoot } } sessionId annuaireId nodeId = contact props@{ tasks, cursors: { reloadRoot } } sessionId annuaireId nodeId =
authed props sessionId $ authed props sessionId $
forested props forested props
......
...@@ -10,6 +10,7 @@ import Gargantext.Prelude (class Eq, class Read, class Show) ...@@ -10,6 +10,7 @@ import Gargantext.Prelude (class Eq, class Read, class Show)
import Gargantext.Components.Category.Types (Category) import Gargantext.Components.Category.Types (Category)
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson, genericEnumDecodeJson, genericEnumEncodeJson) import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson, genericEnumDecodeJson, genericEnumEncodeJson)
import Gargantext.Utils.Toestand as T2
-- Example: -- Example:
......
...@@ -12,8 +12,8 @@ import Gargantext.Utils.Reactix as R2 ...@@ -12,8 +12,8 @@ import Gargantext.Utils.Reactix as R2
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Tab" here = R2.here "Gargantext.Components.Tab"
type TabsProps = type TabsProps = (
( selected :: Int selected :: Int
, tabs :: Array (Tuple String R.Element) , tabs :: Array (Tuple String R.Element)
) )
......
...@@ -41,8 +41,8 @@ stateParams {pageSize, page, orderBy, searchType} = {offset, limit, orderBy, sea ...@@ -41,8 +41,8 @@ stateParams {pageSize, page, orderBy, searchType} = {offset, limit, orderBy, sea
limit = pageSizes2Int pageSize limit = pageSizes2Int pageSize
offset = limit * (page - 1) offset = limit * (page - 1)
type TableHeaderLayoutProps = type TableHeaderLayoutProps = (
( afterCacheStateChange :: NT.CacheState -> Effect Unit afterCacheStateChange :: NT.CacheState -> Effect Unit
, cacheState :: R.State NT.CacheState , cacheState :: R.State NT.CacheState
, date :: String , date :: String
, desc :: String , desc :: String
......
...@@ -13,6 +13,7 @@ import Gargantext.Prelude ...@@ -13,6 +13,7 @@ import Gargantext.Prelude
import Gargantext.Components.Themes (themeSwitcher, defaultTheme, allThemes) import Gargantext.Components.Themes (themeSwitcher, defaultTheme, allThemes)
import Gargantext.Types (Handed(..), reverseHanded) import Gargantext.Types (Handed(..), reverseHanded)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.TopBar" here = R2.here "Gargantext.Components.TopBar"
...@@ -248,6 +249,6 @@ handedChooserCpt = here.component "handedChooser" cpt ...@@ -248,6 +249,6 @@ handedChooserCpt = here.component "handedChooser" cpt
handedClass LeftHanded = "fa fa-hand-o-left" handedClass LeftHanded = "fa fa-hand-o-left"
handedClass RightHanded = "fa fa-hand-o-right" handedClass RightHanded = "fa fa-hand-o-right"
onClick handed = T.modify (\h -> case h of onClick handed = T2.modify_ (\h -> case h of
LeftHanded -> RightHanded LeftHanded -> RightHanded
RightHanded -> LeftHanded) handed RightHanded -> LeftHanded) handed
...@@ -6,11 +6,13 @@ import Routing.Match (Match) ...@@ -6,11 +6,13 @@ import Routing.Match (Match)
import Routing.Hash (matches) import Routing.Hash (matches)
import Toestand as T import Toestand as T
import Gargantext.Utils.Toestand as T2
-- | Sets up the hash router so it writes the route to the given cell. -- | Sets up the hash router so it writes the route to the given cell.
-- | Note: if it gets sent to an unrecognised url, it will quietly -- | Note: if it gets sent to an unrecognised url, it will quietly
-- | drop the change. -- | drop the change.
useHashRouter :: forall r c. T.Write c r => Match r -> c -> R.Hooks Unit useHashRouter :: forall r c. T.Write c r => Match r -> c -> R.Hooks Unit
useHashRouter routes cell = R.useEffectOnce $ matches routes h where useHashRouter routes cell = R.useEffectOnce $ matches routes h where
h _old new = void $ T.write new cell h _old new = T2.write_ new cell
-- useSession cell = -- useSession cell =
...@@ -22,10 +22,12 @@ import Effect.Class.Console (error) ...@@ -22,10 +22,12 @@ import Effect.Class.Console (error)
import Effect.Timer (TimeoutId, clearTimeout) import Effect.Timer (TimeoutId, clearTimeout)
import FFI.Simple ((.=)) import FFI.Simple ((.=))
import Reactix as R import Reactix as R
import Toestand as T
import Gargantext.Hooks.Sigmax.Sigma as Sigma import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Hooks.Sigmax.Types as ST import Gargantext.Hooks.Sigmax.Types as ST
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
type Sigma = type Sigma =
{ sigma :: R.Ref (Maybe Sigma.Sigma) { sigma :: R.Ref (Maybe Sigma.Sigma)
...@@ -112,9 +114,10 @@ dependOnContainer container notFoundMsg f = do ...@@ -112,9 +114,10 @@ dependOnContainer container notFoundMsg f = do
-- | 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.
--handleForceAtlasPause sigmaRef (toggled /\ setToggled) mFAPauseRef = do --handleForceAtlasPause sigmaRef (toggled /\ setToggled) mFAPauseRef = do
handleForceAtlas2Pause :: R.Ref Sigma -> R.State ST.ForceAtlasState -> R.Ref (Maybe TimeoutId) -> Effect Unit handleForceAtlas2Pause :: R.Ref Sigma -> T.Cursor ST.ForceAtlasState -> R.Ref (Maybe TimeoutId) -> Effect Unit
handleForceAtlas2Pause sigmaRef (toggled /\ setToggled) mFAPauseRef = do handleForceAtlas2Pause sigmaRef forceAtlasState mFAPauseRef = do
let sigma = R.readRef sigmaRef let sigma = R.readRef sigmaRef
toggled <- T.read forceAtlasState
dependOnSigma sigma "[handleForceAtlas2Pause] sigma: Nothing" $ \s -> do dependOnSigma sigma "[handleForceAtlas2Pause] sigma: Nothing" $ \s -> do
--log2 "[handleForceAtlas2Pause] mSigma: Just " s --log2 "[handleForceAtlas2Pause] mSigma: Just " s
--log2 "[handleForceAtlas2Pause] toggled: " toggled --log2 "[handleForceAtlas2Pause] toggled: " toggled
...@@ -189,15 +192,15 @@ multiSelectUpdate new selected = foldl fld selected new ...@@ -189,15 +192,15 @@ multiSelectUpdate new selected = foldl fld selected new
Set.insert item selectedAcc Set.insert item selectedAcc
bindSelectedNodesClick :: Sigma.Sigma -> R.State ST.NodeIds -> R.Ref Boolean -> Effect Unit bindSelectedNodesClick :: Sigma.Sigma -> T.Cursor ST.NodeIds -> R.Ref Boolean -> Effect Unit
bindSelectedNodesClick sigma (_ /\ setNodeIds) multiSelectEnabledRef = bindSelectedNodesClick sigma selectedNodeIds multiSelectEnabledRef =
Sigma.bindClickNodes sigma $ \nodes -> do Sigma.bindClickNodes sigma $ \nodes -> do
let multiSelectEnabled = R.readRef multiSelectEnabledRef let multiSelectEnabled = R.readRef multiSelectEnabledRef
let nodeIds = Set.fromFoldable $ map _.id nodes let nodeIds = Set.fromFoldable $ map _.id nodes
if multiSelectEnabled then if multiSelectEnabled then
setNodeIds $ multiSelectUpdate nodeIds T2.modify_ (multiSelectUpdate nodeIds) selectedNodeIds
else else
setNodeIds $ const nodeIds T2.write_ nodeIds selectedNodeIds
bindSelectedEdgesClick :: R.Ref Sigma -> R.State ST.EdgeIds -> Effect Unit bindSelectedEdgesClick :: R.Ref Sigma -> R.State ST.EdgeIds -> Effect Unit
bindSelectedEdgesClick sigmaRef (_ /\ setEdgeIds) = bindSelectedEdgesClick sigmaRef (_ /\ setEdgeIds) =
......
...@@ -34,12 +34,12 @@ import Gargantext.Components.Nodes.Lists.Types as NT ...@@ -34,12 +34,12 @@ import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Config.REST as REST import Gargantext.Config.REST as REST
import Gargantext.Ends (class ToUrl, Backend, toUrl) import Gargantext.Ends (class ToUrl, Backend, toUrl)
import Gargantext.Utils.Reactix (getls) import Gargantext.Utils.Reactix (getls)
import Gargantext.Utils.Toestand as T2
load :: forall c. T.Write c Sessions => c -> Effect Sessions load :: forall c. T.Write c Sessions => c -> Effect Sessions
load cell = do load cell = do
sessions <- loadSessions sessions <- loadSessions
_ <- T.write sessions cell T.write sessions cell
pure sessions
change change
:: forall c :: forall c
......
...@@ -16,6 +16,9 @@ instance closedRange :: Ord t => Range (Closed t) t where ...@@ -16,6 +16,9 @@ instance closedRange :: Ord t => Range (Closed t) t where
clamp (Closed r) = max r.min <<< min r.max clamp (Closed r) = max r.min <<< min r.max
within (Closed r) v = (v <= r.max) && (v >= r.min) within (Closed r) v = (v <= r.max) && (v >= r.min)
instance eqRange :: Eq t => Eq (Closed t) where
eq (Closed r1) (Closed r2) = (r1.min == r2.min) && (r1.max == r2.max)
type NumberRange = Closed Number type NumberRange = Closed Number
range :: NumberRange -> Number range :: NumberRange -> Number
......
...@@ -8,6 +8,8 @@ import Effect (Effect) ...@@ -8,6 +8,8 @@ import Effect (Effect)
import Reactix as R import Reactix as R
import Toestand as T import Toestand as T
import Gargantext.Utils.Toestand as T2
type Reload = Int type Reload = Int
type ReloadS = R.State Reload type ReloadS = R.State Reload
type ReloadSRef = R.Ref type ReloadSRef = R.Ref
...@@ -19,9 +21,7 @@ bump :: ReloadS -> Effect Unit ...@@ -19,9 +21,7 @@ bump :: ReloadS -> Effect Unit
bump (_ /\ setReload) = setReload (_ + 1) bump (_ /\ setReload) = setReload (_ + 1)
bumpCursor :: T.Cursor Reload -> Effect Unit bumpCursor :: T.Cursor Reload -> Effect Unit
bumpCursor c = do bumpCursor c = T2.modify_ (_ + 1) c
_ <- T.modify (_ + 1) c
pure unit
value :: ReloadS -> Reload value :: ReloadS -> Reload
value (val /\ _) = val value (val /\ _) = val
......
...@@ -2,6 +2,7 @@ module Gargantext.Utils.Toestand ...@@ -2,6 +2,7 @@ module Gargantext.Utils.Toestand
( class Reloadable, reload ( class Reloadable, reload
, Reload, newReload, InitReload(..), ready , Reload, newReload, InitReload(..), ready
, useCursed, useIdentityCursor, useMemberCursor , useCursed, useIdentityCursor, useMemberCursor
, write_, modify_
) where ) where
import Prelude (class Ord, Unit, bind, identity, pure, unit, void, ($), (+), (>>=)) import Prelude (class Ord, Unit, bind, identity, pure, unit, void, ($), (+), (>>=))
...@@ -22,10 +23,10 @@ newReload :: Reload ...@@ -22,10 +23,10 @@ newReload :: Reload
newReload = 0 newReload = 0
instance reloadableCellReload :: Reloadable (T.Cell Int) where instance reloadableCellReload :: Reloadable (T.Cell Int) where
reload cell = void $ T.modify (_ + 1) cell reload cell = modify_ (_ + 1) cell
instance reloadableCursorReload :: Reloadable (T.Cursor Int) where instance reloadableCursorReload :: Reloadable (T.Cursor Int) where
reload cell = void $ T.modify (_ + 1) cell reload cell = modify_ (_ + 1) cell
instance reloadableInitReloadCell :: Reloadable (c Reload) => Reloadable (T.Cell (InitReload c)) where instance reloadableInitReloadCell :: Reloadable (c Reload) => Reloadable (T.Cell (InitReload c)) where
reload cell = do reload cell = do
...@@ -51,7 +52,7 @@ ready :: forall cell c. T.ReadWrite cell (InitReload c) => T.ReadWrite (c Reload ...@@ -51,7 +52,7 @@ ready :: forall cell c. T.ReadWrite cell (InitReload c) => T.ReadWrite (c Reload
ready cell with = do ready cell with = do
val <- T.read cell val <- T.read cell
case val of case val of
Init -> void $ T.write (Ready with) cell Init -> write_ (Ready with) cell
Ready _ -> pure unit Ready _ -> pure unit
-- | Turns a Cell into a Cursor. -- | Turns a Cell into a Cursor.
...@@ -74,3 +75,9 @@ useMemberCursor val cell = T.useCursor (Set.member val) (toggleSet val) cell ...@@ -74,3 +75,9 @@ useMemberCursor val cell = T.useCursor (Set.member val) (toggleSet val) cell
toggleSet :: forall s. Ord s => s -> Boolean -> Set s -> Set s toggleSet :: forall s. Ord s => s -> Boolean -> Set s -> Set s
toggleSet val true set = Set.insert val set toggleSet val true set = Set.insert val set
toggleSet val false set = Set.delete val set toggleSet val false set = Set.delete val set
modify_ :: forall cell val. T.ReadWrite cell val => (val -> val) -> cell -> Effect Unit
modify_ f cell = void $ T.modify f cell
write_ :: forall cell val. T.Write cell val => val -> cell -> Effect Unit
write_ val cell = void $ T.write val cell
module Gargantext.Utils.Spec where module Gargantext.Utils.Spec where
import Prelude
import Data.Argonaut as Argonaut import Data.Argonaut as Argonaut
import Data.Argonaut.Decode.Error (JsonDecodeError) import Data.Argonaut.Decode.Error (JsonDecodeError)
import Data.Either (Either(..), isLeft) import Data.Either (Either(..), isLeft)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual)
import Gargantext.Prelude
import Gargantext.Utils as GU import Gargantext.Utils as GU
import Gargantext.Utils.Argonaut (genericEnumDecodeJson, genericEnumEncodeJson, genericSumDecodeJson, genericSumEncodeJson) import Gargantext.Utils.Argonaut (genericEnumDecodeJson, genericEnumEncodeJson, genericSumDecodeJson, genericSumEncodeJson)
import Gargantext.Utils.Crypto as Crypto import Gargantext.Utils.Crypto as Crypto
import Gargantext.Utils.Math as GUM import Gargantext.Utils.Math as GUM
import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual)
data Fruit data Fruit
= Boat { hi :: Int } = Boat { hi :: Int }
......
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