Commit 7a71ae7d authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[tasks] reload app only on task finish

Otherwise, reload only tree.
parent 97a649f4
...@@ -49,38 +49,37 @@ removeTaskFromList ts (GT.AsyncTaskWithType { task: GT.AsyncTask { id: id' } }) ...@@ -49,38 +49,37 @@ removeTaskFromList ts (GT.AsyncTaskWithType { task: GT.AsyncTask { id: id' } })
A.filter (\(GT.AsyncTaskWithType { task: GT.AsyncTask { id: id'' } }) -> id' /= id'') ts A.filter (\(GT.AsyncTaskWithType { task: GT.AsyncTask { id: id'' } }) -> id' /= id'') ts
type ReductorProps = ( type ReductorProps = (
reload :: R.State Int appReload :: R.State Int
, storage :: Storage , treeReload :: R.State Int
, storage :: Storage
) )
type Reductor = R2.Reductor (Record ReductorProps) Action type Reductor = R2.Reductor (Record ReductorProps) Action
type ReductorAction = Action -> Effect Unit type ReductorAction = Action -> Effect Unit
type OnFinish = Effect Unit type OnFinish = Effect Unit
useTasks :: R.State Int -> R.Hooks Reductor useTasks :: R.State Int -> R.State Int -> R.Hooks Reductor
useTasks reload = R2.useReductor act initializer unit useTasks appReload treeReload = R2.useReductor act initializer unit
where where
act :: R2.Actor (Record ReductorProps) Action act :: R2.Actor (Record ReductorProps) Action
act a s = action s a act a s = action s a
initializer _ = do initializer _ = do
storage <- getAsyncTasks storage <- getAsyncTasks
pure { reload, storage } pure { appReload, treeReload, storage }
data Action = data Action =
Insert NodeId GT.AsyncTaskWithType Insert NodeId GT.AsyncTaskWithType
| Finish NodeId GT.AsyncTaskWithType OnFinish | Finish NodeId GT.AsyncTaskWithType
| Remove NodeId GT.AsyncTaskWithType | Remove NodeId GT.AsyncTaskWithType
action :: Record ReductorProps -> Action -> Effect (Record ReductorProps) action :: Record ReductorProps -> Action -> Effect (Record ReductorProps)
action { reload, storage } (Insert nodeId t) = do action p@{ treeReload, storage } (Insert nodeId t) = do
_ <- snd reload $ (_ + 1) _ <- snd treeReload $ (_ + 1)
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 { reload, storage: newStorage } pure $ p { storage = newStorage }
action p@{ reload, storage } (Finish nodeId t onFinish) = do action p (Finish nodeId t) = do
ret <- action p (Remove nodeId t) action p (Remove nodeId t)
onFinish action p@{ appReload, storage } (Remove nodeId t) = do
pure ret _ <- snd appReload $ (_ + 1)
action { reload, storage } (Remove nodeId t) = do
_ <- snd reload $ (_ + 1)
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
pure { reload, storage: newStorage } pure $ p { storage = newStorage }
...@@ -53,6 +53,7 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where ...@@ -53,6 +53,7 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
route <- useHashRouter router Home route <- useHashRouter router Home
asyncTasksRef <- R.useRef Nothing asyncTasksRef <- R.useRef Nothing
treeReloadRef <- R.useRef Nothing
showLogin <- R.useState' false showLogin <- R.useState' false
backend <- R.useState' Nothing backend <- R.useState' Nothing
...@@ -65,15 +66,16 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where ...@@ -65,15 +66,16 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
let backends = fromFoldable defaultBackends let backends = fromFoldable defaultBackends
let ff f session = R.fragment [ f session, footer { session } ] let ff f session = R.fragment [ f session, footer { session } ]
let forested child = forestLayout { asyncTasksRef let forested child = forestLayout { appReload: reload
, asyncTasksRef
, backend
, child , child
, frontends , frontends
, handed , handed
, reload
, route: fst route , route: fst route
, sessions: fst sessions , sessions: fst sessions
, showLogin: snd showLogin , showLogin: snd showLogin
, backend , treeReloadRef
} }
let defaultView _ = forested $ homeLayout { backend let defaultView _ = forested $ homeLayout { backend
, lang: LL_EN , lang: LL_EN
...@@ -98,6 +100,7 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where ...@@ -98,6 +100,7 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
, frontends , frontends
, nodeId , nodeId
, session , session
, treeReloadRef
} }
Corpus sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session } Corpus sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
CorpusDocument sid corpusId listId nodeId -> withSession sid $ \session -> forested $ documentLayout { corpusId: Just corpusId, nodeId, listId, session } CorpusDocument sid corpusId listId nodeId -> withSession sid $ \session -> forested $ documentLayout { corpusId: Just corpusId, nodeId, listId, session }
...@@ -116,6 +119,7 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where ...@@ -116,6 +119,7 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
, nodeId , nodeId
, session , session
, sessionUpdate , sessionUpdate
, treeReloadRef
} }
Login -> login { backend, backends, sessions, visible: showLogin } Login -> login { backend, backends, sessions, visible: showLogin }
PGraphExplorer sid graphId -> PGraphExplorer sid graphId ->
...@@ -144,18 +148,20 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where ...@@ -144,18 +148,20 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
, frontends , frontends
, nodeId , nodeId
, session , session
, treeReloadRef
} }
type ForestLayoutProps = ( type ForestLayoutProps = (
asyncTasksRef :: R.Ref (Maybe GAT.Reductor) appReload :: R.State Int
, asyncTasksRef :: R.Ref (Maybe GAT.Reductor)
, backend :: R.State (Maybe Backend) , backend :: R.State (Maybe Backend)
, child :: R.Element , child :: R.Element
, frontends :: Frontends , frontends :: Frontends
, handed :: R.State GT.Handed , handed :: R.State GT.Handed
, reload :: R.State Int
, route :: AppRoute , route :: AppRoute
, sessions :: Sessions , sessions :: Sessions
, showLogin :: R.Setter Boolean , showLogin :: R.Setter Boolean
, treeReloadRef :: R.Ref (Maybe (R.State Int))
) )
forestLayout :: Record ForestLayoutProps -> R.Element forestLayout :: Record ForestLayoutProps -> R.Element
...@@ -173,7 +179,16 @@ forestLayoutMain props = R.createElement forestLayoutMainCpt props [] ...@@ -173,7 +179,16 @@ forestLayoutMain props = R.createElement forestLayoutMainCpt props []
forestLayoutMainCpt :: R.Component ForestLayoutProps forestLayoutMainCpt :: R.Component ForestLayoutProps
forestLayoutMainCpt = R.hooksComponentWithModule thisModule "forestLayoutMain" cpt forestLayoutMainCpt = R.hooksComponentWithModule thisModule "forestLayoutMain" cpt
where where
cpt { asyncTasksRef, child, frontends, handed, reload, route, sessions, showLogin, backend} _ = do cpt { appReload
, asyncTasksRef
, backend
, child
, frontends
, handed
, route
, sessions
, showLogin
, treeReloadRef } _ = do
let ordering = let ordering =
case fst handed of case fst handed of
GT.LeftHanded -> reverse GT.LeftHanded -> reverse
...@@ -181,7 +196,15 @@ forestLayoutMainCpt = R.hooksComponentWithModule thisModule "forestLayoutMain" c ...@@ -181,7 +196,15 @@ forestLayoutMainCpt = R.hooksComponentWithModule thisModule "forestLayoutMain" c
pure $ R2.row $ ordering [ pure $ R2.row $ ordering [
H.div { className: "col-md-2", style: { paddingTop: "60px" } } H.div { className: "col-md-2", style: { paddingTop: "60px" } }
[ forest { asyncTasksRef, backend, frontends, handed: fst handed, reload, route, sessions, showLogin } ] [ forest { appReload
, asyncTasksRef
, backend
, frontends
, handed: fst handed
, route
, sessions
, showLogin
, treeReloadRef } ]
, mainPage child , mainPage child
] ]
......
...@@ -22,14 +22,15 @@ thisModule :: String ...@@ -22,14 +22,15 @@ thisModule :: String
thisModule = "Gargantext.Components.Forest" thisModule = "Gargantext.Components.Forest"
type Props = ( type Props = (
asyncTasksRef :: R.Ref (Maybe GAT.Reductor) appReload :: R.State Int
, asyncTasksRef :: R.Ref (Maybe GAT.Reductor)
, backend :: R.State (Maybe Backend) , backend :: R.State (Maybe Backend)
, frontends :: Frontends , frontends :: Frontends
, handed :: Handed , handed :: Handed
, reload :: R.State Int
, route :: AppRoute , route :: AppRoute
, sessions :: Sessions , sessions :: Sessions
, showLogin :: R.Setter Boolean , showLogin :: R.Setter Boolean
, treeReloadRef :: R.Ref (Maybe (R.State Int))
) )
forest :: Record Props -> R.Element forest :: Record Props -> R.Element
...@@ -37,21 +38,33 @@ forest props = R.createElement forestCpt props [] ...@@ -37,21 +38,33 @@ forest props = R.createElement forestCpt props []
forestCpt :: R.Component Props forestCpt :: R.Component Props
forestCpt = R.hooksComponentWithModule thisModule "forest" cpt where forestCpt = R.hooksComponentWithModule thisModule "forest" cpt where
cpt { asyncTasksRef, frontends, handed, reload: extReload, route, sessions, showLogin, backend} _ = do cpt { appReload
, asyncTasksRef
, backend
, frontends
, handed
, route
, sessions
, showLogin
, treeReloadRef } _ = 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)
asyncTasks <- GAT.useTasks reload asyncTasks <- GAT.useTasks appReload reload
openNodes <- R2.useLocalStorageState R2.openNodesKey (Set.empty :: OpenNodes) openNodes <- R2.useLocalStorageState R2.openNodesKey (Set.empty :: OpenNodes)
-- TODO If `treeReloadRef` is set, `reload` state should be updated
R.useEffect' $ do R.useEffect' $ do
R.setRef asyncTasksRef $ Just asyncTasks R.setRef asyncTasksRef $ Just asyncTasks
case R.readRef treeReloadRef of
Nothing -> R.setRef treeReloadRef $ Just reload
Just _ -> pure unit
R2.useCache ( R2.useCache (
frontends frontends
/\ route /\ route
/\ sessions /\ sessions
/\ fst openNodes /\ fst openNodes
/\ fst extReload /\ fst appReload
/\ fst reload /\ fst reload
/\ (fst asyncTasks).storage /\ (fst asyncTasks).storage
/\ handed /\ handed
......
...@@ -127,7 +127,6 @@ nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt ...@@ -127,7 +127,6 @@ nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt
] ]
else H.div {} [] else H.div {} []
, nodeActions { id , nodeActions { id
, nodeType , nodeType
, refreshTree: const $ dispatch RefreshTree , refreshTree: const $ dispatch RefreshTree
...@@ -138,7 +137,8 @@ nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt ...@@ -138,7 +137,8 @@ nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt
] ]
where where
onTaskFinish id t _ = do onTaskFinish id t _ = do
dispatchAsyncTasks $ GAT.Finish id t (snd appReload $ (_ + 1)) dispatchAsyncTasks $ GAT.Finish id t
snd appReload $ (_ + 1)
SettingsBox {show: showBox} = settingsBox nodeType SettingsBox {show: showBox} = settingsBox nodeType
onPopoverClose popoverRef _ = Popover.setOpen popoverRef false onPopoverClose popoverRef _ = Popover.setOpen popoverRef false
......
...@@ -93,6 +93,7 @@ explorerCpt :: R.Component Props ...@@ -93,6 +93,7 @@ explorerCpt :: R.Component Props
explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt
where where
cpt props@{ asyncTasksRef cpt props@{ asyncTasksRef
, backend
, frontends , frontends
, graph , graph
, graphId , graphId
...@@ -104,7 +105,6 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt ...@@ -104,7 +105,6 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt
, session , session
, sessions , sessions
, showLogin , showLogin
, backend
} _ = do } _ = do
let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas }) -> startForceAtlas) mMetaData let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas }) -> startForceAtlas) mMetaData
...@@ -117,13 +117,14 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt ...@@ -117,13 +117,14 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt
graphRef <- R.useRef null graphRef <- R.useRef null
graphVersionRef <- R.useRef (fst graphVersion) graphVersionRef <- R.useRef (fst graphVersion)
treeReload <- R.useState' 0 treeReload <- R.useState' 0
treeReloadRef <- R.useRef $ Just treeReload
controls <- Controls.useGraphControls { forceAtlasS controls <- Controls.useGraphControls { forceAtlasS
, graph , graph
, graphId , graphId
, hyperdataGraph , hyperdataGraph
, session , session
, treeReload: \_ -> (snd treeReload) $ (+) 1 , treeReload: \_ -> (snd treeReload) $ (+) 1
} }
multiSelectEnabledRef <- R.useRef $ fst controls.multiSelectEnabled multiSelectEnabledRef <- R.useRef $ fst controls.multiSelectEnabled
R.useEffect' $ do R.useEffect' $ do
...@@ -165,7 +166,9 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt ...@@ -165,7 +166,9 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt
, reload: treeReload , reload: treeReload
, sessions , sessions
, show: fst controls.showTree , show: fst controls.showTree
, showLogin: snd showLogin } , showLogin: snd showLogin
, treeReloadRef
}
/\ /\
RH.div { ref: graphRef, id: "graph-view", className: "col-md-12" } [] RH.div { ref: graphRef, id: "graph-view", className: "col-md-12" } []
/\ /\
...@@ -212,9 +215,17 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt ...@@ -212,9 +215,17 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt
tree :: Record TreeProps -> R.Element tree :: Record TreeProps -> R.Element
tree { show: false } = RH.div { id: "tree" } [] tree { show: false } = RH.div { id: "tree" } []
tree { asyncTasksRef, backend, frontends, handed, mCurrentRoute: route, reload, sessions, showLogin } = tree { asyncTasksRef, backend, frontends, handed, mCurrentRoute: route, reload, sessions, showLogin, treeReloadRef } =
RH.div {className: "col-md-2 graph-tree"} [ RH.div {className: "col-md-2 graph-tree"} [
forest { asyncTasksRef, backend, frontends, handed, reload, route, sessions, showLogin } forest { appReload: reload
, asyncTasksRef
, backend
, frontends
, handed
, route
, sessions
, showLogin
, treeReloadRef }
] ]
mSidebar :: Maybe GET.MetaData mSidebar :: Maybe GET.MetaData
...@@ -235,6 +246,7 @@ type TreeProps = ...@@ -235,6 +246,7 @@ type TreeProps =
, sessions :: Sessions , sessions :: Sessions
, show :: Boolean , show :: Boolean
, showLogin :: R.Setter Boolean , showLogin :: R.Setter Boolean
, treeReloadRef :: R.Ref (Maybe (R.State Int))
) )
type MSidebarProps = type MSidebarProps =
......
...@@ -286,6 +286,7 @@ type Props = ( ...@@ -286,6 +286,7 @@ type Props = (
, path :: R.State PageParams , path :: R.State PageParams
, state :: R.State State , state :: R.State State
, tabNgramType :: CTabNgramType , tabNgramType :: CTabNgramType
, treeReloadRef :: R.Ref (Maybe (R.State Int))
, versioned :: VersionedNgramsTable , versioned :: VersionedNgramsTable
, withAutoUpdate :: Boolean , withAutoUpdate :: Boolean
) )
...@@ -306,14 +307,15 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable" ...@@ -306,14 +307,15 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable"
, ngramsSelection , ngramsSelection
, ngramsVersion } /\ setState) , ngramsVersion } /\ setState)
, tabNgramType , tabNgramType
, treeReloadRef
, versioned: Versioned { data: initTable } , versioned: Versioned { data: initTable }
, withAutoUpdate } _ = do , withAutoUpdate } _ = do
let syncResetBtns = [ let syncResetBtns = [
syncResetButtons { afterSync: chartsAfterSync syncResetButtons { afterSync: chartsAfterSync
, ngramsLocalPatch , ngramsLocalPatch
, performAction: performAction <<< CoreAction , performAction: performAction <<< CoreAction
} }
] ]
pure $ R.fragment $ pure $ R.fragment $
...@@ -345,12 +347,16 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable" ...@@ -345,12 +347,16 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable"
chartsAfterSync _ = do chartsAfterSync _ = do
task <- postNgramsChartsAsync path' task <- postNgramsChartsAsync path'
liftEffect $ do liftEffect $ do
log2 "[performAction] Synchronize task" task log2 "[chartsAfterSync] Synchronize task" task
case R.readRef asyncTasksRef of case R.readRef asyncTasksRef of
Nothing -> log "[performAction] asyncTasksRef is Nothing" Nothing -> log "[chartsAfterSync] asyncTasksRef is Nothing"
Just asyncTasks -> do Just asyncTasks -> do
snd asyncTasks $ GAT.Insert nodeId task snd asyncTasks $ GAT.Insert nodeId task
snd appReload $ (_ + 1) case R.readRef treeReloadRef of
Nothing -> log "[chartsAfterSync] can't reload tree: ref empty"
Just treeReload -> do
snd treeReload $ (_ + 1)
-- snd appReload $ (_ + 1)
autoUpdate :: Array R.Element autoUpdate :: Array R.Element
autoUpdate = if withAutoUpdate then autoUpdate = if withAutoUpdate then
...@@ -510,9 +516,11 @@ type MainNgramsTableProps = ( ...@@ -510,9 +516,11 @@ type MainNgramsTableProps = (
, defaultListId :: Int , defaultListId :: Int
, nodeId :: Int , nodeId :: Int
-- ^ This node can be a corpus or contact. -- ^ This node can be a corpus or contact.
, pathS :: R.State PageParams
, session :: Session , session :: Session
, tabNgramType :: CTabNgramType , tabNgramType :: CTabNgramType
, tabType :: TabType , tabType :: TabType
, treeReloadRef :: R.Ref (Maybe (R.State Int))
, withAutoUpdate :: Boolean , withAutoUpdate :: Boolean
) )
...@@ -528,30 +536,43 @@ mainNgramsTableCpt = R.hooksComponentWithModule thisModule "mainNgramsTable" cpt ...@@ -528,30 +536,43 @@ mainNgramsTableCpt = R.hooksComponentWithModule thisModule "mainNgramsTable" cpt
, cacheState , cacheState
, defaultListId , defaultListId
, nodeId , nodeId
, pathS
, session , session
, tabNgramType , tabNgramType
, tabType , tabType
, treeReloadRef
, withAutoUpdate } _ = do , withAutoUpdate } _ = do
let path = initialPageParams session nodeId [defaultListId] tabType
let render versioned = mainNgramsTablePaint { afterSync -- let path = initialPageParams session nodeId [defaultListId] tabType
, appReload
, asyncTasksRef
, path
, tabNgramType
, versioned
, withAutoUpdate }
case cacheState of case cacheState of
(NT.CacheOn /\ _) -> do (NT.CacheOn /\ _) -> do
let render versioned = mainNgramsTablePaint { afterSync
, appReload
, asyncTasksRef
, path: fst pathS
, tabNgramType
, treeReloadRef
, versioned
, withAutoUpdate }
useLoaderWithCacheAPI { useLoaderWithCacheAPI {
cacheEndpoint: versionEndpoint props cacheEndpoint: versionEndpoint props
, handleResponse , handleResponse
, mkRequest , mkRequest
, path , path: fst pathS
, renderer: render , renderer: render
} }
(NT.CacheOff /\ _) -> do (NT.CacheOff /\ _) -> do
useLoader path loader render -- pathS <- R.useState' path
let render versioned = mainNgramsTablePaintNoCache { afterSync
, appReload
, asyncTasksRef
, pathS
, tabNgramType
, treeReloadRef
, versioned
, withAutoUpdate }
useLoader (fst pathS) loader render
versionEndpoint :: Record MainNgramsTableProps -> PageParams -> Aff Version versionEndpoint :: Record MainNgramsTableProps -> PageParams -> Aff Version
versionEndpoint { defaultListId, nodeId, session, tabType } _ = get session $ R.GetNgramsTableVersion { listId: defaultListId, tabType } (Just nodeId) versionEndpoint { defaultListId, nodeId, session, tabType } _ = get session $ R.GetNgramsTableVersion { listId: defaultListId, tabType } (Just nodeId)
...@@ -603,6 +624,7 @@ type MainNgramsTablePaintProps = ( ...@@ -603,6 +624,7 @@ type MainNgramsTablePaintProps = (
, asyncTasksRef :: R.Ref (Maybe GAT.Reductor) , asyncTasksRef :: R.Ref (Maybe GAT.Reductor)
, path :: PageParams , path :: PageParams
, tabNgramType :: CTabNgramType , tabNgramType :: CTabNgramType
, treeReloadRef :: R.Ref (Maybe (R.State Int))
, versioned :: VersionedNgramsTable , versioned :: VersionedNgramsTable
, withAutoUpdate :: Boolean , withAutoUpdate :: Boolean
) )
...@@ -613,7 +635,7 @@ mainNgramsTablePaint p = R.createElement mainNgramsTablePaintCpt p [] ...@@ -613,7 +635,7 @@ mainNgramsTablePaint p = R.createElement mainNgramsTablePaintCpt p []
mainNgramsTablePaintCpt :: R.Component MainNgramsTablePaintProps mainNgramsTablePaintCpt :: R.Component MainNgramsTablePaintProps
mainNgramsTablePaintCpt = R.hooksComponentWithModule thisModule "mainNgramsTablePaint" cpt mainNgramsTablePaintCpt = R.hooksComponentWithModule thisModule "mainNgramsTablePaint" cpt
where where
cpt props@{ afterSync, appReload, asyncTasksRef, path, tabNgramType, versioned, withAutoUpdate } _ = do cpt props@{ afterSync, appReload, asyncTasksRef, path, tabNgramType, treeReloadRef, versioned, withAutoUpdate } _ = do
pathS <- R.useState' path pathS <- R.useState' path
state <- R.useState' $ initialState versioned state <- R.useState' $ initialState versioned
...@@ -624,6 +646,39 @@ mainNgramsTablePaintCpt = R.hooksComponentWithModule thisModule "mainNgramsTable ...@@ -624,6 +646,39 @@ mainNgramsTablePaintCpt = R.hooksComponentWithModule thisModule "mainNgramsTable
, path: pathS , path: pathS
, state , state
, tabNgramType , tabNgramType
, treeReloadRef
, versioned
, withAutoUpdate
}
type MainNgramsTablePaintNoCacheProps = (
afterSync :: Unit -> Aff Unit
, appReload :: R.State Int
, asyncTasksRef :: R.Ref (Maybe GAT.Reductor)
, pathS :: R.State PageParams
, tabNgramType :: CTabNgramType
, treeReloadRef :: R.Ref (Maybe (R.State Int))
, versioned :: VersionedNgramsTable
, withAutoUpdate :: Boolean
)
mainNgramsTablePaintNoCache :: Record MainNgramsTablePaintNoCacheProps -> R.Element
mainNgramsTablePaintNoCache p = R.createElement mainNgramsTablePaintNoCacheCpt p []
mainNgramsTablePaintNoCacheCpt :: R.Component MainNgramsTablePaintNoCacheProps
mainNgramsTablePaintNoCacheCpt = R.hooksComponentWithModule thisModule "mainNgramsTablePaintNoCache" cpt
where
cpt props@{ afterSync, appReload, asyncTasksRef, pathS, tabNgramType, treeReloadRef, versioned, withAutoUpdate } _ = do
state <- R.useState' $ initialState versioned
pure $ loadedNgramsTable {
afterSync
, appReload
, asyncTasksRef
, path: pathS
, state
, tabNgramType
, treeReloadRef
, versioned , versioned
, withAutoUpdate , withAutoUpdate
} }
......
...@@ -158,8 +158,8 @@ type PageParams = ...@@ -158,8 +158,8 @@ type PageParams =
initialPageParams :: Session -> Int -> Array Int -> TabType -> PageParams initialPageParams :: Session -> Int -> Array Int -> TabType -> PageParams
initialPageParams session nodeId listIds tabType = initialPageParams session nodeId listIds tabType =
{ nodeId { listIds
, listIds , nodeId
, params , params
, tabType , tabType
, termSizeFilter: Nothing , termSizeFilter: Nothing
......
...@@ -150,6 +150,7 @@ type LayoutProps = ( ...@@ -150,6 +150,7 @@ type LayoutProps = (
, frontends :: Frontends , frontends :: Frontends
, nodeId :: Int , nodeId :: Int
, session :: Session , session :: Session
, treeReloadRef :: R.Ref (Maybe (R.State Int))
) )
type KeyLayoutProps = ( type KeyLayoutProps = (
...@@ -163,7 +164,7 @@ userLayout props = R.createElement userLayoutCpt props [] ...@@ -163,7 +164,7 @@ userLayout props = R.createElement userLayoutCpt props []
userLayoutCpt :: R.Component LayoutProps userLayoutCpt :: R.Component LayoutProps
userLayoutCpt = R.hooksComponentWithModule thisModule "userLayout" cpt userLayoutCpt = R.hooksComponentWithModule thisModule "userLayout" cpt
where where
cpt { appReload, asyncTasksRef, frontends, nodeId, session } _ = do cpt { appReload, asyncTasksRef, frontends, nodeId, session, treeReloadRef } _ = do
let sid = sessionId session let sid = sessionId session
pure $ userLayoutWithKey { pure $ userLayoutWithKey {
...@@ -173,6 +174,7 @@ userLayoutCpt = R.hooksComponentWithModule thisModule "userLayout" cpt ...@@ -173,6 +174,7 @@ userLayoutCpt = R.hooksComponentWithModule thisModule "userLayout" cpt
, key: show sid <> "-" <> show nodeId , key: show sid <> "-" <> show nodeId
, nodeId , nodeId
, session , session
, treeReloadRef
} }
userLayoutWithKey :: Record KeyLayoutProps -> R.Element userLayoutWithKey :: Record KeyLayoutProps -> R.Element
...@@ -181,7 +183,7 @@ userLayoutWithKey props = R.createElement userLayoutWithKeyCpt props [] ...@@ -181,7 +183,7 @@ userLayoutWithKey props = R.createElement userLayoutWithKeyCpt props []
userLayoutWithKeyCpt :: R.Component KeyLayoutProps userLayoutWithKeyCpt :: R.Component KeyLayoutProps
userLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "userLayoutWithKey" cpt userLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "userLayoutWithKey" cpt
where where
cpt { appReload, asyncTasksRef, frontends, nodeId, session } _ = do cpt { appReload, asyncTasksRef, frontends, nodeId, session, treeReloadRef } _ = do
reload <- R.useState' 0 reload <- R.useState' 0
cacheState <- R.useState' NT.CacheOn cacheState <- R.useState' NT.CacheOn
...@@ -198,6 +200,7 @@ userLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "userLayoutWithKey" ...@@ -198,6 +200,7 @@ userLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "userLayoutWithKey"
, frontends , frontends
, nodeId , nodeId
, session , session
, treeReloadRef
} }
] ]
where where
...@@ -240,7 +243,7 @@ annuaireUserLayout props = R.createElement annuaireUserLayoutCpt props [] ...@@ -240,7 +243,7 @@ annuaireUserLayout props = R.createElement annuaireUserLayoutCpt props []
annuaireUserLayoutCpt :: R.Component AnnuaireLayoutProps annuaireUserLayoutCpt :: R.Component AnnuaireLayoutProps
annuaireUserLayoutCpt = R.hooksComponentWithModule thisModule "annuaireUserLayout" cpt annuaireUserLayoutCpt = R.hooksComponentWithModule thisModule "annuaireUserLayout" cpt
where where
cpt { annuaireId, appReload, asyncTasksRef, frontends, nodeId, session } _ = do cpt { annuaireId, appReload, asyncTasksRef, frontends, nodeId, session, treeReloadRef } _ = do
cacheState <- R.useState' NT.CacheOn cacheState <- R.useState' NT.CacheOn
useLoader nodeId (getAnnuaireContact session annuaireId) $ useLoader nodeId (getAnnuaireContact session annuaireId) $
...@@ -255,6 +258,7 @@ annuaireUserLayoutCpt = R.hooksComponentWithModule thisModule "annuaireUserLayou ...@@ -255,6 +258,7 @@ annuaireUserLayoutCpt = R.hooksComponentWithModule thisModule "annuaireUserLayou
, frontends , frontends
, nodeId , nodeId
, session , session
, treeReloadRef
} }
] ]
......
...@@ -12,6 +12,7 @@ import Reactix as R ...@@ -12,6 +12,7 @@ import Reactix as R
import Gargantext.AsyncTasks as GAT import Gargantext.AsyncTasks as GAT
import Gargantext.Components.DocsTable as DT import Gargantext.Components.DocsTable as DT
import Gargantext.Components.NgramsTable as NT import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (ContactData) import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (ContactData)
import Gargantext.Components.Nodes.Lists.Types as NTypes import Gargantext.Components.Nodes.Lists.Types as NTypes
...@@ -51,6 +52,7 @@ type TabsProps = ( ...@@ -51,6 +52,7 @@ type TabsProps = (
, frontends :: Frontends , frontends :: Frontends
, nodeId :: Int , nodeId :: Int
, session :: Session , session :: Session
, treeReloadRef :: R.Ref (Maybe (R.State Int))
) )
tabs :: Record TabsProps -> R.Element tabs :: Record TabsProps -> R.Element
...@@ -59,7 +61,7 @@ tabs props = R.createElement tabsCpt props [] ...@@ -59,7 +61,7 @@ tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component TabsProps tabsCpt :: R.Component TabsProps
tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
where where
cpt { appReload, asyncTasksRef, cacheState, contactData: {defaultListId}, frontends, nodeId, session} _ = do cpt { appReload, asyncTasksRef, cacheState, contactData: {defaultListId}, frontends, nodeId, session, treeReloadRef } _ = do
active <- R.useState' 0 active <- R.useState' 0
pure $ pure $
Tab.tabs { selected: fst active, tabs: tabs' } Tab.tabs { selected: fst active, tabs: tabs' }
...@@ -72,9 +74,9 @@ tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt ...@@ -72,9 +74,9 @@ tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
, "Trash" /\ docs -- TODO pass-in trash mode , "Trash" /\ docs -- TODO pass-in trash mode
] ]
where where
patentsView = { appReload, asyncTasksRef, cacheState, defaultListId, mode: Patents, nodeId, session } patentsView = { appReload, asyncTasksRef, cacheState, defaultListId, mode: Patents, nodeId, session, treeReloadRef }
booksView = { appReload, asyncTasksRef, cacheState, defaultListId, mode: Books, nodeId, session } booksView = { appReload, asyncTasksRef, cacheState, defaultListId, mode: Books, nodeId, session, treeReloadRef }
commView = { appReload, asyncTasksRef, cacheState, defaultListId, mode: Communication, nodeId, session } commView = { appReload, asyncTasksRef, cacheState, defaultListId, mode: Communication, nodeId, session, treeReloadRef }
chart = mempty chart = mempty
totalRecords = 4736 -- TODO totalRecords = 4736 -- TODO
docs = DT.docViewLayout docs = DT.docViewLayout
...@@ -99,22 +101,32 @@ type NgramsViewTabsProps = ( ...@@ -99,22 +101,32 @@ type NgramsViewTabsProps = (
, mode :: Mode , mode :: Mode
, nodeId :: Int , nodeId :: Int
, session :: Session , session :: Session
, treeReloadRef :: R.Ref (Maybe (R.State Int))
) )
ngramsView :: Record NgramsViewTabsProps -> R.Element ngramsView :: Record NgramsViewTabsProps -> R.Element
ngramsView { appReload, asyncTasksRef, cacheState, defaultListId, mode, nodeId, session } = ngramsView props = R.createElement ngramsViewCpt props []
NT.mainNgramsTable {
appReload ngramsViewCpt :: R.Component NgramsViewTabsProps
, afterSync: \_ -> pure unit ngramsViewCpt = R.hooksComponentWithModule thisModule "ngramsView" cpt
, asyncTasksRef
, cacheState
, defaultListId
, nodeId
, tabType
, session
, tabNgramType
, withAutoUpdate: false
}
where where
tabNgramType = modeTabType' mode cpt { appReload, asyncTasksRef, cacheState, defaultListId, mode, nodeId, session, treeReloadRef } _ = do
tabType = TabPairing $ TabNgramType $ modeTabType mode pathS <- R.useState' $ NTC.initialPageParams session nodeId [defaultListId] (TabDocument TabDocs)
pure $ NT.mainNgramsTable {
appReload
, afterSync: \_ -> pure unit
, asyncTasksRef
, cacheState
, defaultListId
, nodeId
, pathS
, tabType
, session
, tabNgramType
, treeReloadRef
, withAutoUpdate: false
}
where
tabNgramType = modeTabType' mode
tabType = TabPairing $ TabNgramType $ modeTabType mode
...@@ -28,6 +28,7 @@ import Gargantext.Types (ChartType(..), TabType) ...@@ -28,6 +28,7 @@ import Gargantext.Types (ChartType(..), TabType)
import Gargantext.Utils.CacheAPI as GUC import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.Nodes.Corpus.Chart.Pie" thisModule = "Gargantext.Components.Nodes.Corpus.Chart.Pie"
newtype ChartMetrics = ChartMetrics { newtype ChartMetrics = ChartMetrics {
......
...@@ -31,6 +31,7 @@ type Props = ( ...@@ -31,6 +31,7 @@ type Props = (
, nodeId :: Int , nodeId :: Int
, session :: Session , session :: Session
, sessionUpdate :: Session -> Effect Unit , sessionUpdate :: Session -> Effect Unit
, treeReloadRef :: R.Ref (Maybe (R.State Int))
) )
listsLayout :: Record Props -> R.Element listsLayout :: Record Props -> R.Element
...@@ -55,7 +56,7 @@ listsLayoutWithKey props = R.createElement listsLayoutWithKeyCpt props [] ...@@ -55,7 +56,7 @@ listsLayoutWithKey props = R.createElement listsLayoutWithKeyCpt props []
listsLayoutWithKeyCpt :: R.Component KeyProps listsLayoutWithKeyCpt :: R.Component KeyProps
listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKey" cpt listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKey" cpt
where where
cpt { appReload, asyncTasksRef, nodeId, session, sessionUpdate } _ = do cpt { appReload, asyncTasksRef, nodeId, session, sessionUpdate, treeReloadRef } _ = do
let path = { nodeId, session } let path = { nodeId, session }
cacheState <- R.useState' $ getCacheState NT.CacheOn session nodeId cacheState <- R.useState' $ getCacheState NT.CacheOn session nodeId
...@@ -82,7 +83,9 @@ listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKe ...@@ -82,7 +83,9 @@ listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKe
, corpusData , corpusData
, corpusId , corpusId
, key: "listsLayoutWithKey-tabs-" <> (show $ fst cacheState) , key: "listsLayoutWithKey-tabs-" <> (show $ fst cacheState)
, session } , session
, treeReloadRef
}
] ]
where where
afterCacheStateChange cacheState = do afterCacheStateChange cacheState = do
......
module Gargantext.Components.Nodes.Lists.Tabs where module Gargantext.Components.Nodes.Lists.Tabs where
import Data.Array as A
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Reactix as R import Reactix as R
...@@ -11,6 +13,7 @@ import Gargantext.Prelude ...@@ -11,6 +13,7 @@ import Gargantext.Prelude
import Gargantext.AsyncTasks as GAT import Gargantext.AsyncTasks as GAT
import Gargantext.Components.NgramsTable as NT import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Nodes.Corpus.Types (CorpusData) import Gargantext.Components.Nodes.Corpus.Types (CorpusData)
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics) import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar) import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar)
...@@ -33,6 +36,7 @@ type Props = ( ...@@ -33,6 +36,7 @@ type Props = (
, corpusData :: CorpusData , corpusData :: CorpusData
, corpusId :: Int , corpusId :: Int
, session :: Session , session :: Session
, treeReloadRef :: R.Ref (Maybe (R.State Int))
) )
type PropsWithKey = ( type PropsWithKey = (
...@@ -46,7 +50,7 @@ tabs props = R.createElement tabsCpt props [] ...@@ -46,7 +50,7 @@ tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component PropsWithKey tabsCpt :: R.Component PropsWithKey
tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
where where
cpt { appReload, asyncTasksRef, cacheState, corpusData, corpusId, session } _ = do cpt { appReload, asyncTasksRef, cacheState, corpusData, corpusId, session, treeReloadRef } _ = do
(selected /\ setSelected) <- R.useState' 0 (selected /\ setSelected) <- R.useState' 0
pure $ Tab.tabs { selected, tabs: tabs' } pure $ Tab.tabs { selected, tabs: tabs' }
...@@ -55,7 +59,7 @@ tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt ...@@ -55,7 +59,7 @@ tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
, "Institutes" /\ view Institutes , "Institutes" /\ view Institutes
, "Sources" /\ view Sources , "Sources" /\ view Sources
, "Terms" /\ view Terms ] , "Terms" /\ view Terms ]
view mode = ngramsView { appReload, asyncTasksRef, cacheState, corpusData, corpusId, mode, session } view mode = ngramsView { appReload, asyncTasksRef, cacheState, corpusData, corpusId, mode, session, treeReloadRef }
type NgramsViewProps = ( mode :: Mode | Props ) type NgramsViewProps = ( mode :: Mode | Props )
...@@ -71,22 +75,40 @@ ngramsViewCpt = R.hooksComponentWithModule thisModule "ngramsView" cpt ...@@ -71,22 +75,40 @@ ngramsViewCpt = R.hooksComponentWithModule thisModule "ngramsView" cpt
, corpusData: { defaultListId } , corpusData: { defaultListId }
, corpusId , corpusId
, mode , mode
, session } _ = do , session
, treeReloadRef
} _ = do
chartType <- R.useState' Histo chartType <- R.useState' Histo
chartsReload <- R.useState' 0 chartsReload <- R.useState' 0
pathS <- R.useState' $ NTC.initialPageParams session initialPath.corpusId [initialPath.listId] initialPath.tabType
let listId' = fromMaybe defaultListId $ A.head (fst pathS).listIds
let path = {
corpusId: (fst pathS).nodeId
, limit: (fst pathS).params.limit
, listId: listId'
, tabType: (fst pathS).tabType
}
let chartParams = {
corpusId: path.corpusId
, limit: Just path.limit
, listId: path.listId
, tabType: path.tabType
}
pure $ R.fragment pure $ R.fragment
( charts tabNgramType chartType chartsReload ( charts chartParams tabNgramType chartType chartsReload
<> [ NT.mainNgramsTable { afterSync: afterSync chartsReload <> [ NT.mainNgramsTable { afterSync: afterSync chartsReload
, appReload , appReload
, asyncTasksRef , asyncTasksRef
, cacheState , cacheState
, defaultListId , defaultListId
, nodeId: corpusId , nodeId: corpusId
, pathS
, session , session
, tabNgramType , tabNgramType
, tabType , tabType
, treeReloadRef
, withAutoUpdate: false , withAutoUpdate: false
} }
] ]
...@@ -104,25 +126,26 @@ ngramsViewCpt = R.hooksComponentWithModule thisModule "ngramsView" cpt ...@@ -104,25 +126,26 @@ ngramsViewCpt = R.hooksComponentWithModule thisModule "ngramsView" cpt
tabNgramType = modeTabType mode tabNgramType = modeTabType mode
tabType = TabCorpus (TabNgramType tabNgramType) tabType = TabCorpus (TabNgramType tabNgramType)
mNgramsType = mNgramsTypeFromTabType tabType mNgramsType = mNgramsTypeFromTabType tabType
listId = defaultListId listId = defaultListId
path = { corpusId initialPath = { corpusId
, limit: Just 1000 -- , limit: Just 1000
, listId , listId
, tabType , tabType
} }
charts CTabTerms (chartType /\ setChartType) _ = [ charts params CTabTerms (chartType /\ setChartType) _ = [
H.div { className: "row chart-type-selector" } [ H.div { className: "row chart-type-selector" } [
H.div { className: "col-md-3" } [ H.div { className: "col-md-3" } [
R2.select { className: "form-control" R2.select { className: "form-control"
, on: { change: \e -> setChartType , defaultValue: show chartType
, on: { change: \e -> setChartType
$ const $ const
$ fromMaybe Histo $ fromMaybe Histo
$ chartTypeFromString $ chartTypeFromString
$ R.unsafeEventValue e $ R.unsafeEventValue e
} }
, defaultValue: show chartType } [ } [
H.option { value: show Histo } [ H.text $ show Histo ] H.option { value: show Histo } [ H.text $ show Histo ]
, H.option { value: show Scatter } [ H.text $ show Scatter ] , H.option { value: show Scatter } [ H.text $ show Scatter ]
, H.option { value: show ChartBar } [ H.text $ show ChartBar ] , H.option { value: show ChartBar } [ H.text $ show ChartBar ]
...@@ -131,11 +154,11 @@ ngramsViewCpt = R.hooksComponentWithModule thisModule "ngramsView" cpt ...@@ -131,11 +154,11 @@ ngramsViewCpt = R.hooksComponentWithModule thisModule "ngramsView" cpt
] ]
] ]
] ]
, getChartFunction chartType $ { session, path } , getChartFunction chartType $ { path: params, session }
] ]
charts _ _ _ = [ chart mode ] charts params _ _ _ = [ chart params mode ]
chart Authors = pie { path, session } chart path Authors = pie { path, session }
chart Institutes = tree { path, session } chart path Institutes = tree { path, session }
chart Sources = bar { path, session } chart path Sources = bar { path, session }
chart Terms = metrics { path, session } chart path Terms = metrics { path, session }
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