Commit a702dad5 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[toestand] some reloadForest/Root refactorign

parent ebb67a01
...@@ -79,18 +79,20 @@ data Action = ...@@ -79,18 +79,20 @@ data Action =
action :: Record ReductorProps -> Action -> Effect (Record ReductorProps) action :: Record ReductorProps -> Action -> Effect (Record ReductorProps)
action p@{ reloadForest, storage } (Insert nodeId t) = do action p@{ reloadForest, storage } (Insert nodeId t) = do
_ <- T2.reload reloadForest -- _ <- T2.reload reloadForest
let newStorage = Map.alter (maybe (Just [t]) (\ts -> Just $ A.cons t ts)) nodeId storage let newStorage = Map.alter (maybe (Just [t]) (\ts -> Just $ A.cons t ts)) nodeId storage
pure $ p { storage = newStorage } pure $ p { storage = newStorage }
action p (Finish nodeId t) = do action p (Finish nodeId t) = do
action p (Remove nodeId t) action p (Remove nodeId t)
action p@{ reloadRoot, reloadForest, storage } (Remove nodeId t@(GT.AsyncTaskWithType { typ })) = do action p@{ reloadRoot, reloadForest, storage } (Remove nodeId t@(GT.AsyncTaskWithType { typ })) = do
_ <- if GT.asyncTaskTriggersAppReload typ then _ <- if GT.asyncTaskTriggersAppReload typ then
T2.reload reloadRoot pure unit
-- T2.reload reloadRoot
else else
pure unit pure unit
_ <- if GT.asyncTaskTriggersTreeReload typ then _ <- if GT.asyncTaskTriggersTreeReload typ then
T2.reload reloadForest pure unit
-- T2.reload reloadForest
else else
pure unit pure unit
let newStorage = Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts t)) nodeId storage let newStorage = Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts t)) nodeId storage
......
...@@ -76,7 +76,7 @@ forestCpt = here.component "forest" cpt where ...@@ -76,7 +76,7 @@ forestCpt = here.component "forest" cpt where
-- T.write_ (Just tasks') tasks -- T.write_ (Just tasks') tasks
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
route' <- T.useLive T.unequal route route' <- T.useLive T.unequal route
forestOpen' <- T.useLive T.unequal forestOpen forestOpen' <- T.useLive T.unequal forestOpen
sessions' <- T.useLive T.unequal sessions sessions' <- T.useLive T.unequal sessions
...@@ -87,7 +87,7 @@ forestCpt = here.component "forest" cpt where ...@@ -87,7 +87,7 @@ forestCpt = here.component "forest" cpt where
-- R.setRef tasks $ Just tasks' -- R.setRef tasks $ Just tasks'
R2.useCache R2.useCache
( frontends /\ route' /\ sessions' /\ handed' /\ forestOpen' ( frontends /\ route' /\ sessions' /\ handed' /\ forestOpen'
/\ reloadForest' /\ reloadRoot' /\ (fst tasks).storage ) /\ reloadForest' /\ (fst tasks).storage )
(cp handed' sessions') (cp handed' sessions')
where where
common = RX.pick props :: Record Common common = RX.pick props :: Record Common
......
...@@ -77,9 +77,9 @@ treeLoaderCpt = here.component "treeLoader" cpt where ...@@ -77,9 +77,9 @@ treeLoaderCpt = here.component "treeLoader" cpt where
-- treeLoaderCpt = R.memo (here.component "treeLoader" cpt) memoCmp where -- treeLoaderCpt = R.memo (here.component "treeLoader" cpt) memoCmp where
-- memoCmp ({ root: t1 }) ({ root: t2 }) = t1 == t2 -- memoCmp ({ root: t1 }) ({ root: t2 }) = t1 == t2
cpt p@{ root, session } _ = do cpt p@{ root, session } _ = do
app <- T.useLive T.unequal p.reloadRoot -- app <- T.useLive T.unequal p.reloadRoot
let fetch { root: r } = getNodeTree session r let fetch { root: r } = getNodeTree session r
useLoader { app, root } fetch loaded where useLoader { root } fetch loaded where
loaded tree' = tree props where loaded tree' = tree props where
props = Record.merge common extra where props = Record.merge common extra where
common = RecordE.pick p :: Record Common common = RecordE.pick p :: Record Common
......
...@@ -147,7 +147,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt ...@@ -147,7 +147,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
-- case mT of -- case mT of
-- Just t' -> snd t' $ GAT.Finish id' t -- Just t' -> snd t' $ GAT.Finish id' t
-- Nothing -> pure unit -- Nothing -> pure unit
T2.reload reloadRoot -- T2.reload reloadRoot
SettingsBox {show: showBox} = settingsBox nodeType SettingsBox {show: showBox} = settingsBox nodeType
onPopoverClose popoverRef _ = Popover.setOpen popoverRef false onPopoverClose popoverRef _ = Popover.setOpen popoverRef false
......
...@@ -361,7 +361,7 @@ loadedNgramsTableCpt = here.component "loadedNgramsTable" cpt where ...@@ -361,7 +361,7 @@ loadedNgramsTableCpt = here.component "loadedNgramsTable" cpt where
totalRecords = fromMaybe (Seq.length rows) mTotalRows totalRecords = fromMaybe (Seq.length rows) mTotalRows
afterSync' _ = do afterSync' _ = do
chartsAfterSync path' tasks reloadForest unit chartsAfterSync path' tasks unit
afterSync unit afterSync unit
syncResetButton = syncResetButtons { afterSync: afterSync' syncResetButton = syncResetButtons { afterSync: afterSync'
......
...@@ -1141,7 +1141,8 @@ syncResetButtonsCpt :: R.Component SyncResetButtonsProps ...@@ -1141,7 +1141,8 @@ syncResetButtonsCpt :: R.Component SyncResetButtonsProps
syncResetButtonsCpt = here.component "syncResetButtons" cpt syncResetButtonsCpt = here.component "syncResetButtons" cpt
where where
cpt { afterSync, ngramsLocalPatch, performAction } _ = do cpt { afterSync, ngramsLocalPatch, performAction } _ = do
synchronizing@(s /\ setSynchronizing) <- R.useState' false -- synchronizing <- T.useBox false
-- synchronizing' <- T.useLive T.unequal synchronizing
let let
hasChanges = ngramsLocalPatch /= mempty hasChanges = ngramsLocalPatch /= mempty
...@@ -1151,12 +1152,12 @@ syncResetButtonsCpt = here.component "syncResetButtons" cpt ...@@ -1151,12 +1152,12 @@ syncResetButtonsCpt = here.component "syncResetButtons" cpt
performAction ResetPatches performAction ResetPatches
synchronizeClick _ = delay unit $ \_ -> do synchronizeClick _ = delay unit $ \_ -> do
setSynchronizing $ const true -- T.write_ true synchronizing
performAction $ Synchronize { afterSync: newAfterSync } performAction $ Synchronize { afterSync: newAfterSync }
newAfterSync x = do newAfterSync x = do
afterSync x afterSync x
liftEffect $ setSynchronizing $ const false -- liftEffect $ T.write_ false synchronizing
pure $ H.div { className: "btn-toolbar" } pure $ H.div { className: "btn-toolbar" }
[ H.div { className: "btn-group mr-2" } [ H.div { className: "btn-group mr-2" }
...@@ -1185,15 +1186,13 @@ chartsAfterSync :: forall props discard. ...@@ -1185,15 +1186,13 @@ chartsAfterSync :: forall props discard.
| props | props
} }
-> GAT.Reductor -> GAT.Reductor
-> T.Box T2.Reload
-> discard -> discard
-> Aff Unit -> Aff Unit
chartsAfterSync path'@{ nodeId } tasks reloadForest _ = do chartsAfterSync path'@{ nodeId } tasks _ = do
task <- postNgramsChartsAsync path' task <- postNgramsChartsAsync path'
liftEffect $ do liftEffect $ do
log2 "[chartsAfterSync] Synchronize task" task log2 "[chartsAfterSync] Synchronize task" task
snd tasks $ GAT.Insert nodeId task snd tasks $ GAT.Insert nodeId task
T2.reload reloadForest
postNgramsChartsAsync :: forall s. CoreParams s -> Aff AsyncTaskWithType postNgramsChartsAsync :: forall s. CoreParams s -> Aff AsyncTaskWithType
postNgramsChartsAsync { listIds, nodeId, session, tabType } = do postNgramsChartsAsync { listIds, nodeId, session, tabType } = do
......
module Gargantext.Components.Nodes.Lists where module Gargantext.Components.Nodes.Lists where
import Gargantext.Prelude (Unit, bind, const, discard, pure, show, unit, ($), (<>)) import DOM.Simple.Console (log, log2)
import Data.Maybe (Maybe(..)) import Data.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 (Effect)
import Effect.Aff (launchAff_) import Effect.Aff (launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as REX
import Toestand as T
import Gargantext.AsyncTasks as GAT import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest as Forest import Gargantext.Components.Forest as Forest
import Gargantext.Components.NgramsTable.Loader (clearCache) import Gargantext.Components.NgramsTable.Loader (clearCache)
import Gargantext.Components.Node (NodePoly(..)) import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild) import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
import Gargantext.Components.Nodes.Corpus.Types import Gargantext.Components.Nodes.Corpus.Types (getCorpusInfo, CorpusInfo(..), Hyperdata(..))
( getCorpusInfo, CorpusInfo(..), Hyperdata(..) )
import Gargantext.Components.Nodes.Lists.Tabs as Tabs import Gargantext.Components.Nodes.Lists.Tabs as Tabs
import Gargantext.Components.Nodes.Lists.Types import Gargantext.Components.Nodes.Lists.Types (CacheState(..), ListsLayoutControls, SidePanelState(..), initialControls, toggleSidePanelState)
( CacheState(..), ListsLayoutControls, SidePanelState(..)
, initialControls, toggleSidePanelState )
import Gargantext.Components.Table as Table import Gargantext.Components.Table as Table
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, const, discard, pure, show, unit, ($), (<>))
import Gargantext.Sessions (WithSession, WithSessionContext, Session, sessionId, getCacheState, setCacheState) import Gargantext.Sessions (WithSession, WithSessionContext, Session, sessionId, getCacheState, setCacheState)
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 import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as REX
import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Lists" here = R2.here "Gargantext.Components.Nodes.Lists"
......
...@@ -79,7 +79,7 @@ ngramsViewCpt = here.component "ngramsView" cpt where ...@@ -79,7 +79,7 @@ ngramsViewCpt = here.component "ngramsView" cpt where
, sidePanelTriggers , sidePanelTriggers
, tasks } _ = do , tasks } _ = do
chartsReload <- T.useBox T2.newReload chartsReload <- T.useBox T2.newReload
chartsReload' <- T.useLive T.unequal chartsReload
path <- T.useBox $ NTC.initialPageParams props.session initialPath.corpusId [initialPath.listId] initialPath.tabType path <- T.useBox $ NTC.initialPageParams props.session initialPath.corpusId [initialPath.listId] initialPath.tabType
{ listIds, nodeId, params, tabType } <- T.useLive T.unequal path { listIds, nodeId, params, tabType } <- T.useLive T.unequal path
let path' = { let path' = {
......
...@@ -226,8 +226,8 @@ listsCpt = here.component "lists" cpt where ...@@ -226,8 +226,8 @@ listsCpt = here.component "lists" cpt where
, showLogin , showLogin
, tasks } , tasks }
, listsProps: { nodeId , listsProps: { nodeId
, reloadRoot
, reloadForest , reloadForest
, reloadRoot
, session , session
, sessionUpdate: \_ -> pure unit , sessionUpdate: \_ -> pure unit
, tasks } , tasks }
......
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