Skip to content

P
purescript-gargantext
Commit 51dd886f authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

[ngrams] asyncTasks cache work

parent aba97048
Hide whitespace changes
Inline Side-by-side
Showing with 281 additions and 141 deletions
src/Gargantext/AsyncTasks.purs
View file @ 51dd886f
......@@ -5,9 +5,11 @@ import Data.Argonaut.Parser (jsonParser)
import Data.Array as A
import Data.Either (Either(..))
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..), maybe)
import Data.Tuple (snd)
import DOM.Simple.Console (log2)
import Effect (Effect)
import Reactix as R
import Web.Storage.Storage as WSS
import Gargantext.Prelude
......@@ -19,7 +21,9 @@ import Gargantext.Utils.Reactix as R2
localStorageKey :: String
localStorageKey = "garg-async-tasks"
type Storage = Map.Map Int (Array GT.AsyncTaskWithType)
type NodeId = Int
type Storage = Map.Map NodeId (Array GT.AsyncTaskWithType)
empty :: Storage
empty = Map.empty
......@@ -40,3 +44,26 @@ getAsyncTasks = R2.getls >>= WSS.getItem localStorageKey >>= handleMaybe
removeTaskFromList :: Array GT.AsyncTaskWithType -> GT.AsyncTaskWithType -> Array GT.AsyncTaskWithType
removeTaskFromList ts (GT.AsyncTaskWithType { task: GT.AsyncTask { id: id' } }) =
A.filter (\(GT.AsyncTaskWithType { task: GT.AsyncTask { id: id'' } }) -> id' /= id'') ts
type ReductorProps = (
reload :: R.State Int
, storage :: Storage
)
useTasks :: R.State Int -> R.Hooks (R2.Reductor (Record ReductorProps) Action)
useTasks reload = R2.useReductor act (const { reload, storage: getAsyncTasks }) unit
where
act :: R2.Actor (Record ReductorProps) Action
act a s = action s a
data Action =
Insert NodeId GT.AsyncTaskWithType
| Remove NodeId GT.AsyncTaskWithType
action :: Record ReductorProps -> Action -> Effect Storage
action { reload, storage } (Insert id t) = do
snd reload $ (_ + 1)
pure $ Map.alter (maybe (Just [t]) (\ts -> Just $ A.cons t ts)) id storage
action { reload, storage } (Remove id t) = do
snd reload $ (_ + 1)
pure $ Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts t)) id storage
src/Gargantext/Components/App.purs
View file @ 51dd886f
......@@ -10,7 +10,7 @@ import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Config (publicBackend)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest (forest)
import Gargantext.Components.GraphExplorer (explorerLayout)
import Gargantext.Components.Lang (LandingLang(..))
......@@ -25,7 +25,7 @@ import Gargantext.Components.Nodes.Frame (frameLayout)
import Gargantext.Components.Nodes.Home (homeLayout)
import Gargantext.Components.Nodes.Lists (listsLayout)
import Gargantext.Components.Nodes.Texts (textsLayout)
import Gargantext.Config (defaultFrontends, defaultBackends)
import Gargantext.Config (defaultFrontends, defaultBackends, publicBackend)
import Gargantext.Ends (Frontends, Backend)
import Gargantext.Hooks.Router (useHashRouter)
import Gargantext.License (license)
......@@ -61,9 +61,12 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
handed <- R.useState' GT.RightHanded
asyncTasks <- R2.useLocalStorageState GAT.localStorageKey GAT.empty
let backends = fromFoldable defaultBackends
let ff f session = R.fragment [ f session, footer { session } ]
let forested child = forestLayout { child
let forested child = forestLayout { asyncTasks
, child
, frontends
, handed
, reload: treeReload
......@@ -88,7 +91,7 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
false ->
case fst route of
Annuaire sid nodeId -> withSession sid $ \session -> forested $ annuaireLayout { frontends, nodeId, session }
ContactPage sid aId nodeId -> withSession sid $ \session -> forested $ annuaireUserLayout { annuaireId: aId, frontends, nodeId, session }
ContactPage sid aId nodeId -> withSession sid $ \session -> forested $ annuaireUserLayout { annuaireId: aId, asyncTasks, frontends, nodeId, session }
Corpus sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
CorpusDocument sid corpusId listId nodeId -> withSession sid $ \session -> forested $ documentLayout { nodeId, listId, session, corpusId: Just corpusId }
Dashboard sid nodeId -> withSession sid $ \session -> forested $ dashboardLayout { nodeId, session }
......@@ -100,13 +103,14 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
FolderPublic sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
FolderShared sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
Home -> forested $ homeLayout { backend, lang:LL_EN, publicBackend, sessions, visible: showLogin }
Lists sid nodeId -> withSession sid $ \session -> forested $ listsLayout { nodeId, session, sessionUpdate }
Lists sid nodeId -> withSession sid $ \session -> forested $ listsLayout { asyncTasks, nodeId, session, sessionUpdate }
Login -> login { backend, backends, sessions, visible: showLogin }
PGraphExplorer sid graphId ->
withSession sid $
\session ->
simpleLayout handed $
explorerLayout { backend
explorerLayout { asyncTasks
, backend
, frontends
, graphId
, handed: fst handed
......@@ -121,10 +125,11 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
RouteFrameWrite sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session }
Team sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
Texts sid nodeId -> withSession sid $ \session -> forested $ textsLayout { frontends, nodeId, session, sessionUpdate }
UserPage sid nodeId -> withSession sid $ \session -> forested $ userLayout { frontends, nodeId, session }
UserPage sid nodeId -> withSession sid $ \session -> forested $ userLayout { asyncTasks, frontends, nodeId, session }
type ForestLayoutProps =
( backend :: R.State (Maybe Backend)
( asyncTasks :: R.State GAT.Storage
, backend :: R.State (Maybe Backend)
, child :: R.Element
, frontends :: Frontends
, handed :: R.State GT.Handed
......@@ -149,7 +154,7 @@ forestLayoutMain props = R.createElement forestLayoutMainCpt props []
forestLayoutMainCpt :: R.Component ForestLayoutProps
forestLayoutMainCpt = R.hooksComponentWithModule thisModule "forestLayoutMain" cpt
where
cpt { child, frontends, handed, reload, route, sessions, showLogin, backend} _ = do
cpt { asyncTasks, child, frontends, handed, reload, route, sessions, showLogin, backend} _ = do
let ordering =
case fst handed of
GT.LeftHanded -> reverse
......@@ -157,7 +162,7 @@ forestLayoutMainCpt = R.hooksComponentWithModule thisModule "forestLayoutMain" c
pure $ R2.row $ ordering [
H.div { className: "col-md-2", style: { paddingTop: "60px" } }
[ forest { frontends, handed: fst handed, reload, route, sessions, showLogin, backend} ]
[ forest { asyncTasks, backend, frontends, handed: fst handed, reload, route, sessions, showLogin } ]
, mainPage child
]
......
src/Gargantext/Components/Forest.purs
View file @ 51dd886f
......@@ -22,13 +22,14 @@ thisModule :: String
thisModule = "Gargantext.Components.Forest"
type Props =
( backend :: R.State (Maybe Backend)
, frontends :: Frontends
, handed :: Handed
, reload :: R.State Int
, route :: AppRoute
, sessions :: Sessions
, showLogin :: R.Setter Boolean
( asyncTasks :: R.State GAT.Storage
, backend :: R.State (Maybe Backend)
, frontends :: Frontends
, handed :: Handed
, reload :: R.State Int
, route :: AppRoute
, sessions :: Sessions
, showLogin :: R.Setter Boolean
)
forest :: Record Props -> R.Element
......@@ -36,11 +37,10 @@ forest props = R.createElement forestCpt props []
forestCpt :: R.Component Props
forestCpt = R.hooksComponentWithModule thisModule "forest" cpt where
cpt { frontends, handed, reload: extReload, route, sessions, showLogin, backend} _ = do
cpt { asyncTasks, frontends, handed, reload: extReload, route, sessions, showLogin, backend} _ = do
-- NOTE: this is a hack to reload the tree view on demand
reload <- R.useState' (0 :: Reload)
openNodes <- R2.useLocalStorageState R2.openNodesKey (Set.empty :: OpenNodes)
asyncTasks <- R2.useLocalStorageState GAT.localStorageKey GAT.empty
R2.useCache
( frontends
/\ route
......
src/Gargantext/Components/Forest/Tree.purs
View file @ 51dd886f
......@@ -44,16 +44,16 @@ thisModule = "Gargantext.Components.Forest.Tree"
------------------------------------------------------------------------
type CommonProps =
( frontends :: Frontends
, handed :: GT.Handed
, mCurrentRoute :: Maybe AppRoute
, openNodes :: R.State OpenNodes
, reload :: R.State Reload
, session :: Session
, handed :: GT.Handed
)
------------------------------------------------------------------------
type Props = ( root :: ID
, asyncTasks :: R.State GAT.Storage
type Props = ( asyncTasks :: R.State GAT.Storage
, root :: ID
| CommonProps
)
......@@ -63,22 +63,22 @@ treeView props = R.createElement treeViewCpt props []
treeViewCpt :: R.Component Props
treeViewCpt = R.hooksComponentWithModule thisModule "treeView" cpt
where
cpt { root
, asyncTasks
cpt { asyncTasks
, frontends
, handed
, mCurrentRoute
, openNodes
, reload
, root
, session
} _children = pure
$ treeLoadView { root
, asyncTasks
$ treeLoadView { asyncTasks
, frontends
, handed
, mCurrentRoute
, openNodes
, reload
, root
, session
}
......@@ -88,13 +88,13 @@ treeLoadView p = R.createElement treeLoadViewCpt p []
treeLoadViewCpt :: R.Component Props
treeLoadViewCpt = R.hooksComponentWithModule thisModule "treeLoadView" cpt
where
cpt { root
, asyncTasks
cpt { asyncTasks
, frontends
, handed
, mCurrentRoute
, openNodes
, reload
, root
, session
} _children = do
let fetch _ = getNodeTree session root
......@@ -116,8 +116,8 @@ getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) ""
--------------
type TreeViewProps = ( asyncTasks :: R.State GAT.Storage
, tree :: FTree
, tasks :: Record Tasks
, tree :: FTree
| CommonProps
)
......@@ -168,6 +168,7 @@ type ToHtmlProps =
toHtml :: Record ToHtmlProps -> R.Element
toHtml p@{ asyncTasks
, frontends
, handed
, mCurrentRoute
, openNodes
, reload: reload@(_ /\ setReload)
......@@ -182,7 +183,6 @@ toHtml p@{ asyncTasks
}
) ary
)
, handed
} =
R.createElement el {} []
where
......@@ -201,11 +201,11 @@ toHtml p@{ asyncTasks
pure $ H.li { className: if A.null ary then "no-children" else "with-children" } $
[ nodeMainSpan (A.null ary)
{ id
, dispatch: pAction
{ dispatch: pAction
, folderOpen
, frontends
, handed
, id
, mCurrentRoute
, name
, nodeType
......@@ -262,10 +262,10 @@ performAction :: Action
-> Record PerformActionProps
-> Aff Unit
performAction (DeleteNode nt) p@{ openNodes: (_ /\ setOpenNodes)
, reload: (_ /\ setReload)
, session
, tree: (NTree (LNode {id, parent_id}) _)
} =
, reload: (_ /\ setReload)
, session
, tree: (NTree (LNode {id, parent_id}) _)
} =
do
case nt of
GT.NodePublic GT.FolderPublic -> void $ deleteNode session nt id
......@@ -287,10 +287,10 @@ performAction (DoSearch task) { reload: (_ /\ setReload)
-------
performAction (UpdateNode params) { reload: (_ /\ setReload)
, session
, tasks: {onTaskAdd}
, tree: (NTree (LNode {id}) _)
} =
, session
, tasks: {onTaskAdd}
, tree: (NTree (LNode {id}) _)
} =
do
task <- updateRequest params session id
liftEffect $ onTaskAdd task
......
src/Gargantext/Components/GraphExplorer.purs
View file @ 51dd886f
......@@ -20,6 +20,7 @@ import Reactix as R
import Reactix.DOM.HTML as RH
import Record as Record
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest (forest)
import Gargantext.Components.Graph as Graph
import Gargantext.Components.GraphExplorer.Controls as Controls
......@@ -41,7 +42,8 @@ thisModule :: String
thisModule = "Gargantext.Components.GraphExplorer"
type LayoutProps =
( frontends :: Frontends
( asyncTasks :: R.State GAT.Storage
, frontends :: Frontends
, graphId :: GET.GraphId
, handed :: Types.Handed
, mCurrentRoute :: AppRoute
......@@ -90,7 +92,8 @@ explorer props = R.createElement explorerCpt props []
explorerCpt :: R.Component Props
explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt
where
cpt props@{ frontends
cpt props@{ asyncTasks
, frontends
, graph
, graphId
, graphVersion
......@@ -154,14 +157,15 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt
[ inner handed
[ rowControls [ Controls.controls controls ]
, R2.row $ mainLayout handed $
tree { frontends
, handed
, mCurrentRoute
, reload: treeReload
, sessions
, show: fst controls.showTree
, showLogin: snd showLogin
, backend}
tree { asyncTasks
, backend
, frontends
, handed
, mCurrentRoute
, reload: treeReload
, sessions
, show: fst controls.showTree
, showLogin: snd showLogin }
/\
RH.div { ref: graphRef, id: "graph-view", className: "col-md-12" } []
/\
......@@ -208,9 +212,9 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt
tree :: Record TreeProps -> R.Element
tree { show: false } = RH.div { id: "tree" } []
tree { frontends, handed, mCurrentRoute: route, reload, sessions, showLogin, backend} =
tree { asyncTasks, backend, frontends, handed, mCurrentRoute: route, reload, sessions, showLogin } =
RH.div {className: "col-md-2 graph-tree"} [
forest { frontends, handed, reload, route, sessions, showLogin, backend}
forest { asyncTasks, backend, frontends, handed, reload, route, sessions, showLogin }
]
mSidebar :: Maybe GET.MetaData
......@@ -222,14 +226,15 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt
type TreeProps =
(
frontends :: Frontends
, handed :: Types.Handed
asyncTasks :: R.State GAT.Storage
, backend :: R.State (Maybe Backend)
, frontends :: Frontends
, handed :: Types.Handed
, mCurrentRoute :: AppRoute
, reload :: R.State Int
, sessions :: Sessions
, show :: Boolean
, showLogin :: R.Setter Boolean
, backend :: R.State (Maybe Backend)
, reload :: R.State Int
, sessions :: Sessions
, show :: Boolean
, showLogin :: R.Setter Boolean
)
type MSidebarProps =
......
src/Gargantext/Components/GraphExplorer/Sidebar.purs
View file @ 51dd886f
......@@ -223,7 +223,10 @@ deleteNode :: TermList
-> 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 = do
ret <- NTC.putNgramsPatches coreParams versioned
task <- NTC.postNgramsChartsAsync coreParams -- TODO add task
pure ret
where
nodeId :: Int
nodeId = unsafePartial $ fromJust $ fromString node.id
......
src/Gargantext/Components/NgramsTable.purs
View file @ 51dd886f
......@@ -22,15 +22,17 @@ import Data.Set as Set
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log)
import DOM.Simple.Console (log, log2)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import FFI.Simple (delay)
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.NgramsTable.Components as NTC
......@@ -279,6 +281,7 @@ tableContainerCpt { dispatch
-- NEXT
type Props =
( afterSync :: Unit -> Aff Unit
, asyncTasks :: R.State GAT.Storage
, path :: R.State PageParams
, state :: R.State State
, tabNgramType :: CTabNgramType
......@@ -293,6 +296,7 @@ loadedNgramsTableCpt :: R.Component Props
loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable" cpt
where
cpt { afterSync
, asyncTasks
, path: path@(path'@{ searchQuery, scoreType, params, termListFilter, termSizeFilter } /\ setPath)
, state: (state@{ ngramsChildren
, ngramsLocalPatch
......@@ -357,7 +361,12 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable"
s { ngramsSelection = Set.empty :: Set NgramsTerm }
else
s { ngramsSelection = selectNgramsOnFirstPage filteredRows }
performAction (Synchronize { afterSync }) = syncPatches path' (state /\ setState) afterSync
performAction (Synchronize { afterSync }) = do
syncPatches path' (state /\ setState) afterSync
launchAff_ $ do
task <- postNgramsChartsAsync path'
liftEffect $ do
log2 "[performAction] Synchronize task" task
performAction (CommitPatch pt) =
commitPatch (Versioned {version: ngramsVersion, data: pt}) (state /\ setState)
performAction ResetPatches =
......@@ -518,8 +527,9 @@ selectNgramsOnFirstPage :: PreConversionRows -> Set NgramsTerm
selectNgramsOnFirstPage rows = Set.fromFoldable $ (view $ _NgramsElement <<< _ngrams) <$> rows
type MainNgramsTableProps =
( afterSync :: Unit -> Aff Unit
type MainNgramsTableProps = (
afterSync :: Unit -> Aff Unit
, asyncTasks :: R.State GAT.Storage
, cacheState :: R.State NT.CacheState
, defaultListId :: Int
, nodeId :: Int
......@@ -537,6 +547,7 @@ mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = R.hooksComponentWithModule thisModule "mainNgramsTable" cpt
where
cpt props@{ afterSync
, asyncTasks
, cacheState
, defaultListId
, nodeId
......@@ -546,7 +557,12 @@ mainNgramsTableCpt = R.hooksComponentWithModule thisModule "mainNgramsTable" cpt
, withAutoUpdate } _ = do
let path = initialPageParams session nodeId [defaultListId] tabType
let render versioned = mainNgramsTablePaint { afterSync, path, tabNgramType, versioned, withAutoUpdate }
let render versioned = mainNgramsTablePaint { afterSync
, asyncTasks
, path
, tabNgramType
, versioned
, withAutoUpdate }
case cacheState of
(NT.CacheOn /\ _) ->
......@@ -588,8 +604,9 @@ mainNgramsTableCpt = R.hooksComponentWithModule thisModule "mainNgramsTable" cpt
pathNoLimit path@{ params } = path { params = params { limit = 100000 }
, termListFilter = Nothing }
type MainNgramsTablePaintProps =
( afterSync :: Unit -> Aff Unit
type MainNgramsTablePaintProps = (
afterSync :: Unit -> Aff Unit
, asyncTasks :: R.State GAT.Storage
, path :: PageParams
, tabNgramType :: CTabNgramType
, versioned :: VersionedNgramsTable
......@@ -602,12 +619,13 @@ mainNgramsTablePaint p = R.createElement mainNgramsTablePaintCpt p []
mainNgramsTablePaintCpt :: R.Component MainNgramsTablePaintProps
mainNgramsTablePaintCpt = R.hooksComponentWithModule thisModule "mainNgramsTablePaint" cpt
where
cpt { afterSync, path, tabNgramType, versioned, withAutoUpdate } _ = do
cpt props@{ afterSync, asyncTasks, path, tabNgramType, versioned, withAutoUpdate } _ = do
pathS <- R.useState' path
state <- R.useState' $ initialState versioned
pure $ loadedNgramsTable {
afterSync
, asyncTasks
, path: pathS
, state
, tabNgramType
......
src/Gargantext/Components/NgramsTable/Core.purs
View file @ 51dd886f
......@@ -19,6 +19,7 @@ module Gargantext.Components.NgramsTable.Core
, Version
, Versioned(..)
, VersionedNgramsPatches
, AsyncNgramsChartsUpdate
, VersionedNgramsTable
, CoreState
, highlightNgrams
......@@ -50,7 +51,9 @@ module Gargantext.Components.NgramsTable.Core
, _ngrams_scores
, commitPatch
, putNgramsPatches
, postNgramsChartsAsync
, syncPatches
-- , syncPatchesAsync
, addNewNgram
, Action(..)
, Dispatch
......@@ -114,8 +117,8 @@ import Partial.Unsafe (unsafePartial)
import Gargantext.Prelude
import Gargantext.Components.Table as T
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, put)
import Gargantext.Types (CTabNgramType(..), OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..))
import Gargantext.Sessions (Session, get, post, put)
import Gargantext.Types (AsyncTaskType(..), AsyncTaskWithType(..), CTabNgramType(..), ListId, OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..))
import Gargantext.Utils.KarpRabin (indicesOfAny)
type Endo a = a -> a
......@@ -732,6 +735,15 @@ applyPatchMap applyPatchValue (PatchMap pm) m = mergeMap f pm m
type NgramsPatches = PatchMap NgramsTerm NgramsPatch
type VersionedNgramsPatches = Versioned NgramsPatches
newtype AsyncNgramsChartsUpdate = AsyncNgramsChartsUpdate {
listId :: Maybe ListId
, tabType :: TabType
}
instance encodeAsyncNgramsChartsUpdate :: EncodeJson AsyncNgramsChartsUpdate where
encodeJson (AsyncNgramsChartsUpdate { listId, tabType }) = do
"list_id" := listId
~> "tab_type" := tabType
~> jsonEmptyObject
type NewElems = Map NgramsTerm TermList
......@@ -867,9 +879,18 @@ addNewNgram ngrams list =
{ ngramsPatches: singletonPatchMap ngrams (newNgramPatch list) }
putNgramsPatches :: forall s. CoreParams s -> VersionedNgramsPatches -> Aff VersionedNgramsPatches
putNgramsPatches {session, nodeId, listIds, tabType} = put session putNgrams
putNgramsPatches { listIds, nodeId, session, tabType } = put session putNgrams
where putNgrams = PutNgrams tabType (head listIds) Nothing (Just nodeId)
postNgramsChartsAsync :: forall s. CoreParams s -> Aff AsyncTaskWithType
postNgramsChartsAsync { listIds, nodeId, session, tabType } = do
task <- post session putNgramsAsync acu
pure $ AsyncTaskWithType { task, typ: UpdateNgramsCharts }
where
acu = AsyncNgramsChartsUpdate { listId: head listIds
, tabType }
putNgramsAsync = PostNgramsChartsAsync (Just nodeId)
syncPatches :: forall p s. CoreParams p -> R.State (CoreState s) -> (Unit -> Aff Unit) -> Effect Unit
syncPatches props ({ ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches }
, ngramsStagePatch
......@@ -885,6 +906,7 @@ syncPatches props ({ ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches }
launchAff_ $ do
Versioned { data: newPatch, version: newVersion } <- putNgramsPatches props pt
callback unit
-- task <- postNgramsChartsAsync props
liftEffect $ do
log2 "[syncPatches] setting state, newVersion" newVersion
setState $ \s ->
......@@ -899,6 +921,33 @@ syncPatches props ({ ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches }
, ngramsVersion = newVersion
}
log2 "[syncPatches] ngramsVersion" newVersion
pure unit
{-
syncPatchesAsync :: forall p s. CoreParams p -> R.State (CoreState s) -> (Unit -> Aff Unit) -> Effect Unit
syncPatchesAsync props@{ listIds, tabType }
({ ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches }
, ngramsStagePatch
, ngramsValidPatch
, ngramsVersion
} /\ setState) callback = do
when (isEmptyNgramsTablePatch ngramsStagePatch) $ do
let patch = Versioned { data: ngramsPatches, version: ngramsVersion }
launchAff_ $ do
Versioned { data: newPatch, version: newVersion } <- postNgramsPatchesAsync props patch
callback unit
liftEffect $ do
log2 "[syncPatches] setting state, newVersion" newVersion
setState $ \s ->
s {
ngramsLocalPatch = fromNgramsPatches mempty
, ngramsStagePatch = fromNgramsPatches mempty
, ngramsValidPatch = fromNgramsPatches newPatch <> ngramsLocalPatch <> s.ngramsValidPatch
-- First the already valid patch, then the local patch, then the newly received newPatch.
, ngramsVersion = newVersion
}
log2 "[syncPatches] ngramsVersion" newVersion
-}
commitPatch :: forall s. Versioned NgramsTablePatch -> R.State (CoreState s) -> Effect Unit
commitPatch (Versioned {version, data: tablePatch}) (_ /\ setState) = do
......
src/Gargantext/Components/Nodes/Annuaire/User/Contacts.purs
View file @ 51dd886f
......@@ -15,6 +15,7 @@ import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), ContactData, ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser)
......@@ -145,7 +146,8 @@ infoRender (Tuple title content) =
, H.span {} [H.text content] ]
type LayoutProps = (
frontends :: Frontends
asyncTasks :: R.State GAT.Storage
, frontends :: Frontends
, nodeId :: Int
, session :: Session
)
......@@ -161,10 +163,10 @@ userLayout props = R.createElement userLayoutCpt props []
userLayoutCpt :: R.Component LayoutProps
userLayoutCpt = R.hooksComponentWithModule thisModule "userLayout" cpt
where
cpt { frontends, nodeId, session } _ = do
cpt { asyncTasks, frontends, nodeId, session } _ = do
let sid = sessionId session
pure $ userLayoutWithKey { frontends, key: show sid <> "-" <> show nodeId, nodeId, session }
pure $ userLayoutWithKey { asyncTasks, frontends, key: show sid <> "-" <> show nodeId, nodeId, session }
userLayoutWithKey :: Record KeyLayoutProps -> R.Element
userLayoutWithKey props = R.createElement userLayoutWithKeyCpt props []
......@@ -172,7 +174,7 @@ userLayoutWithKey props = R.createElement userLayoutWithKeyCpt props []
userLayoutWithKeyCpt :: R.Component KeyLayoutProps
userLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "userLayoutWithKey" cpt
where
cpt { frontends, nodeId, session } _ = do
cpt { asyncTasks, frontends, nodeId, session } _ = do
reload <- R.useState' 0
cacheState <- R.useState' NT.CacheOn
......@@ -181,7 +183,7 @@ userLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "userLayoutWithKey"
\contactData@{contactNode: Contact {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" } [
display (fromMaybe "no name" name) (contactInfos hyperdata (onUpdateHyperdata reload))
, Tabs.tabs { cacheState, contactData, frontends, nodeId, session }
, Tabs.tabs { asyncTasks, cacheState, contactData, frontends, nodeId, session }
]
where
onUpdateHyperdata :: R.State Int -> HyperdataUser -> Effect Unit
......@@ -212,8 +214,8 @@ saveContactHyperdata session id h = do
put session (Routes.NodeAPI Node (Just id) "") h
type AnnuaireLayoutProps =
( annuaireId :: Int
type AnnuaireLayoutProps = (
annuaireId :: Int
| LayoutProps )
......@@ -223,14 +225,14 @@ annuaireUserLayout props = R.createElement annuaireUserLayoutCpt props []
annuaireUserLayoutCpt :: R.Component AnnuaireLayoutProps
annuaireUserLayoutCpt = R.hooksComponentWithModule thisModule "annuaireUserLayout" cpt
where
cpt { annuaireId, frontends, nodeId, session } _ = do
cpt { annuaireId, asyncTasks, frontends, nodeId, session } _ = do
cacheState <- R.useState' NT.CacheOn
useLoader nodeId (getAnnuaireContact session annuaireId) $
\contactData@{contactNode: Contact {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" }
[ display (fromMaybe "no name" name) (contactInfos hyperdata onUpdateHyperdata)
, Tabs.tabs { cacheState, contactData, frontends, nodeId, session } ]
, Tabs.tabs { asyncTasks, cacheState, contactData, frontends, nodeId, session } ]
where
onUpdateHyperdata :: HyperdataUser -> Effect Unit
......
src/Gargantext/Components/Nodes/Annuaire/User/Contacts/Tabs.purs
View file @ 51dd886f
......@@ -9,6 +9,7 @@ import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Reactix as R
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.DocsTable as DT
import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.Tab as Tab
......@@ -43,8 +44,9 @@ modeTabType' Patents = CTabAuthors
modeTabType' Books = CTabAuthors
modeTabType' Communication = CTabAuthors
type TabsProps =
( cacheState :: R.State NTypes.CacheState
type TabsProps = (
asyncTasks :: R.State GAT.Storage
, cacheState :: R.State NTypes.CacheState
, contactData :: ContactData
, frontends :: Frontends
, nodeId :: Int
......@@ -57,7 +59,7 @@ tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component TabsProps
tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
where
cpt { cacheState, contactData: {defaultListId}, frontends, nodeId, session} _ = do
cpt { asyncTasks, cacheState, contactData: {defaultListId}, frontends, nodeId, session} _ = do
active <- R.useState' 0
pure $
Tab.tabs { selected: fst active, tabs: tabs' }
......@@ -70,9 +72,9 @@ tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
, "Trash" /\ docs -- TODO pass-in trash mode
]
where
patentsView = { cacheState, defaultListId, mode: Patents, nodeId, session }
booksView = { cacheState, defaultListId, mode: Books, nodeId, session }
commView = { cacheState, defaultListId, mode: Communication, nodeId, session }
patentsView = { asyncTasks, cacheState, defaultListId, mode: Patents, nodeId, session }
booksView = { asyncTasks, cacheState, defaultListId, mode: Books, nodeId, session }
commView = { asyncTasks, cacheState, defaultListId, mode: Communication, nodeId, session }
chart = mempty
totalRecords = 4736 -- TODO
docs = DT.docViewLayout
......@@ -83,8 +85,9 @@ tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
, showSearch: true }
type NgramsViewTabsProps =
( cacheState :: R.State NTypes.CacheState
type NgramsViewTabsProps = (
asyncTasks :: R.State GAT.Storage
, cacheState :: R.State NTypes.CacheState
, defaultListId :: Int
, mode :: Mode
, nodeId :: Int
......@@ -92,9 +95,10 @@ type NgramsViewTabsProps =
)
ngramsView :: Record NgramsViewTabsProps -> R.Element
ngramsView { cacheState, defaultListId, mode, nodeId, session } =
ngramsView { asyncTasks, cacheState, defaultListId, mode, nodeId, session } =
NT.mainNgramsTable {
afterSync: \_ -> pure unit
, asyncTasks
, cacheState
, defaultListId
, nodeId
......
src/Gargantext/Components/Nodes/Lists.purs
View file @ 51dd886f
......@@ -3,7 +3,9 @@ module Gargantext.Components.Nodes.Lists where
import Effect (Effect)
import Effect.Aff (launchAff_)
import Reactix as R
import Record as Record
------------------------------------------------------------------------
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.NgramsTable.Loader (clearCache)
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
......@@ -22,8 +24,9 @@ thisModule = "Gargantext.Components.Nodes.Lists"
------------------------------------------------------------------------
type Props = (
nodeId :: Int
, session :: Session
asyncTasks :: R.State GAT.Storage
, nodeId :: Int
, session :: Session
, sessionUpdate :: Session -> Effect Unit
)
......@@ -33,10 +36,10 @@ listsLayout props = R.createElement listsLayoutCpt props []
listsLayoutCpt :: R.Component Props
listsLayoutCpt = R.hooksComponentWithModule thisModule "listsLayout" cpt
where
cpt path@{ nodeId, session, sessionUpdate } _ = do
cpt path@{ nodeId, session } _ = do
let sid = sessionId session
pure $ listsLayoutWithKey { key: show sid <> "-" <> show nodeId, nodeId, session, sessionUpdate }
pure $ listsLayoutWithKey $ Record.merge path { key: show sid <> "-" <> show nodeId }
type KeyProps = (
key :: String
......@@ -49,7 +52,7 @@ listsLayoutWithKey props = R.createElement listsLayoutWithKeyCpt props []
listsLayoutWithKeyCpt :: R.Component KeyProps
listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKey" cpt
where
cpt { nodeId, session, sessionUpdate } _ = do
cpt { asyncTasks, nodeId, session, sessionUpdate } _ = do
let path = { nodeId, session }
cacheState <- R.useState' $ getCacheState NT.CacheOn session nodeId
......@@ -69,7 +72,8 @@ listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKe
, title: "Corpus " <> name
, user: authors }
, Tabs.tabs {
cacheState
asyncTasks
, cacheState
, corpusData
, corpusId
, session }
......
src/Gargantext/Components/Nodes/Lists/Tabs.purs
View file @ 51dd886f
......@@ -11,6 +11,7 @@ import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.Nodes.Corpus.Types (CorpusData)
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
......@@ -27,11 +28,13 @@ import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.Nodes.Lists.Tabs"
type Props = ( cacheState :: R.State NTypes.CacheState
, corpusData :: CorpusData
, corpusId :: Int
, session :: Session
)
type Props = (
asyncTasks :: R.State GAT.Storage
, cacheState :: R.State NTypes.CacheState
, corpusData :: CorpusData
, corpusId :: Int
, session :: Session
)
tabs :: Record Props -> R.Element
tabs props = R.createElement tabsCpt props []
......@@ -39,7 +42,7 @@ tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component Props
tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
where
cpt { cacheState, corpusData: corpusData@{ defaultListId }, corpusId, session } _ = do
cpt { asyncTasks, cacheState, corpusData: corpusData@{ defaultListId }, corpusId, session } _ = do
(selected /\ setSelected) <- R.useState' 0
pure $ Tab.tabs { selected, tabs: tabs' }
......@@ -48,7 +51,7 @@ tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
, "Institutes" /\ view Institutes
, "Sources" /\ view Sources
, "Terms" /\ view Terms ]
view mode = ngramsView { cacheState, corpusData, corpusId, mode, session }
view mode = ngramsView { asyncTasks, cacheState, corpusData, corpusId, mode, session }
type NgramsViewProps = ( mode :: Mode | Props )
......@@ -58,7 +61,8 @@ ngramsView props = R.createElement ngramsViewCpt props []
ngramsViewCpt :: R.Component NgramsViewProps
ngramsViewCpt = R.hooksComponentWithModule thisModule "ngramsView" cpt
where
cpt { cacheState
cpt { asyncTasks
, cacheState
, corpusData: { defaultListId }
, corpusId
, mode
......@@ -70,6 +74,7 @@ ngramsViewCpt = R.hooksComponentWithModule thisModule "ngramsView" cpt
pure $ R.fragment
( charts tabNgramType chartType chartsReload
<> [ NT.mainNgramsTable { afterSync: afterSync chartsReload
, asyncTasks
, cacheState
, defaultListId
, nodeId: corpusId
......
src/Gargantext/Components/Nodes/Texts.purs
View file @ 51dd886f
......@@ -25,6 +25,7 @@ import Gargantext.Sessions (Session, Sessions, sessionId, getCacheState, setCach
import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..))
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.Nodes.Texts"
--------------------------------------------------------
......
src/Gargantext/Ends.purs
View file @ 51dd886f
......@@ -167,6 +167,8 @@ sessionPath (R.PutNgrams t listId termList i) =
<> showTabType' t
<> maybe "" (\x -> "&list=" <> show x) listId
<> foldMap (\x -> "&listType=" <> show x) termList
sessionPath (R.PostNgramsChartsAsync i) =
sessionPath $ R.NodeAPI Node i $ "ngrams/async/charts/update"
sessionPath (R.NodeAPI nt i p) = nodeTypePath nt
<> (maybe "" (\i' -> "/" <> show i') i)
<> (if p == "" then "" else "/" <> p)
......
src/Gargantext/Routes.purs
View file @ 51dd886f
......@@ -44,6 +44,7 @@ data SessionRoute
| GetNgramsTableAll NgramsGetTableAllOpts (Maybe Id)
| GetNgramsTableVersion { listId :: ListId, tabType :: TabType } (Maybe Id)
| PutNgrams TabType (Maybe ListId) (Maybe TermList) (Maybe Id)
| PostNgramsChartsAsync (Maybe Id)
-- ^ This name is not good. In particular this URL is used both in PUT and POST.
| RecomputeNgrams (TabSubType CTabNgramType) Id ListId
| RecomputeListChart ChartType CTabNgramType Id ListId
......
src/Gargantext/Types.purs
View file @ 51dd886f
......@@ -442,31 +442,33 @@ data CTabNgramType = CTabTerms | CTabSources | CTabAuthors | CTabInstitutes
derive instance eqCTabNgramType :: Eq CTabNgramType
derive instance ordCTabNgramType :: Ord CTabNgramType
instance showCTabNgramType :: Show CTabNgramType where
show CTabTerms = "Terms"
show CTabSources = "Sources"
show CTabAuthors = "Authors"
show CTabInstitutes = "Institutes"
instance encodeCTabNgramType :: EncodeJson CTabNgramType where
encodeJson t = encodeJson $ show t
data PTabNgramType = PTabPatents | PTabBooks | PTabCommunication
derive instance eqPTabNgramType :: Eq PTabNgramType
derive instance ordPTabNgramType :: Ord PTabNgramType
instance showPTabNgramType :: Show PTabNgramType where
show PTabPatents = "Patents"
show PTabBooks = "Books"
show PTabCommunication = "Communication"
instance encodePTabNgramType :: EncodeJson PTabNgramType where
encodeJson t = encodeJson $ show t
data TabSubType a = TabDocs | TabNgramType a | TabTrash | TabMoreLikeFav | TabMoreLikeTrash
derive instance eqTabSubType :: Eq a => Eq (TabSubType a)
derive instance ordTabSubType :: Ord a => Ord (TabSubType a)
{- instance encodeTabSubType a :: EncodeJson a => EncodeJson (TabSubType a) where
instance encodeTabSubType :: EncodeJson a => EncodeJson (TabSubType a) where
encodeJson TabDocs =
"type" := "TabDocs"
~> "data" := Nothing
~> "data" := (Nothing :: Maybe String)
~> jsonEmptyObject
encodeJson (TabNgramType a) =
"type" := "TabNgramType"
......@@ -474,16 +476,17 @@ derive instance ordTabSubType :: Ord a => Ord (TabSubType a)
~> jsonEmptyObject
encodeJson TabTrash =
"type" := "TabTrash"
~> "data" := Nothing
~> "data" := (Nothing :: Maybe String)
~> jsonEmptyObject
encodeJson TabMoreLikeFav =
"type" := "TabMoreLikeFav"
~> "data" := Nothing
~> "data" := (Nothing :: Maybe String)
~> jsonEmptyObject
encodeJson TabMoreLikeTrash =
"type" := "TabMoreLikeTrash"
~> "data" := Nothing
~> "data" := (Nothing :: Maybe String)
~> jsonEmptyObject
{-
instance decodeTabSubType a :: DecodeJson a => DecodeJson (TabSubType a) where
decodeJson j = do
obj <- decodeJson j
......@@ -514,19 +517,26 @@ derive instance eqTabType :: Eq TabType
derive instance ordTabType :: Ord TabType
instance showTabType :: Show TabType where
show = genericShow
{- instance encodeTabType :: EncodeJson TabType where
encodeJson (TabCorpus d) =
"type" := "TabCorpus"
~> "data" := encodeJson d
~> jsonEmptyObject
encodeJson (TabDocument d) =
"type" := "TabDocument"
~> "data" := encodeJson d
~> jsonEmptyObject
encodeJson (TabPairing d) =
"type" := "TabPairing"
~> "data" := encodeJson d
~> jsonEmptyObject
instance encodeTabType :: EncodeJson TabType where
encodeJson (TabCorpus TabDocs) = encodeJson "Docs"
encodeJson (TabCorpus (TabNgramType CTabAuthors)) = encodeJson "Authors"
encodeJson (TabCorpus (TabNgramType CTabInstitutes)) = encodeJson "Institutes"
encodeJson (TabCorpus (TabNgramType CTabSources)) = encodeJson "Sources"
encodeJson (TabCorpus (TabNgramType CTabTerms)) = encodeJson "Terms"
encodeJson (TabCorpus TabMoreLikeFav) = encodeJson "MoreFav"
encodeJson (TabCorpus TabMoreLikeTrash) = encodeJson "MoreTrash"
encodeJson (TabCorpus TabTrash) = encodeJson "Trash"
encodeJson (TabDocument TabDocs) = encodeJson "Docs"
encodeJson (TabDocument (TabNgramType CTabAuthors)) = encodeJson "Authors"
encodeJson (TabDocument (TabNgramType CTabInstitutes)) = encodeJson "Institutes"
encodeJson (TabDocument (TabNgramType CTabSources)) = encodeJson "Sources"
encodeJson (TabDocument (TabNgramType CTabTerms)) = encodeJson "Terms"
encodeJson (TabDocument TabMoreLikeFav) = encodeJson "MoreFav"
encodeJson (TabDocument TabMoreLikeTrash) = encodeJson "MoreTrash"
encodeJson (TabDocument TabTrash) = encodeJson "Trash"
encodeJson (TabPairing d) = encodeJson "TabPairing" -- TODO
-- ["Docs","Trash","MoreFav","MoreTrash","Terms","Sources","Authors","Institutes","Contacts"]
{-
instance decodeTabType :: DecodeJson TabType where
decodeJson j = do
obj <- decodeJson j
......@@ -571,12 +581,13 @@ modeFromString _ = Nothing
-- Async tasks
-- corresponds to /add/form/async or /add/query/async
data AsyncTaskType = Form
| UploadFile
data AsyncTaskType = AddNode
| Form
| GraphRecompute
| Query
| AddNode
| UpdateNgramsCharts
| UpdateNode
| UploadFile
derive instance genericAsyncTaskType :: Generic AsyncTaskType _
instance eqAsyncTaskType :: Eq AsyncTaskType where
......@@ -589,20 +600,23 @@ instance decodeJsonAsyncTaskType :: DecodeJson AsyncTaskType where
decodeJson json = do
obj <- decodeJson json
case obj of
"Form" -> pure Form
"UploadFile" -> pure UploadFile
"GraphRecompute" -> pure GraphRecompute
"Query" -> pure Query
"AddNode" -> pure AddNode
s -> Left $ AtKey s $ TypeMismatch "Unknown string"
"AddNode" -> pure AddNode
"Form" -> pure Form
"GraphRecompute" -> pure GraphRecompute
"Query" -> pure Query
"UpdateNgramsCharts" -> pure UpdateNgramsCharts
"UpdateNode" -> pure UpdateNode
"UploadFile" -> pure UploadFile
s -> Left $ AtKey s $ TypeMismatch "Unknown string"
asyncTaskTypePath :: AsyncTaskType -> String
asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath UploadFile = "async/file/add/"
asyncTaskTypePath Query = "query/"
asyncTaskTypePath GraphRecompute = "async/recompute/"
asyncTaskTypePath AddNode = "async/nobody/"
asyncTaskTypePath UpdateNode = "update/"
asyncTaskTypePath AddNode = "async/nobody/"
asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath GraphRecompute = "async/recompute/"
asyncTaskTypePath Query = "query/"
asyncTaskTypePath UpdateNgramsCharts = "async/charts/update/"
asyncTaskTypePath UpdateNode = "update/"
asyncTaskTypePath UploadFile = "async/file/add/"
type AsyncTaskID = String
......
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