Commit d5c430c4 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[toestand] refactor tasks to be pure Reductor

No Box needed.
parent d44d9447
...@@ -25,12 +25,12 @@ appCpt = here.component "app" cpt where ...@@ -25,12 +25,12 @@ appCpt = here.component "app" cpt where
cpt _ _ = do cpt _ _ = do
box <- T.useBox emptyApp -- global data box <- T.useBox emptyApp -- global data
boxes <- T.useFocusedFields box {} -- read-write access for children boxes <- T.useFocusedFields box {} -- read-write access for children
tasks <- T.useBox Nothing -- storage for asynchronous tasks reductor -- tasks <- T.useBox Nothing -- storage for asynchronous tasks reductor
R.useEffectOnce' $ do R.useEffectOnce' $ do
void $ Sessions.load boxes.sessions void $ Sessions.load boxes.sessions
tasksReductor <- GAT.useTasks boxes.reloadRoot boxes.reloadForest tasks <- GAT.useTasks boxes.reloadRoot boxes.reloadForest
R.useEffectOnce' $ do -- R.useEffectOnce' $ do
T.write (Just tasksReductor) tasks -- T.write (Just tasksReductor) tasks
R.useEffectOnce' $ do R.useEffectOnce' $ do
R2.loadLocalStorageState R2.openNodesKey boxes.forestOpen R2.loadLocalStorageState R2.openNodesKey boxes.forestOpen
T.listen (R2.listenLocalStorageState R2.openNodesKey) boxes.forestOpen T.listen (R2.listenLocalStorageState R2.openNodesKey) boxes.forestOpen
......
...@@ -33,11 +33,12 @@ here = R2.here "Gargantext.Components.Forest" ...@@ -33,11 +33,12 @@ here = R2.here "Gargantext.Components.Forest"
-- Shared by components here with Tree -- Shared by components here with Tree
type Common = type Common =
( frontends :: Frontends ( frontends :: Frontends
, handed :: T.Box Handed , handed :: T.Box Handed
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T.Box T2.Reload
, route :: T.Box AppRoute , route :: T.Box AppRoute
, tasks :: T.Box (Maybe GAT.Reductor) -- , tasks :: T.Box (Maybe GAT.Reductor)
, tasks :: GAT.Reductor
) )
type Props = type Props =
...@@ -69,29 +70,32 @@ forestCpt = here.component "forest" cpt where ...@@ -69,29 +70,32 @@ forestCpt = here.component "forest" cpt where
, sessions , sessions
, showLogin , showLogin
, tasks } _ = do , tasks } _ = do
tasks' <- GAT.useTasks reloadRoot reloadForest -- TODO Fix this. I think tasks shouldn't be a Box but only a Reductor
R.useEffect' $ T.write_ (Just tasks') tasks -- tasks' <- GAT.useTasks reloadRoot reloadForest
-- R.useEffect' $ do
-- 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
-- TODO If `reloadForest` is set, `reload` state should be updated -- TODO If `reloadForest` is set, `reload` state should be updated
-- TODO fix tasks ref -- TODO fix tasks ref
-- R.useEffect' $ do -- R.useEffect' $ do
-- 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' /\ reloadRoot' /\ (fst tasks).storage )
(cp handed' sessions' tasks') (cp handed' sessions')
where where
common = RX.pick props :: Record Common common = RX.pick props :: Record Common
cp handed' sessions' tasks' _ = cp handed' sessions' _ =
pure $ H.div { className: "forest" } pure $ H.div { className: "forest" }
(A.cons (plus handed' showLogin backend) (trees handed' sessions' tasks')) (A.cons (plus handed' showLogin backend) (trees handed' sessions'))
trees handed' sessions' tasks' = (tree handed' tasks') <$> unSessions sessions' trees handed' sessions' = (tree handed') <$> unSessions sessions'
tree handed' tasks' s@(Session {treeId}) = tree handed' s@(Session {treeId}) =
treeLoader { forestOpen treeLoader { forestOpen
, frontends , frontends
, handed: handed' , handed: handed'
...@@ -193,7 +197,7 @@ mainPage = R.createElement mainPageCpt ...@@ -193,7 +197,7 @@ mainPage = R.createElement mainPageCpt
-- mainPageCpt :: R.Memo () -- mainPageCpt :: R.Memo ()
-- mainPageCpt = R.memo (here.component "mainPage" cpt) where -- mainPageCpt = R.memo (here.component "mainPage" cpt) where
mainPageCpt :: R.Component() mainPageCpt :: R.Component ()
mainPageCpt = here.component "mainPage" cpt mainPageCpt = here.component "mainPage" cpt
where where
cpt _ children = do cpt _ children = do
......
...@@ -48,7 +48,8 @@ here = R2.here "Gargantext.Components.Forest.Tree" ...@@ -48,7 +48,8 @@ here = R2.here "Gargantext.Components.Forest.Tree"
-- Shared by every component here + performAction + nodeSpan -- Shared by every component here + performAction + nodeSpan
type Universal = type Universal =
( reloadRoot :: T.Box T2.Reload ( reloadRoot :: T.Box T2.Reload
, tasks :: T.Box (Maybe GAT.Reductor) ) -- , tasks :: T.Box (Maybe GAT.Reductor) )
, tasks :: GAT.Reductor )
-- Shared by every component here + nodeSpan -- Shared by every component here + nodeSpan
type Global = type Global =
...@@ -178,19 +179,13 @@ performAction (DeleteNode nt) p@{ forestOpen ...@@ -178,19 +179,13 @@ performAction (DeleteNode nt) p@{ 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
mT <- T.read tasks snd tasks $ GAT.Insert id task
case mT of
Just t -> snd t $ GAT.Insert id task
Nothing -> pure unit
log2 "[performAction] DoSearch task:" task log2 "[performAction] DoSearch task:" task
performAction (UpdateNode params) p@{ tasks performAction (UpdateNode params) p@{ tasks
, tree: (NTree (LNode {id}) _) } = do , tree: (NTree (LNode {id}) _) } = do
task <- updateRequest params p.session id task <- updateRequest params p.session id
liftEffect $ do liftEffect $ do
mT <- T.read tasks snd tasks $ GAT.Insert id task
case mT of
Just t -> snd t $ GAT.Insert id task
Nothing -> pure unit
log2 "[performAction] UpdateNode task:" task log2 "[performAction] UpdateNode task:" task
performAction (RenameNode name) p@{ tree: (NTree (LNode {id}) _) } = do performAction (RenameNode name) p@{ tree: (NTree (LNode {id}) _) } = do
void $ rename p.session id $ RenameValue { text: name } void $ rename p.session id $ RenameValue { text: name }
...@@ -213,19 +208,13 @@ performAction (UploadFile nodeType fileType mName blob) p@{ tasks ...@@ -213,19 +208,13 @@ performAction (UploadFile nodeType fileType mName blob) p@{ tasks
, tree: (NTree (LNode { id }) _) } = do , tree: (NTree (LNode { id }) _) } = do
task <- uploadFile p.session nodeType id fileType {mName, blob} task <- uploadFile p.session nodeType id fileType {mName, blob}
liftEffect $ do liftEffect $ do
mT <- T.read tasks snd tasks $ GAT.Insert id task
case mT of
Just t -> snd t $ GAT.Insert id task
Nothing -> pure unit
log2 "[performAction] UploadFile, uploaded, task:" task log2 "[performAction] UploadFile, uploaded, task:" task
performAction (UploadArbitraryFile mName blob) p@{ tasks performAction (UploadArbitraryFile mName blob) p@{ tasks
, tree: (NTree (LNode { id }) _) } = do , tree: (NTree (LNode { id }) _) } = do
task <- uploadArbitraryFile p.session id { blob, mName } task <- uploadArbitraryFile p.session id { blob, mName }
liftEffect $ do liftEffect $ do
mT <- T.read tasks snd tasks $ GAT.Insert id task
case mT of
Just t -> snd t $ GAT.Insert id task
Nothing -> pure unit
log2 "[performAction] UploadArbitraryFile, uploaded, task:" task log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
performAction DownloadNode _ = liftEffect $ log "[performAction] DownloadNode" performAction DownloadNode _ = liftEffect $ log "[performAction] DownloadNode"
performAction (MoveNode {params}) p@{ forestOpen performAction (MoveNode {params}) p@{ forestOpen
......
...@@ -5,7 +5,7 @@ import Gargantext.Prelude ...@@ -5,7 +5,7 @@ import Gargantext.Prelude
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Nullable (null) import Data.Nullable (null)
import Data.Symbol (SProxy(..)) import Data.Symbol (SProxy(..))
import Data.Tuple (snd) import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
...@@ -54,7 +54,7 @@ type NodeMainSpanProps = ...@@ -54,7 +54,7 @@ type NodeMainSpanProps =
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T.Box T2.Reload
, route :: T.Box Routes.AppRoute , route :: T.Box Routes.AppRoute
, setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit)) , setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
| CommonProps | CommonProps
) )
...@@ -101,7 +101,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt ...@@ -101,7 +101,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
R.setRef setPopoverRef $ Just $ Popover.setOpen popoverRef R.setRef setPopoverRef $ Just $ Popover.setOpen popoverRef
let isSelected = Just route' == Routes.nodeTypeAppRoute nodeType (sessionId session) id let isSelected = Just route' == Routes.nodeTypeAppRoute nodeType (sessionId session) id
tasks' <- T.read tasks -- tasks' <- T.read tasks
pure $ H.span (dropProps droppedFile droppedFile' isDragOver isDragOver') pure $ H.span (dropProps droppedFile droppedFile' isDragOver isDragOver')
$ reverseHanded handed $ reverseHanded handed
...@@ -117,7 +117,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt ...@@ -117,7 +117,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
, onFinish: onTaskFinish id t , onFinish: onTaskFinish id t
, session , session
} }
) $ GAT.getTasksMaybe tasks' id ) $ GAT.getTasks (fst tasks) id
) )
, if nodeType == GT.NodeUser , if nodeType == GT.NodeUser
then GV.versionView {session} then GV.versionView {session}
...@@ -142,10 +142,11 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt ...@@ -142,10 +142,11 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
] ]
where where
onTaskFinish id' t _ = do onTaskFinish id' t _ = do
mT <- T.read tasks snd tasks $ GAT.Finish id' t
case mT of -- mT <- T.read tasks
Just t' -> snd t' $ GAT.Finish id' t -- case mT of
Nothing -> pure unit -- Just t' -> snd t' $ GAT.Finish id' t
-- Nothing -> pure unit
T2.reload reloadRoot T2.reload reloadRoot
SettingsBox {show: showBox} = settingsBox nodeType SettingsBox {show: showBox} = settingsBox nodeType
......
...@@ -53,7 +53,7 @@ type BaseProps = ...@@ -53,7 +53,7 @@ type BaseProps =
, route :: T.Box AppRoute , route :: T.Box AppRoute
, sessions :: T.Box Sessions , sessions :: T.Box Sessions
, showLogin :: T.Box Boolean , showLogin :: T.Box Boolean
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
) )
type LayoutLoaderProps = ( session :: R.Context Session | BaseProps ) type LayoutLoaderProps = ( session :: R.Context Session | BaseProps )
...@@ -277,7 +277,7 @@ type TreeProps = ( ...@@ -277,7 +277,7 @@ type TreeProps = (
, sessions :: T.Box Sessions , sessions :: T.Box Sessions
, show :: Boolean , show :: Boolean
, showLogin :: T.Box Boolean , showLogin :: T.Box Boolean
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
) )
type MSidebarProps = type MSidebarProps =
......
...@@ -263,7 +263,7 @@ type CommonProps = ( ...@@ -263,7 +263,7 @@ type CommonProps = (
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T.Box T2.Reload
, sidePanelTriggers :: Record NT.SidePanelTriggers , sidePanelTriggers :: Record NT.SidePanelTriggers
, tabNgramType :: CTabNgramType , tabNgramType :: CTabNgramType
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
, withAutoUpdate :: Boolean , withAutoUpdate :: Boolean
) )
......
...@@ -1184,7 +1184,7 @@ chartsAfterSync :: forall props discard. ...@@ -1184,7 +1184,7 @@ chartsAfterSync :: forall props discard.
, tabType :: TabType , tabType :: TabType
| props | props
} }
-> T.Box (Maybe GAT.Reductor) -> GAT.Reductor
-> T.Box T2.Reload -> T.Box T2.Reload
-> discard -> discard
-> Aff Unit -> Aff Unit
...@@ -1192,12 +1192,8 @@ chartsAfterSync path'@{ nodeId } tasks reloadForest _ = do ...@@ -1192,12 +1192,8 @@ chartsAfterSync path'@{ nodeId } tasks reloadForest _ = do
task <- postNgramsChartsAsync path' task <- postNgramsChartsAsync path'
liftEffect $ do liftEffect $ do
log2 "[chartsAfterSync] Synchronize task" task log2 "[chartsAfterSync] Synchronize task" task
mT <- T.read tasks snd tasks $ GAT.Insert nodeId task
case mT of T2.reload reloadForest
Nothing -> log "[chartsAfterSync] tasks is Nothing"
Just tasks' -> do
snd tasks' (GAT.Insert nodeId task) -- *> T2.reload reloadForest
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
......
...@@ -59,7 +59,7 @@ type TabsProps = ...@@ -59,7 +59,7 @@ type TabsProps =
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T.Box T2.Reload
, session :: Session , session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers , sidePanelTriggers :: Record LTypes.SidePanelTriggers
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
) )
tabs :: R2.Leaf TabsProps tabs :: R2.Leaf TabsProps
...@@ -136,5 +136,5 @@ type NTCommon = ...@@ -136,5 +136,5 @@ type NTCommon =
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T.Box T2.Reload
, session :: Session , session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers , sidePanelTriggers :: Record LTypes.SidePanelTriggers
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
) )
...@@ -155,7 +155,7 @@ type LayoutNoSessionProps = ...@@ -155,7 +155,7 @@ type LayoutNoSessionProps =
, nodeId :: Int , nodeId :: Int
, reloadForest :: T.Box T2.Reload , reloadForest :: T.Box T2.Reload
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T.Box T2.Reload
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
) )
type LayoutProps = WithSession LayoutNoSessionProps type LayoutProps = WithSession LayoutNoSessionProps
......
...@@ -141,7 +141,7 @@ listElement = H.li { className: "list-group-item justify-content-between" } ...@@ -141,7 +141,7 @@ listElement = H.li { className: "list-group-item justify-content-between" }
type BasicProps = type BasicProps =
( frontends :: Frontends ( frontends :: Frontends
, nodeId :: Int , nodeId :: Int
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
) )
type ReloadProps = type ReloadProps =
......
...@@ -57,7 +57,7 @@ type TabsProps = ( ...@@ -57,7 +57,7 @@ type TabsProps = (
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T.Box T2.Reload
, session :: Session , session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers , sidePanelTriggers :: Record LTypes.SidePanelTriggers
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
) )
tabs :: Record TabsProps -> R.Element tabs :: Record TabsProps -> R.Element
...@@ -139,7 +139,7 @@ type NgramsViewTabsProps = ( ...@@ -139,7 +139,7 @@ type NgramsViewTabsProps = (
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T.Box T2.Reload
, session :: Session , session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers , sidePanelTriggers :: Record LTypes.SidePanelTriggers
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
) )
ngramsView :: R2.Component NgramsViewTabsProps ngramsView :: R2.Component NgramsViewTabsProps
......
...@@ -98,7 +98,7 @@ type CommonPropsNoSession = ...@@ -98,7 +98,7 @@ type CommonPropsNoSession =
, reloadForest :: T.Box T2.Reload , reloadForest :: T.Box T2.Reload
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T.Box T2.Reload
, sessionUpdate :: Session -> Effect Unit , sessionUpdate :: Session -> Effect Unit
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
) )
type CommonProps = WithSession CommonPropsNoSession type CommonProps = WithSession CommonPropsNoSession
......
...@@ -41,7 +41,7 @@ type Props = ( ...@@ -41,7 +41,7 @@ type Props = (
, reloadRoot :: T.Box T2.Reload , reloadRoot :: T.Box T2.Reload
, session :: Session , session :: Session
, sidePanelTriggers :: Record SidePanelTriggers , sidePanelTriggers :: Record SidePanelTriggers
, tasks :: T.Box (Maybe GAT.Reductor) , tasks :: GAT.Reductor
) )
type PropsWithKey = ( key :: String | Props ) type PropsWithKey = ( key :: String | Props )
......
...@@ -42,7 +42,7 @@ import Gargantext.Utils.Reactix as R2 ...@@ -42,7 +42,7 @@ import Gargantext.Utils.Reactix as R2
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Router" here = R2.here "Gargantext.Components.Router"
type Props = ( boxes :: Boxes, tasks :: T.Box (Maybe GAT.Reductor) ) type Props = ( boxes :: Boxes, tasks :: GAT.Reductor )
type SessionProps = ( session :: R.Context Session, sessionId :: SessionId | Props ) type SessionProps = ( session :: R.Context Session, sessionId :: SessionId | Props )
......
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