Commit 21383650 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[tasks, ngramstable] async tasks refresh, fix ngrams loader bug

parent a51fcc34
...@@ -10,14 +10,13 @@ import Data.Either (Either(..)) ...@@ -10,14 +10,13 @@ import Data.Either (Either(..))
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Effect (Effect) import Effect (Effect)
import Reactix as R
import Toestand as T
import Web.Storage.Storage as WSS
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils as GU import Gargantext.Utils as GU
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 Toestand as T
import Web.Storage.Storage as WSS
localStorageKey :: String localStorageKey :: String
localStorageKey = "garg-async-tasks" localStorageKey = "garg-async-tasks"
...@@ -73,3 +72,20 @@ remove :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit ...@@ -73,3 +72,20 @@ remove :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit
remove id task storage = T.modify_ newStorage storage remove id task storage = T.modify_ newStorage storage
where where
newStorage s = Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts task)) id s newStorage s = Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts task)) id s
-- When a task is finished: which tasks cause forest or app reload
asyncTaskTriggersAppReload :: GT.AsyncTaskType -> Boolean
asyncTaskTriggersAppReload GT.UpdateNgramsCharts = true
asyncTaskTriggersAppReload _ = false
asyncTaskTTriggersAppReload :: GT.AsyncTaskWithType -> Boolean
asyncTaskTTriggersAppReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersAppReload typ
asyncTaskTriggersTreeReload :: GT.AsyncTaskType -> Boolean
asyncTaskTriggersTreeReload GT.Form = true
asyncTaskTriggersTreeReload GT.UploadFile = true
asyncTaskTriggersTreeReload _ = false
asyncTaskTTriggersTreeReload :: GT.AsyncTaskWithType -> Boolean
asyncTaskTTriggersTreeReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersTreeReload typ
...@@ -99,7 +99,7 @@ tree props = R.createElement treeCpt props [] ...@@ -99,7 +99,7 @@ tree props = R.createElement treeCpt props []
treeCpt :: R.Component TreeProps treeCpt :: R.Component TreeProps
treeCpt = here.component "tree" cpt where treeCpt = here.component "tree" cpt where
cpt p@{ session, tree: NTree (LNode { id, name, nodeType }) children } _ = do cpt p@{ reload, session, tree: NTree (LNode { id, name, nodeType }) children } _ = do
setPopoverRef <- R.useRef Nothing setPopoverRef <- R.useRef Nothing
folderOpen <- T2.useMemberBox nodeId p.forestOpen folderOpen <- T2.useMemberBox nodeId p.forestOpen
folderOpen' <- T.useLive T.unequal folderOpen folderOpen' <- T.useLive T.unequal folderOpen
...@@ -123,7 +123,7 @@ treeCpt = here.component "tree" cpt where ...@@ -123,7 +123,7 @@ treeCpt = here.component "tree" cpt where
nodeProps = RecordE.pick p :: Record NodeProps nodeProps = RecordE.pick p :: Record NodeProps
nsprops extra = Record.merge common extra' where nsprops extra = Record.merge common extra' where
common = RecordE.pick p :: Record NSCommon common = RecordE.pick p :: Record NSCommon
extra' = Record.merge extra { dispatch } where extra' = Record.merge extra { dispatch, reload } where
dispatch a = performAction a (Record.merge common' spr) where dispatch a = performAction a (Record.merge common' spr) where
common' = RecordE.pick p :: Record PACommon common' = RecordE.pick p :: Record PACommon
spr = { setPopoverRef: extra.setPopoverRef } spr = { setPopoverRef: extra.setPopoverRef }
......
...@@ -51,6 +51,7 @@ type NodeMainSpanProps = ...@@ -51,6 +51,7 @@ type NodeMainSpanProps =
, isLeaf :: IsLeaf , isLeaf :: IsLeaf
, name :: Name , name :: Name
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
, reload :: T.Box T2.Reload
, 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))
...@@ -83,6 +84,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt ...@@ -83,6 +84,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
, isLeaf , isLeaf
, name , name
, nodeType , nodeType
, reload
, reloadRoot , reloadRoot
, route , route
, session , session
...@@ -146,6 +148,15 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt ...@@ -146,6 +148,15 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
where where
onTaskFinish id' t _ = do onTaskFinish id' t _ = do
GAT.finish id' t tasks GAT.finish id' t tasks
if GAT.asyncTaskTTriggersAppReload t then do
here.log2 "reloading root for task" t
T2.reload reloadRoot
else if GAT.asyncTaskTTriggersTreeReload t then do
here.log2 "reloading tree for task" t
T2.reload reload
else do
here.log2 "task doesn't trigger a reload" t
pure unit
-- snd tasks $ GAT.Finish id' t -- snd tasks $ GAT.Finish id' t
-- mT <- T.read tasks -- mT <- T.read tasks
-- case mT of -- case mT of
......
...@@ -1110,7 +1110,7 @@ coreDispatch path state (Synchronize { afterSync }) = ...@@ -1110,7 +1110,7 @@ coreDispatch path state (Synchronize { afterSync }) =
coreDispatch _ state (CommitPatch pt) = coreDispatch _ state (CommitPatch pt) =
commitPatch pt state commitPatch pt state
coreDispatch _ state ResetPatches = coreDispatch _ state ResetPatches =
T.modify_ (\s -> s { ngramsLocalPatch = { ngramsPatches: mempty } }) state T.modify_ (_ { ngramsLocalPatch = { ngramsPatches: mempty } }) state
isSingleNgramsTerm :: NgramsTerm -> Boolean isSingleNgramsTerm :: NgramsTerm -> Boolean
isSingleNgramsTerm nt = isSingleTerm $ ngramsTermText nt isSingleNgramsTerm nt = isSingleTerm $ ngramsTermText nt
...@@ -1141,32 +1141,34 @@ syncResetButtonsCpt :: R.Component SyncResetButtonsProps ...@@ -1141,32 +1141,34 @@ 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 <- T.useBox false synchronizing <- T.useBox false
-- synchronizing' <- T.useLive T.unequal synchronizing synchronizing' <- T.useLive T.unequal synchronizing
let let
hasChanges = ngramsLocalPatch /= mempty hasChanges = ngramsLocalPatch /= mempty
hasChangesClass = if hasChanges then "" else " disabled" hasChangesClass = if hasChanges then "" else " disabled"
synchronizingClass = if synchronizing' then " disabled" else ""
resetClick _ = do resetClick _ = do
performAction ResetPatches performAction ResetPatches
synchronizeClick _ = delay unit $ \_ -> do synchronizeClick _ = delay unit $ \_ -> do
-- T.write_ true synchronizing T.write_ true synchronizing
performAction $ Synchronize { afterSync: newAfterSync } performAction $ Synchronize { afterSync: newAfterSync }
newAfterSync x = do newAfterSync x = do
afterSync x afterSync x
-- liftEffect $ T.write_ false synchronizing 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" }
[ H.button { className: "btn btn-danger " <> hasChangesClass [ H.button { className: "btn btn-danger " <> hasChangesClass <> synchronizingClass
, on: { click: resetClick } , on: { click: resetClick }
} [ H.text "Reset" ] } [ H.text "Reset" ]
] ]
, H.div { className: "btn-group mr-2" } , H.div { className: "btn-group mr-2" }
[ H.button { className: "btn btn-primary " <> hasChangesClass [ H.button { className: "btn btn-primary " <> hasChangesClass <> synchronizingClass
, on: { click: synchronizeClick } , on: { click: synchronizeClick }
} [ H.text "Sync" ] } [ H.text "Sync" ]
] ]
......
...@@ -88,10 +88,10 @@ useCachedAPILoaderEffect { cacheEndpoint ...@@ -88,10 +88,10 @@ useCachedAPILoaderEffect { cacheEndpoint
-- log2 "[useCachedAPILoaderEffect] cached version" version -- log2 "[useCachedAPILoaderEffect] cached version" version
-- log2 "[useCachedAPILoaderEffect] real version" cacheReal -- log2 "[useCachedAPILoaderEffect] real version" cacheReal
_ <- GUC.deleteReq cache req _ <- GUC.deleteReq cache req
vr'@(Versioned { version: _, data: _ }) <- GUC.cachedJson cache req vr'@(Versioned { version: version', data: _ }) <- GUC.cachedJson cache req
if version == cacheReal then if version' == cacheReal then
pure vr' pure vr'
else else
throwError $ error $ "Fetched clean cache but hashes don't match: " <> show version <> " != " <> show cacheReal throwError $ error $ "[NgramsTable.Loader] Fetched clean cache but hashes don't match: " <> show version <> " != " <> show cacheReal
liftEffect $ do liftEffect $ do
T.write_ (Just $ handleResponse val) state T.write_ (Just $ handleResponse val) state
...@@ -157,6 +157,6 @@ useCachedAPILoaderEffect { cacheEndpoint ...@@ -157,6 +157,6 @@ useCachedAPILoaderEffect { cacheEndpoint
if h == cacheReal then if h == cacheReal then
pure hr' pure hr'
else else
throwError $ error $ "Fetched clean cache but hashes don't match: " <> h <> " != " <> cacheReal throwError $ error $ "[Hooks.Loader] Fetched clean cache but hashes don't match: " <> h <> " != " <> cacheReal
liftEffect $ do liftEffect $ do
T.write_ (Just $ handleResponse val) state T.write_ (Just $ handleResponse val) state
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