[ngrams] asyncTasks cache work

src/Gargantext/AsyncTasks.purs

@@ -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

@@ -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

@@ -22,7 +22,8 @@ thisModule :: String
 thisModule = "Gargantext.Components.Forest"
 
 type Props =
-  ( backend   :: R.State (Maybe Backend)
+  ( asyncTasks :: R.State GAT.Storage
+  , backend    :: R.State (Maybe Backend)
   , frontends  :: Frontends
   , handed     :: Handed
   , reload     :: R.State Int
@@ -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

@@ -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

src/Gargantext/Components/GraphExplorer.purs

@@ -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
+                    tree { asyncTasks
+                         , backend
+                         , frontends
                          , handed
                          , mCurrentRoute
                          , reload: treeReload
                          , sessions
                          , show: fst controls.showTree
-                          , showLogin: snd showLogin 
-                          , backend}
+                         , 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
+    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)
   )
 
 type MSidebarProps =

src/Gargantext/Components/GraphExplorer/Sidebar.purs

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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,7 +24,8 @@ thisModule = "Gargantext.Components.Nodes.Lists"
 ------------------------------------------------------------------------
 
 type Props = (
-    nodeId :: Int
+    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

@@ -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,7 +28,9 @@ import Gargantext.Utils.Reactix as R2
 thisModule :: String
 thisModule = "Gargantext.Components.Nodes.Lists.Tabs"
 
-type Props = ( cacheState :: R.State NTypes.CacheState
+type Props = (
+    asyncTasks    :: R.State GAT.Storage
+  , cacheState :: R.State NTypes.CacheState
   , corpusData :: CorpusData
   , corpusId   :: Int
   , session    :: Session
@@ -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

@@ -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

@@ -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

@@ -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

@@ -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
+      "AddNode"            -> pure AddNode
       "Form"               -> pure Form
-      "UploadFile"     -> pure UploadFile
       "GraphRecompute"     -> pure GraphRecompute
       "Query"              -> pure Query
-      "AddNode"        -> pure AddNode
+      "UpdateNgramsCharts" -> pure UpdateNgramsCharts
+      "UpdateNode"         -> pure UpdateNode
+      "UploadFile"         -> pure UploadFile
       s                    -> Left $ AtKey s $ TypeMismatch "Unknown string"
 
 asyncTaskTypePath :: AsyncTaskType -> String
+asyncTaskTypePath AddNode            = "async/nobody/"
 asyncTaskTypePath Form               = "add/form/async/"
-asyncTaskTypePath UploadFile     = "async/file/add/"
-asyncTaskTypePath Query          = "query/"
 asyncTaskTypePath GraphRecompute     = "async/recompute/"
-asyncTaskTypePath AddNode        = "async/nobody/"
+asyncTaskTypePath Query              = "query/"
+asyncTaskTypePath UpdateNgramsCharts = "async/charts/update/"
 asyncTaskTypePath UpdateNode         = "update/"
+asyncTaskTypePath UploadFile         = "async/file/add/"
 
 
 type AsyncTaskID = String