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