Commit c06adcf0 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[graph] reloading tree after ngrams are patched

parent d8f3c5da
......@@ -7,6 +7,7 @@ import Data.Foldable (intercalate)
import Data.Maybe (Maybe(..), maybe')
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Reactix as R
......@@ -50,7 +51,14 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
showLogin <- R.useState' false
showCorpus <- R.useState' false
let forested = forestLayout frontends (fst sessions) (fst route) (snd showLogin)
treeReload <- R.useState' 0
let forested child = forestLayout { child
, frontends
, reload: treeReload
, route: fst route
, sessions: fst sessions
, showLogin: snd showLogin }
let mCurrentRoute = fst route
let backends = fromFoldable defaultBackends
let ff f session = R.fragment [ f session, version { session } ]
......@@ -85,18 +93,32 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
withSession sid $
\session ->
simpleLayout $
explorerLayout { graphId, mCurrentRoute, session
, sessions: (fst sessions), frontends
, showLogin }
explorerLayout { frontends
, graphId
, mCurrentRoute
, session
, sessions: (fst sessions)
, showLogin
, treeReload }
type ForestLayoutProps =
(
child :: R.Element
, frontends :: Frontends
, reload :: R.State Int
, route :: AppRoute
, sessions :: Sessions
, showLogin :: R2.Setter Boolean
)
forestLayout :: Frontends -> Sessions -> AppRoute -> R2.Setter Boolean -> R.Element -> R.Element
forestLayout frontends sessions route showLogin child = do
forestLayout :: Record ForestLayoutProps -> R.Element
forestLayout { child, frontends, reload, route, sessions, showLogin } = do
R.fragment [ topBar {}, R2.row [main], footer { } ]
where
main =
R.fragment
[ H.div {className: "col-md-2", style: {paddingTop: "60px"}}
[ forest {sessions, route, frontends, showLogin } ]
[ forest { frontends, reload, route, sessions, showLogin } ]
, mainPage child
]
......
......@@ -7,17 +7,20 @@ import Data.Maybe (Maybe(..))
import Data.Set as Set
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Forest.Tree (treeView)
import Gargantext.Components.Forest.Tree.Node.Action (Reload)
import Gargantext.Ends (Frontends)
import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session(..), Sessions, OpenNodes, unSessions)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
type Props =
( frontends :: Frontends
, reload :: R.State Int
, route :: AppRoute
, sessions :: Sessions
, showLogin :: R2.Setter Boolean
......@@ -28,14 +31,14 @@ forest props = R.createElement forestCpt props []
forestCpt :: R.Component Props
forestCpt = R.hooksComponent "G.C.Forest.forest" cpt where
cpt {frontends, route, sessions, showLogin } _ = do
cpt { frontends, reload: extReload, route, sessions, showLogin } _ = do
-- NOTE: this is a hack to reload the tree view on demand
reload <- R.useState' (0 :: Reload)
openNodes <- R2.useLocalStorageState R2.openNodesKey (Set.empty :: OpenNodes)
R2.useCache
(frontends /\ route /\ sessions /\ fst openNodes /\ fst reload)
(frontends /\ route /\ sessions /\ fst openNodes /\ fst extReload /\ fst reload)
(cpt' openNodes reload showLogin)
cpt' openNodes reload showLogin (frontends /\ route /\ sessions /\ _ /\ _) = do
cpt' openNodes reload showLogin (frontends /\ route /\ sessions /\ _ /\ _ /\ _) = do
pure $ R.fragment $ A.cons (plus showLogin) trees
where
trees = tree <$> unSessions sessions
......@@ -54,4 +57,4 @@ plus showLogin =
-- [ H.i { className: "material-icons md-36"} [] ]
where
click _ = do
showLogin (const true)
showLogin $ const true
......@@ -46,6 +46,7 @@ type LayoutProps =
, session :: Session
, sessions :: Sessions
, showLogin :: R.State Boolean
, treeReload :: R.State Int
)
type Props = (
......@@ -85,7 +86,7 @@ explorer props = R.createElement explorerCpt props []
explorerCpt :: R.Component Props
explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
where
cpt props@{frontends, graph, graphId, graphVersion, mCurrentRoute, mMetaData, session, sessions, showLogin } _ = do
cpt props@{frontends, graph, graphId, graphVersion, mCurrentRoute, mMetaData, session, sessions, showLogin, treeReload } _ = do
dataRef <- R.useRef graph
graphRef <- R.useRef null
graphVersionRef <- R.useRef (fst graphVersion)
......@@ -124,7 +125,12 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
]
, rowControls [ Controls.controls controls ]
, R2.row [
tree (fst controls.showTree) {sessions, mCurrentRoute, frontends} (snd showLogin)
tree { frontends
, mCurrentRoute
, reload: props.treeReload
, sessions
, show: fst controls.showTree
, showLogin: snd showLogin }
, RH.div { ref: graphRef, id: "graph-view", className: "col-md-12" } [] -- graph container
, graphView { controls
, elRef: graphRef
......@@ -140,6 +146,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
, session
, selectedNodeIds: controls.selectedNodeIds
, showSidePanel: fst controls.showSidePanel
, treeReload
}
]
]
......@@ -155,13 +162,12 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
pullLeft = RH.div { className: "pull-left" }
pullRight = RH.div { className: "pull-right" }
tree :: Boolean
-> {sessions :: Sessions, mCurrentRoute :: AppRoute, frontends :: Frontends}
-> R2.Setter Boolean
-> R.Element
tree false _ _ = RH.div { id: "tree" } []
tree true {sessions, mCurrentRoute: route, frontends} showLogin =
RH.div {className: "col-md-2 graph-tree"} [forest {sessions, route, frontends, showLogin }]
tree :: Record TreeProps -> R.Element
tree { show: false } = RH.div { id: "tree" } []
tree { frontends, mCurrentRoute: route, reload, sessions, showLogin } =
RH.div {className: "col-md-2 graph-tree"} [
forest { frontends, reload, route, sessions, showLogin }
]
mSidebar :: Maybe GET.MetaData
-> Record MSidebarProps
......@@ -170,6 +176,16 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
mSidebar (Just metaData) props =
Sidebar.sidebar (Record.merge props { metaData })
type TreeProps =
(
frontends :: Frontends
, mCurrentRoute :: AppRoute
, reload :: R.State Int
, sessions :: Sessions
, show :: Boolean
, showLogin :: R2.Setter Boolean
)
type MSidebarProps =
( frontends :: Frontends
, graph :: SigmaxT.SGraph
......@@ -179,6 +195,7 @@ type MSidebarProps =
, showSidePanel :: GET.SidePanelState
, selectedNodeIds :: R.State SigmaxT.NodeIds
, session :: Session
, treeReload :: R.State Int
)
type GraphProps = (
......
......@@ -13,16 +13,13 @@ import Data.Sequence as Seq
import Data.Set as Set
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Effect.Timer (setInterval)
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Components.GraphExplorer.API as GAPI
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Nodes.Corpus.Graph.Tabs (tabs) as CGT
......@@ -46,6 +43,7 @@ type Props =
, selectedNodeIds :: R.State SigmaxT.NodeIds
, session :: Session
, showSidePanel :: GET.SidePanelState
, treeReload :: R.State Int
)
sidebar :: Record Props -> R.Element
......@@ -131,7 +129,12 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
onClickRemove rType props nodesMap e = do
let nodes = mapMaybe (\id -> Map.lookup id nodesMap) $ Set.toUnfoldable $ fst props.selectedNodeIds
deleteNodes rType props.session props.metaData props.graphId nodes
deleteNodes { graphId: props.graphId
, metaData: props.metaData
, nodes
, session: props.session
, termList: rType
, treeReload: props.treeReload }
snd props.removedNodeIds $ const $ fst props.selectedNodeIds
snd props.selectedNodeIds $ const SigmaxT.emptyNodeIds
......@@ -156,30 +159,25 @@ neighbourBadges graph (selectedNodeIds /\ _) = SigmaxT.neighbours graph selected
where
selectedNodes = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
deleteNodes :: TermList -> Session -> GET.MetaData -> Int -> Array (Record SigmaxT.Node) -> Effect Unit
deleteNodes termList session metaData graphId nodes = do
-- launchAff_ do
-- task <- GAPI.graphAsyncUpdate { graphId, listId, nodes, termList, session, version }
-- liftEffect $ log2 "task" task
-- where
-- listId = metaData.list.listId
-- version = metaData.list.version
type DeleteNodes =
(
graphId :: Int
, metaData :: GET.MetaData
, nodes :: Array (Record SigmaxT.Node)
, session :: Session
, termList :: TermList
, treeReload :: R.State Int
)
deleteNodes :: Record DeleteNodes -> Effect Unit
deleteNodes { graphId, metaData, nodes, session, termList, treeReload } = do
launchAff_ do
patches <- (parTraverse (deleteNode termList session metaData) nodes) :: Aff (Array NTC.VersionedNgramsPatches)
let mPatch = last patches
case mPatch of
Nothing -> pure unit
Just (NTC.Versioned patch) -> do
task <- GAPI.graphAsyncRecompute { graphId, session }
_ <- liftEffect $ setInterval 1000 $ launchAff_ $ do
let (GT.AsyncTaskWithType { task: GT.AsyncTask { id } }) = task
asyncProgress@(GT.AsyncProgress {status}) <- GAPI.queryProgress { graphId, session, taskId: id }
liftEffect $ log2 "progress" asyncProgress
pure unit
--pure unit
--liftEffect do
--setGraphVersion $ const $ patch.version
liftEffect $ snd treeReload $ (+) 1
deleteNode :: TermList -> Session -> GET.MetaData -> Record SigmaxT.Node -> Aff NTC.VersionedNgramsPatches
deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches coreParams versioned
......
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