Merge remote-tracking branch 'origin/async-workers' into dev

package.json

@@ -79,6 +79,6 @@
     "xhr2": "~0.2.1"
   },
   "optionalDependencies": {
-    "purescript-language-server": "~0.17.1"
+    "purescript-language-server": "~0.18.2"
   }
 }

src/Gargantext/AsyncTasks.purs

 module Gargantext.AsyncTasks (
-    TaskList
+    Task
+  , TaskList
   , Storage(..)
-  , readAsyncTasks
   , insert
   , finish
   , focus
-  , asyncTaskTTriggersAppReload
-  , asyncTaskTTriggersTreeReload
-  , asyncTaskTTriggersMainPageReload )
+  -- , asyncTaskTTriggersAppReload
+  -- , asyncTaskTTriggersTreeReload
+  -- , asyncTaskTTriggersMainPageReload
+  )
 where
 
 import Gargantext.Prelude
@@ -33,7 +34,8 @@ import Toestand as T
 import Web.Storage.Storage as WSS
 
 
-type TaskList = Array GT.AsyncTaskWithType
+type Task = GT.WorkerTask
+type TaskList = Array Task
 newtype Storage = Storage (Map.Map GT.NodeID TaskList)
 derive newtype instance Semigroup Storage
 derive newtype instance Monoid Storage
@@ -47,32 +49,9 @@ instance JSON.WriteForeign Storage where
       arr :: Array (Tuple String TaskList)
       arr = (\(Tuple k v) -> Tuple (show k) v) <$> (Map.toUnfoldable s)
 
-readAsyncTasks :: Effect Storage
-readAsyncTasks = R2.loadLocalStorageState' R2.asyncTasksKey mempty
--- readAsyncTasks = R2.getls >>= WSS.getItem R2.asyncTasksKey >>= handleMaybe
-  -- where
-  --   handleMaybe (Just val) = handleEither (parse val)
-  --   handleMaybe Nothing    = pure empty
-
-  --   -- either parsing or decoding could fail, hence two errors
-  --   handleEither (Left err) = err *> pure empty
-  --   handleEither (Right ss) = pure ss
-
-  --   parse  s = GU.mapLeft (log2 "Error parsing serialised sessions:") (JSON.readJSON s)
-
-writeAsyncTasks :: Storage -> Effect Unit
-writeAsyncTasks = R2.setLocalStorageState R2.asyncTasksKey
--- writeAsyncTasks storage = R2.getls >>= WSS.setItem R2.asyncTasksKey storage
-
-modifyAsyncTasks :: (Storage -> Storage) -> Effect Unit
-modifyAsyncTasks f = readAsyncTasks >>= writeAsyncTasks <<< f
-
 modifyTaskBox :: (Storage -> Storage) -> T.Box Storage -> Effect Unit
-modifyTaskBox f box = do
-  s <- T.read box
-  let newS = f s
-  T.write_ newS box
-  modifyAsyncTasks (const newS)
+modifyTaskBox f box = T.modify_ f box
+  -- modifyAsyncTasks (const newS)
 
 getTasks :: GT.NodeID -> Storage -> TaskList
 getTasks nodeId (Storage storage) = fromMaybe [] $ Map.lookup nodeId storage
@@ -83,9 +62,9 @@ setTasks id tasks (Storage s) = Storage $ Map.insert id tasks s
 focus :: GT.NodeID -> T.Box Storage -> R.Hooks (T.Box TaskList)
 focus id tasks = T.useFocused (getTasks id) (setTasks id) tasks
 
-removeTaskFromList :: TaskList -> GT.AsyncTaskWithType -> TaskList
-removeTaskFromList ts (GT.AsyncTaskWithType { task: GT.AsyncTask { id: id' } }) =
-  A.filter (\(GT.AsyncTaskWithType { task: GT.AsyncTask { id: id'' } }) -> id' /= id'') ts
+removeTaskFromList :: TaskList -> Task -> TaskList
+removeTaskFromList ts (GT.WorkerTask { message_id }) =
+  A.filter (\(GT.WorkerTask { message_id: message_id' }) -> message_id /= message_id') ts
 
 type ReductorProps = (
     reloadForest :: T2.ReloadS
@@ -93,39 +72,57 @@ type ReductorProps = (
   , storage      :: Storage
   )
 
-insert :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit
+insert :: GT.NodeID -> Task -> T.Box Storage -> Effect Unit
 insert id task storageBox = modifyTaskBox newStorage storageBox
   where
-    newStorage (Storage s) = Storage $ Map.alter (maybe (Just [task]) (\ts -> Just $ A.cons task ts)) id s
+    newStorage (Storage s) = Storage $ Map.alter (maybe (Just [task]) (\ts -> Just $ A.nub $ A.cons task ts)) id s
 
-finish :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit
+finish :: GT.NodeID -> Task -> T.Box Storage -> Effect Unit
 finish id task storage = remove id task storage
 
-remove :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit
+remove :: GT.NodeID -> Task -> T.Box Storage -> Effect Unit
 remove id task storageBox = modifyTaskBox newStorage storageBox
   where
     newStorage (Storage s) = Storage $ Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts task)) id s
 
 
+-- AsyncTaskWithType is deprecated, but we leave these functions here,
+-- becuase they're a useful reference
+
 -- When a task is finished: which tasks cause forest or app reload
-asyncTaskTriggersAppReload :: GT.AsyncTaskType -> Boolean
-asyncTaskTriggersAppReload _                     = false
+-- asyncTaskTriggersAppReload :: GT.AsyncTaskType -> Boolean
+-- asyncTaskTriggersAppReload _                     = false
+
+-- asyncTaskTTriggersAppReload :: GT.AsyncTaskWithType -> Boolean
+-- asyncTaskTTriggersAppReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersAppReload typ
+
+-- asyncTaskTriggersMainPageReload :: GT.AsyncTaskType -> Boolean
+-- asyncTaskTriggersMainPageReload GT.UpdateNgramsCharts = true
+-- asyncTaskTriggersMainPageReload _                     = false
+
+-- asyncTaskTTriggersMainPageReload :: GT.AsyncTaskWithType -> Boolean
+-- asyncTaskTTriggersMainPageReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersMainPageReload typ
+
+-- asyncTaskTriggersTreeReload :: GT.AsyncTaskType -> Boolean
+-- asyncTaskTriggersTreeReload GT.CorpusFormUpload = true
+-- asyncTaskTriggersTreeReload GT.Query            = true
+-- asyncTaskTriggersTreeReload GT.UploadFile       = true
+-- asyncTaskTriggersTreeReload _                   = false
+
+-- asyncTaskTTriggersTreeReload :: GT.AsyncTaskWithType -> Boolean
+-- asyncTaskTTriggersTreeReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersTreeReload typ
 
-asyncTaskTTriggersAppReload :: GT.AsyncTaskWithType -> Boolean
-asyncTaskTTriggersAppReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersAppReload typ
 
-asyncTaskTriggersMainPageReload :: GT.AsyncTaskType -> Boolean
-asyncTaskTriggersMainPageReload GT.UpdateNgramsCharts = true
-asyncTaskTriggersMainPageReload _                     = false
+-- With push-based notifications, it doesn't make sense to store jobs in localStorage
+-- readAsyncTasks :: Effect Storage
+-- readAsyncTasks = R2.loadLocalStorageState' R2.asyncTasksKey mempty
 
-asyncTaskTTriggersMainPageReload :: GT.AsyncTaskWithType -> Boolean
-asyncTaskTTriggersMainPageReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersMainPageReload typ
+-- writeAsyncTasks :: Storage -> Effect Unit
+-- writeAsyncTasks = R2.setLocalStorageState R2.asyncTasksKey
 
-asyncTaskTriggersTreeReload :: GT.AsyncTaskType -> Boolean
-asyncTaskTriggersTreeReload GT.CorpusFormUpload = true
-asyncTaskTriggersTreeReload GT.Query            = true
-asyncTaskTriggersTreeReload GT.UploadFile       = true
-asyncTaskTriggersTreeReload _                   = false
+-- modifyAsyncTasks :: (Storage -> Storage) -> Effect Unit
+-- modifyAsyncTasks f = readAsyncTasks >>= writeAsyncTasks <<< f
 
-asyncTaskTTriggersTreeReload :: GT.AsyncTaskWithType -> Boolean
-asyncTaskTTriggersTreeReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersTreeReload typ
+-- removeTaskFromList :: TaskList -> GT.AsyncTaskWithType -> TaskList
+-- removeTaskFromList ts (GT.AsyncTaskWithType { task: GT.AsyncTask { id: id' } }) =
+--   A.filter (\(GT.AsyncTaskWithType { task: GT.AsyncTask { id: id'' } }) -> id' /= id'') ts

src/Gargantext/Components/App/App.purs

@@ -93,9 +93,14 @@ mainAppCpt = here.component "main" cpt where
     R.useEffectOnce' $ do
       void $ Sessions.load boxes.sessions
     -- tasks <- GAT.useTasks boxes.reloadRoot boxes.reloadForest
-    R.useEffectOnce' $ do
-      tasksStorage <- GAT.readAsyncTasks
-      T.write_ tasksStorage boxes.tasks
+
+    -- NOTE Task storage is not needed with new-style notifications
+    -- and async workers. The tasks (with their pgoress) should be
+    -- pushed as soon as the worker computes the task's chunk
+    -- R.useEffectOnce' $ do
+    --   tasksStorage <- GAT.readAsyncTasks
+    --   T.write_ tasksStorage boxes.tasks
+      
     -- R.useEffectOnce' $ do
     --   T.write (Just tasksReductor) tasks
     R.useEffectOnce' $ do

src/Gargantext/Components/DocsTable.purs

@@ -23,6 +23,7 @@ import Effect (Effect)
 import Effect.Aff (Aff, launchAff_)
 import Effect.Class (liftEffect)
 import Effect.Timer (setTimeout)
+import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.App.Store as Store
 import Gargantext.Components.Bootstrap as B
 import Gargantext.Components.Bootstrap.Types (ComponentStatus(..), ModalSizing(..), Variant(..))
@@ -169,15 +170,17 @@ docViewCpt = R2.hereComponent here "docView" hCpt where
       liftEffect $
         T.write_ true onDocumentCreationPendingBox
 
-      eTask <- DFC.create session nodeId fdata
+      _ <- DFC.create session nodeId fdata
 
-      handleRESTError hp errors eTask
-        \t -> liftEffect $ launchDocumentCreationProgress
-                              errors
-                              session
-                              nodeId
-                              t
-                              onCreateDocumentEnd
+      liftEffect $ here.log "[docView] TODO onCreateDocumentEnd handler"
+
+      -- handleRESTError hp errors eTask
+      --   \t -> liftEffect $ launchDocumentCreationProgress
+      --                         errors
+      --                         session
+      --                         nodeId
+      --                         t
+      --                         onCreateDocumentEnd
 
     -- Render
     pure $
@@ -237,44 +240,44 @@ docViewCpt = R2.hereComponent here "docView" hCpt where
         ]
       ]
 
-launchDocumentCreationProgress ::
-     T.Box (Array GT.FrontendError)
-  -> Session
-  -> GT.ID
-  -> GT.AsyncTaskWithType
-  -> (GT.AsyncProgress -> Effect Unit)
-  -> Effect Unit
-launchDocumentCreationProgress errors session nodeId currentTask cbk
-  = void $ setTimeout 1000 $ launchAff_ $
-      scanDocumentCreationProgress errors session nodeId currentTask cbk
-
-scanDocumentCreationProgress ::
-     T.Box (Array GT.FrontendError)
-  -> Session
-  -> GT.ID
-  -> GT.AsyncTaskWithType
-  -> (GT.AsyncProgress -> Effect Unit)
-  -> Aff Unit
-scanDocumentCreationProgress errors session nodeId currentTask cbk = do
-
-  eTask <- DFC.createProgress session nodeId currentTask
-
-  handleRESTError (R2.herePrefix here "[scanDocumentCreationProgress]") errors eTask
-    \asyncProgress -> liftEffect do
-      let
-        GT.AsyncProgress { status } = asyncProgress
-        endingStatusList =
-          [ GT.IsFinished
-          , GT.IsKilled
-          , GT.IsFailure
-          ]
-        hasEndingStatus s = any (eq s) endingStatusList
-
-      if (hasEndingStatus status)
-      then
-        cbk asyncProgress
-      else
-        launchDocumentCreationProgress errors session nodeId currentTask cbk
+-- launchDocumentCreationProgress ::
+--      T.Box (Array GT.FrontendError)
+--   -> Session
+--   -> GT.ID
+--   -> GAT.Task
+--   -> (GT.AsyncProgress -> Effect Unit)
+--   -> Effect Unit
+-- launchDocumentCreationProgress errors session nodeId currentTask cbk
+--   = void $ setTimeout 1000 $ launchAff_ $
+--       scanDocumentCreationProgress errors session nodeId currentTask cbk
+
+-- scanDocumentCreationProgress ::
+--      T.Box (Array GT.FrontendError)
+--   -> Session
+--   -> GT.ID
+--   -> GAT.Task
+--   -> (GT.AsyncProgress -> Effect Unit)
+--   -> Aff Unit
+-- scanDocumentCreationProgress errors session nodeId currentTask cbk = do
+
+--   -- eTask <- DFC.createProgress session nodeId currentTask
+
+--   handleRESTError (R2.herePrefix here "[scanDocumentCreationProgress]") errors eTask
+--     \asyncProgress -> liftEffect do
+--       let
+--         GT.AsyncProgress { status } = asyncProgress
+--         endingStatusList =
+--           [ GT.IsFinished
+--           , GT.IsKilled
+--           , GT.IsFailure
+--           ]
+--         hasEndingStatus s = any (eq s) endingStatusList
+
+--       if (hasEndingStatus status)
+--       then
+--         cbk asyncProgress
+--       else
+--         launchDocumentCreationProgress errors session nodeId currentTask cbk
 
 ---------------------------------------------------
 

src/Gargantext/Components/DocsTable/DocumentFormCreation.purs

 module Gargantext.Components.DocsTable.DocumentFormCreation
   ( documentFormCreation
   , FormData
-  , create, createProgress
+  , create
   ) where
 
 import Gargantext.Prelude
@@ -11,6 +11,7 @@ import Data.Either (Either(..))
 import Data.Foldable (foldl, intercalate)
 import Data.Maybe (Maybe(..))
 import Effect (Effect)
+import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.Bootstrap as B
 import Gargantext.Components.Bootstrap.Types (ButtonVariant(..), ComponentStatus(..), Variant(..))
 import Gargantext.Config.REST (AffRESTError)
@@ -288,41 +289,15 @@ create ::
      Session
   -> GT.ID
   -> Record FormData
-  -> AffRESTError GT.AsyncTaskWithType
+  -> AffRESTError GAT.Task
 create session nodeId =
       rename
   >>> post session request
-  >=> case _ of
-    Left err   -> pure $ Left err
-    Right task -> pure $ Right $ GT.AsyncTaskWithType
-      { task
-      , typ: GT.NodeDocument
-      }
 
   where
 
-    request = GR.NodeAPI GT.Node (Just nodeId)
-      (GT.asyncTaskTypePath GT.NodeDocument)
+    request = GR.NodeAPI GT.Node (Just nodeId) (GT.asyncTaskTypePath GT.NodeDocument)
 
     rename = Record.rename
       (Proxy :: Proxy "source")
       (Proxy :: Proxy "sources")
-
-createProgress ::
-    Session
-  -> GT.ID
-  -> GT.AsyncTaskWithType
-  -> AffRESTError GT.AsyncProgress
-createProgress
-  session
-  nodeId
-  (GT.AsyncTaskWithType { task: GT.AsyncTask { id } })
-  =
-    get session request
-
-  where
-
-    request = GR.NodeAPI GT.Node (Just nodeId)
-      (GT.asyncTaskTypePath GT.NodeDocument <> pollParams)
-
-    pollParams = "/" <> id <> "/poll?limit1"

src/Gargantext/Components/FolderView.purs

@@ -372,7 +372,8 @@ performAction = performAction' where
   updateNode params { boxes: { errors, tasks }, nodeId: id, session } = do
     eTask <- updateRequest params session id
     handleRESTError (R2.herePrefix here "[updateNode]") errors eTask $ \task -> liftEffect $ do
-      GAT.insert id task tasks
+      -- GAT.insert id task tasks
+      here.log "[performAction] TODO: IMPLEMENT ME!"
 
   sharePublic params p@{ boxes: { errors }, session } = traverse_ f params where
     f (SubTreeOut { in: inId, out }) = do
@@ -386,12 +387,14 @@ performAction = performAction' where
   uploadFile' nodeType fileType fileFormat lang mName contents { boxes: { errors, tasks }, nodeId: id, session } selection = do
     eTask <- uploadFile { contents, fileType, fileFormat, lang, id, nodeType, mName, selection, session }
     handleRESTError (R2.herePrefix here "[uploadFile']") errors eTask $ \task -> liftEffect $ do
-      GAT.insert id task tasks
+      -- GAT.insert id task tasks
+      here.log "[performAction] TODO: IMPLEMENT ME!"
 
   uploadArbitraryFile' fileFormat mName blob { boxes: { errors, tasks }, nodeId: id, session } = do
     eTask <- uploadArbitraryFile session id { blob, fileFormat, mName }
     handleRESTError (R2.herePrefix here "[uploadArbitraryFile']") errors eTask $ \task -> liftEffect $ do
-      GAT.insert id task tasks
+      -- GAT.insert id task tasks
+      here.log "[performAction] TODO: IMPLEMENT ME!"
 
   moveNode params p@{ boxes: { errors }, session } = traverse_ f params where
     f (SubTreeOut { in: in', out }) = do

src/Gargantext/Components/Forest/Tree.purs

@@ -30,7 +30,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.WriteNodesDocuments (docume
 import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..), fTreeID)
 import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
 import Gargantext.Components.Notifications as Notifications
-import Gargantext.Components.Notifications.Types as NotificationsT
+import Gargantext.Components.Notifications.Types as NT
 import Gargantext.Config.REST (AffRESTError, logRESTError)
 import Gargantext.Config.Utils (handleRESTError)
 import Gargantext.Ends (Frontends)
@@ -181,12 +181,17 @@ treeCpt = here.component "tree" cpt where
       -- rendered via 'childLoader'. However, we still need a hook
       -- here, so that if e.g. the tree is pinned, it becomes its own
       -- root and we want to see notifications of it as well.
-      let cb _ = do
-            here.log2 "[tree] callback!" root
-            -- The modal window has some problems closing when we refresh too early. This is a HACK
-            void $ setTimeout 400 $ T2.reload reload
-      let action = NotificationsT.InsertCallback (NotificationsT.UpdateTree root) ("tree-" <> show root) cb
+      let cb n = do
+            case n of
+              NT.NUpdateTree _ -> do
+                here.log2 "[tree] update tree" root
+                -- The modal window has some problems closing when we refresh too early. This is a HACK
+                void $ setTimeout 400 $ T2.reload reload
+              NT.NUpdateWorkerProgress ji jl -> do
+                here.log3 "[tree] update worker progress" ji jl
+              _ -> pure unit
       ws <- T.read boxes.wsNotification
+      let action = NT.InsertCallback (NT.UpdateTree root) ("tree-" <> show root) cb
       Notifications.performAction ws action
 
     R.useEffect' do
@@ -337,12 +342,15 @@ childLoaderCpt = R2.hereComponent here "childLoader" hCpt where
 
     boxes <- Store.use
     R.useEffectOnce' $ do
-      let cb _ = do
-            here.log2 "[childLoader] callback!" p.id
-            -- The modal window has some problems closing when we refresh too early. This is a HACK
-            void $ setTimeout 400 $ T2.reload reload
-      let action = NotificationsT.InsertCallback (NotificationsT.UpdateTree p.id) ("tree-" <> show p.id) cb
+      let cb n = do
+            case n of
+              NT.NUpdateTree _nId -> do
+                here.log2 "[childLoader] update tree" p.id
+                -- The modal window has some problems closing when we refresh too early. This is a HACK
+                void $ setTimeout 400 $ T2.reload reload
+              _ -> pure unit
       ws <- T.read boxes.wsNotification
+      let action = NT.InsertCallback (NT.UpdateTree p.id) ("tree-" <> show p.id) cb
       Notifications.performAction ws action
 
     -- Render
@@ -384,7 +392,8 @@ doSearch task { boxes: { tasks }, tree: NTree (LNode {id}) _ } = liftEffect $ do
 updateNode params p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode {id}) _) } = do
   eTask <- updateRequest params session id
   handleRESTError (R2.herePrefix here "[updateNode]") errors eTask $ \task -> liftEffect $ do
-    GAT.insert id task tasks
+    -- GAT.insert id task tasks
+    here.log "[updateNode] TODO: IMPLEMENT ME!"
     closeBox p
 
 renameNode name p@{ boxes: { errors }, session, tree: (NTree (LNode {id}) _) } = do
@@ -412,19 +421,22 @@ addNode' name nodeType p@{ boxes: { errors, forestOpen }, session, tree: (NTree
 uploadFile' nodeType fileType fileFormat lang mName contents p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do
   eTask <- uploadFile { contents, fileFormat, fileType, id, lang, mName, nodeType, selection, session }
   handleRESTError (R2.herePrefix here "[uploadFile']") errors eTask $ \task -> liftEffect $ do
-    GAT.insert id task tasks
+    -- GAT.insert id task tasks
+    here.log "[uplaodFile'] TODO: IMPLEMENT ME!"
     here.log2 "[uploadFile'] UploadFile, uploaded, task:" task
     closeBox p
 
 uploadArbitraryFile' fileFormat mName blob { boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } = do
   eTask <- uploadArbitraryFile session id { blob, fileFormat, mName }
   handleRESTError (R2.herePrefix here "[uploadArbitraryFile']") errors eTask $ \task -> liftEffect $ do
-    GAT.insert id task tasks
+    -- GAT.insert id task tasks
+    here.log "[uplaodArbitraryFile'] TODO: IMPLEMENT ME!"
 
 uploadFrameCalc' lang { boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do
   eTask <- uploadFrameCalc session id lang selection
   handleRESTError (R2.herePrefix here "[uploadFrameCalc']") errors eTask $ \task -> liftEffect $ do
-    GAT.insert id task tasks
+    -- GAT.insert id task tasks
+    here.log "[uplaodFrameCalc'] TODO: IMPLEMENT ME!"
 
 moveNode params p@{ boxes: { errors, forestOpen }, session } = traverse_ f params where
   f (SubTreeOut { in: in', out }) = do
@@ -448,7 +460,8 @@ linkNode nodeType params p@{ boxes: { errors }, session } = traverse_ f params w
 documentsFromWriteNodes params p@{ boxes: { errors, tasks }, session, tree: NTree (LNode { id }) _ } = do
   eTask <- documentsFromWriteNodesReq session params
   handleRESTError (R2.herePrefix here "[documentsFromWriteNodes]") errors eTask $ \task -> liftEffect $ do
-    GAT.insert id task tasks
+    -- GAT.insert id task tasks
+    here.log "[documentsFromWriteNodes] TODO: IMPLEMENT ME!"
     pure unit
   refreshTree p
 

src/Gargantext/Components/Forest/Tree/Node.purs

@@ -14,6 +14,7 @@ import Data.String.Regex as Regex
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff)
 import Effect.Class (liftEffect)
+import Effect.Timer (setTimeout)
 import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.App.Store as AppStore
 import Gargantext.Components.Bootstrap as B
@@ -28,6 +29,8 @@ import Gargantext.Components.Forest.Tree.Node.Tools.Sync (nodeActionsGraph, node
 import Gargantext.Components.GraphExplorer.API as GraphAPI
 import Gargantext.Components.Lang (Lang(EN))
 import Gargantext.Components.Nodes.Corpus.Types (CorpusData)
+import Gargantext.Components.Notifications as Notifications
+import Gargantext.Components.Notifications.Types as NT
 import Gargantext.Context.Progress (asyncContext, asyncProgress)
 import Gargantext.Ends (Frontends, url)
 import Gargantext.Hooks.Loader (useLoader)
@@ -174,27 +177,29 @@ nodeSpanCpt = here.component "nodeSpan" cpt
 
         onTaskFinish ::
              GT.NodeID
-          -> GT.AsyncTaskWithType
+          -> GAT.Task
           -> Unit
           -> Effect Unit
         onTaskFinish id' t _ = do
           GAT.finish id' t boxes.tasks
-          if GAT.asyncTaskTTriggersAppReload t then do
-            here.log2 "reloading root for task" t
-            T2.reload boxes.reloadRoot
-          else do
-            if GAT.asyncTaskTTriggersTreeReload t then do
-              here.log2 "reloading tree for task" t
-              T2.reload reload
-            else do
-              here.log2 "task doesn't trigger a tree reload" t
-              pure unit
-            if GAT.asyncTaskTTriggersMainPageReload t then do
-              here.log2 "reloading main page for task" t
-              T2.reload boxes.reloadMainPage
-            else do
-              here.log2 "task doesn't trigger a main page reload" t
-              pure unit
+          -- TODO App reload!
+          here.log "[onTaskFinish] TODO APP/TREE/MAIN PAGE RELOAD"
+          -- if GAT.asyncTaskTTriggersAppReload t then do
+          --   here.log2 "reloading root for task" t
+          --   T2.reload boxes.reloadRoot
+          -- else do
+          --   if GAT.asyncTaskTTriggersTreeReload t then do
+          --     here.log2 "reloading tree for task" t
+          --     T2.reload reload
+          --   else do
+          --     here.log2 "task doesn't trigger a tree reload" t
+          --     pure unit
+          --   if GAT.asyncTaskTTriggersMainPageReload t then do
+          --     here.log2 "reloading main page for task" t
+          --     T2.reload boxes.reloadMainPage
+          --   else do
+          --     here.log2 "task doesn't trigger a main page reload" t
+          --     pure unit
           -- snd tasks $ GAT.Finish id' t
           -- mT <- T.read tasks
           -- case mT of
@@ -230,6 +235,26 @@ nodeSpanCpt = here.component "nodeSpan" cpt
             else
               H.div {} []
 
+    -- Notifications
+      R.useEffectOnce' $ do
+        let cb n = do
+              case n of
+                NT.NUpdateTree _ -> do
+                  here.log2 "[nodeSpan] update tree" props.id
+                  -- The modal window has some problems closing when we refresh too early. This is a HACK
+                  void $ setTimeout 400 $ T2.reload reload
+                NT.NUpdateWorkerProgress ji atl -> do
+                  -- TODO Fire this only once!
+                  -- here.log3 "[nodeSpan] update job progress" ji atl
+                  if GT.asyncTaskLogIsFinished atl
+                    then pure unit
+                    else
+                      GAT.insert props.id ji boxes.tasks
+                _ -> pure unit
+        ws <- T.read boxes.wsNotification
+        let action = NT.InsertCallback (NT.UpdateTree props.id) ("node-span-" <> show props.id) cb
+        Notifications.performAction ws action
+
     -- Render
 
       pure $

src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs

@@ -8,6 +8,7 @@ import Data.Newtype (class Newtype)
 import Data.String (Pattern(..), indexOf)
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff_)
+import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
 import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
 import Gargantext.Components.Forest.Tree.Node.Tools as Tools
@@ -39,10 +40,9 @@ addNode session parentId = post session $ GR.NodeAPI GT.Node (Just parentId) ""
 addNodeAsync :: Session
              -> GT.ID
              -> AddNodeValue
-             -> AffRESTError GT.AsyncTaskWithType
+             -> AffRESTError GAT.Task
 addNodeAsync session parentId q = do
-  eTask :: Either RESTError GT.AsyncTask <- post session p q
-  pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.AddNode }) <$> eTask
+  post session p q
   where
     p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.AddNode)
 

src/Gargantext/Components/Forest/Tree/Node/Action/Link.purs

@@ -4,6 +4,7 @@ import Gargantext.Prelude
 
 import Data.Either (Either)
 import Data.Maybe (Maybe(..))
+import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
 import Gargantext.Components.Forest.Tree.Node.Action.Update.Types (LinkNodeReq(..), UpdateNodeParams(..))
 import Gargantext.Components.Forest.Tree.Node.Tools as Tools
@@ -20,11 +21,11 @@ import Toestand as T
 here :: R2.Here
 here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Link"
 
-linkNodeReq :: Session -> Maybe GT.NodeType -> GT.ID -> GT.ID -> AffRESTError GT.AsyncTaskWithType
+linkNodeReq :: Session -> Maybe GT.NodeType -> GT.ID -> GT.ID -> AffRESTError GAT.Task
 linkNodeReq session nt fromId toId = do
-  eTask :: Either RESTError GT.AsyncTask <- post session (NodeAPI GT.Node (Just fromId) "update")
-                        (LinkNodeReq { nodeType: linkNodeType nt, id: toId })
-  pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.UpdateNode }) <$> eTask
+  post session (NodeAPI GT.Node (Just fromId) "update")
+               (LinkNodeReq { nodeType: linkNodeType nt, id: toId })
+
 
 linkNodeType :: Maybe GT.NodeType -> GT.NodeType
 linkNodeType (Just GT.Corpus)   = GT.Annuaire

src/Gargantext/Components/Forest/Tree/Node/Action/Search.purs

@@ -3,6 +3,7 @@ module Gargantext.Components.Forest.Tree.Node.Action.Search where
 import Data.Maybe (Maybe(..))
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff)
+import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.App.Store as Store
 import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar (searchBar)
 import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField (defaultSearch)
@@ -68,7 +69,7 @@ actionSearchWithLangsCpt = here.component "actionSearchWithLangs" cpt
         ]
         where
           searchOn :: (Action -> Aff Unit)
-                   -> GT.AsyncTaskWithType
+                   -> GAT.Task
                    -> Effect Unit
           searchOn dispatch' task = do
             _ <- launchAff $ dispatch' (DoSearch task)

src/Gargantext/Components/Forest/Tree/Node/Action/Search/SearchBar.purs

@@ -4,6 +4,7 @@ module Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar
   ) where
 
 import Effect (Effect)
+import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField (searchField)
 import Gargantext.Components.Forest.Tree.Node.Action.Search.Types (Search, allDatabases)
 import Gargantext.Components.Lang (Lang)
@@ -21,7 +22,7 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar"
 
 type Props = ( errors    :: T.Box (Array FrontendError)
              , langs     :: Array Lang
-             , onSearch  :: GT.AsyncTaskWithType -> Effect Unit
+             , onSearch  :: GAT.Task -> Effect Unit
              , search    :: T.Box Search
              , session   :: Session
              )

src/Gargantext/Components/Forest/Tree/Node/Action/Search/SearchField.purs

@@ -13,6 +13,7 @@ import Data.Tuple (Tuple(..))
 import Effect (Effect)
 import Effect.Aff (launchAff_)
 import Effect.Class (liftEffect)
+import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.Forest.Tree.Node.Action.Search.Frame (searchIframes)
 import Gargantext.Components.Forest.Tree.Node.Action.Search.Types (DataField(..), Database(..), IMT_org(..), Org(..), SearchQuery(..), allOrgs, dataFields, defaultSearchQuery, doc, performSearch, datafield2database, Search, dbFromInputValue, dbToInputValue)
 import Gargantext.Components.GraphQL.Endpoints (getIMTSchools, getUser)
@@ -53,7 +54,7 @@ type Props =
   , errors    :: T.Box (Array FrontendError)
   , langs     :: Array Lang
   -- State hook for a search, how we get data in and out
-  , onSearch  :: GT.AsyncTaskWithType -> Effect Unit
+  , onSearch  :: GAT.Task -> Effect Unit
   , search    :: T.Box Search
   , session   :: Session
   )
@@ -645,7 +646,7 @@ searchInputCpt = here.component "searchInput" cpt
 
 type SubmitButtonProps =
   ( errors    :: T.Box (Array FrontendError)
-  , onSearch  :: GT.AsyncTaskWithType -> Effect Unit
+  , onSearch  :: GAT.Task -> Effect Unit
   , search    :: T.Box Search
   , selection :: T.Box ListSelection.Selection
   , session   :: Session
@@ -677,13 +678,13 @@ submitButtonComponent = here.component "submitButton" cpt
 
 type TriggerSearch =
   ( errors    :: T.Box (Array FrontendError)
-  , onSearch  :: GT.AsyncTaskWithType -> Effect Unit
+  , onSearch  :: GAT.Task -> Effect Unit
   , search    :: T.Box Search
   , selection :: T.Box ListSelection.Selection
   , session   :: Session
   )
 
-triggerSearch :: { onSearch :: (GT.AsyncTaskWithType -> Effect Unit)
+triggerSearch :: { onSearch :: (GAT.Task -> Effect Unit)
                  , errors :: T.Box (Array FrontendError)
                  , session :: Session
                  , selection :: ListSelection.Selection

src/Gargantext/Components/Forest/Tree/Node/Action/Search/Types.purs

@@ -12,6 +12,7 @@ import Data.Set (Set)
 import Data.Set as Set
 import Data.Tuple (Tuple)
 import Data.Tuple.Nested ((/\))
+import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.GraphQL.IMT as GQLIMT
 import Gargantext.Components.Lang (Lang)
 import Gargantext.Components.ListSelection.Types as ListSelection
@@ -339,9 +340,10 @@ defaultSearchQuery = SearchQuery
   , selection    : ListSelection.NoList -- MyListsFirst
   }
 
-performSearch :: Session -> Int -> SearchQuery -> AffRESTError GT.AsyncTaskWithType
+performSearch :: Session -> Int -> SearchQuery -> AffRESTError GAT.Task
 performSearch session nodeId q = do
-  eTask :: Either RESTError GT.AsyncTask <- post session p q
-  pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.Query }) <$> eTask
+  post session p q
+  -- eTask :: Either RESTError GT.AsyncTask <- post session p q
+  -- pure $ (\task -> GAT.Task { task, typ: GT.Query }) <$> eTask
   where
     p = GR.NodeAPI GT.Corpus (Just nodeId) $ GT.asyncTaskTypePath GT.Query

src/Gargantext/Components/Forest/Tree/Node/Action/Types.purs

@@ -2,6 +2,7 @@ module Gargantext.Components.Forest.Tree.Node.Action.Types where
 
 import Data.Generic.Rep (class Generic)
 import Data.Maybe (Maybe)
+import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.Forest.Tree.Node.Action.Contact.Types (AddContactParams)
 import Gargantext.Components.Forest.Tree.Node.Action.Update.Types (UpdateNodeParams)
 import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileFormat, FileType, UploadFileBlob)
@@ -15,7 +16,7 @@ data Action = AddNode     String GT.NodeType
             | DeleteNode  GT.NodeType
             | RenameNode  String
             | UpdateNode  UpdateNodeParams
-            | DoSearch    GT.AsyncTaskWithType
+            | DoSearch    GAT.Task
             | UploadFile  GT.NodeType FileType FileFormat Lang (Maybe String) String Selection
             | UploadArbitraryFile FileFormat (Maybe String) UploadFileBlob
             | UploadFrameCalc Lang Selection

src/Gargantext/Components/Forest/Tree/Node/Action/Update.purs

@@ -9,6 +9,7 @@ import Data.Either (Either(..))
 import Data.Maybe (Maybe(..))
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff_)
+import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.Bootstrap.Types (ComponentStatus(..))
 import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
 import Gargantext.Components.Forest.Tree.Node.Tools as Tools
@@ -29,14 +30,11 @@ import Toestand as T
 here :: R2.Here
 here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Update"
 
-updateRequest :: UpdateNodeParams -> Session -> ID -> AffRESTError GT.AsyncTaskWithType
+updateRequest :: UpdateNodeParams -> Session -> ID -> AffRESTError GAT.Task
 updateRequest updateNodeParams session nodeId = do
-  eTask :: Either RESTError GT.AsyncTask <- post session p updateNodeParams
-  case eTask of
-    Left err -> pure $ Left err
-    Right task -> pure $ Right $ GT.AsyncTaskWithType { task, typ: GT.UpdateNode }
-    where
-      p = GR.NodeAPI GT.Node (Just nodeId) "update"
+  post session p updateNodeParams
+  where
+    p = GR.NodeAPI GT.Node (Just nodeId) "update"
 
 ----------------------------------------------------------------------
 type UpdateProps =

src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs

@@ -14,6 +14,7 @@ import Data.Tuple.Nested ((/\))
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff)
 import Effect.Class (liftEffect)
+import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.Bootstrap as B
 import Gargantext.Components.Bootstrap.Types (ComponentStatus(..))
 import Gargantext.Components.Forest.Tree.Node.Action (Props)
@@ -554,21 +555,10 @@ uploadFile :: { contents  :: String
               , mName     :: Maybe String
               , selection :: ListSelection.Selection
               , session   :: Session }
-           -> AffRESTError GT.AsyncTaskWithType
-{-
-uploadFile session NodeList id JSON { mName, contents } = do
-  let url = GR.NodeAPI NodeList (Just id) $ GT.asyncTaskTypePath GT.ListUpload
-    -- { input: { data: ..., filetype: "JSON", name: "..." } }
-  let body = { input: { data: contents
-                      , filetype: "JSON"
-                      , name: fromMaybe "" mName } }
-  task <- post session url body
-  pure $ GT.AsyncTaskWithType { task, typ: GT.Form }
-  -}
+           -> AffRESTError GAT.Task
 uploadFile { contents, fileFormat, lang, fileType, id, nodeType, mName, selection, session } = do
   -- contents <- readAsText blob
-  eTask :: Either RESTError GT.AsyncTask <- postWwwUrlencoded session p body
-  pure $ (\task -> GT.AsyncTaskWithType { task, typ }) <$> eTask
+  postWwwUrlencoded session p body
     --postMultipartFormData session p fileContents
   where
     bodyParams = [ Tuple "_wf_data"       (Just contents)
@@ -603,7 +593,7 @@ uploadFile { contents, fileFormat, lang, fileType, id, nodeType, mName, selectio
 uploadArbitraryFile :: Session
                     -> ID
                     -> {blob :: UploadFileBlob, fileFormat :: FileFormat, mName :: Maybe String}
-                    -> AffRESTError GT.AsyncTaskWithType
+                    -> AffRESTError GAT.Task
 uploadArbitraryFile session id { fileFormat, mName, blob: UploadFileBlob blob } = do
     contents <- readAsDataURL blob
     uploadArbitraryData session id fileFormat mName contents
@@ -613,12 +603,11 @@ uploadArbitraryData :: Session
                     -> FileFormat
                     -> Maybe String
                     -> String
-                    -> AffRESTError GT.AsyncTaskWithType
+                    -> AffRESTError GAT.Task
 uploadArbitraryData session id fileFormat mName contents' = do
     let re = fromRight' (\_ -> unsafeCrashWith "Unexpected Left") $ DSR.regex "data:.*;base64," DSRF.noFlags
         contents = DSR.replace re "" contents'
-    eTask :: Either RESTError GT.AsyncTask <- postWwwUrlencoded session p (bodyParams contents)
-    pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.UploadFile }) <$> eTask
+    postWwwUrlencoded session p (bodyParams contents)
   where
     p = GR.NodeAPI GT.Node (Just id) $ GT.asyncTaskTypePath GT.UploadFile
 
@@ -818,10 +807,9 @@ uploadFrameCalc :: Session
                     -> ID
                     -> Lang
                     -> ListSelection.Selection
-                    -> AffRESTError GT.AsyncTaskWithType
+                    -> AffRESTError GAT.Task
 uploadFrameCalc session id lang selection = do
   let p = GR.NodeAPI GT.Node (Just id) $ GT.asyncTaskTypePath GT.UploadFrameCalc
 
-  eTask <- post session p { _wf_lang: Just lang
-                          , _wf_selection: selection }
-  pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.UploadFrameCalc }) <$> eTask
+  post session p { _wf_lang: Just lang
+                 , _wf_selection: selection }

src/Gargantext/Components/Forest/Tree/Node/Action/WriteNodesDocuments.purs

@@ -4,6 +4,7 @@ import Data.Either (Either)
 import Data.Maybe (Maybe(..))
 import Data.Tuple.Nested ((/\))
 import Effect.Aff (Aff)
+import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.Bootstrap as B
 import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
 import Gargantext.Components.Forest.Tree.Node.Action.Utils (loadLanguages)
@@ -152,8 +153,6 @@ type Params =
   , selection  :: ListSelection.Selection
   )
 
-documentsFromWriteNodesReq :: Session -> Record Params -> AffRESTError GT.AsyncTaskWithType
+documentsFromWriteNodesReq :: Session -> Record Params -> AffRESTError GAT.Task
 documentsFromWriteNodesReq session params@{ id } = do
-  eTask :: Either RESTError GT.AsyncTask <-
-    post session (NodeAPI GT.Node (Just id) "documents-from-write-nodes") params
-  pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.UpdateNode }) <$> eTask
+  post session (NodeAPI GT.Node (Just id) "documents-from-write-nodes") params

src/Gargantext/Components/Forest/Tree/Node/Tools/FTree.purs

 module Gargantext.Components.Forest.Tree.Node.Tools.FTree where
 
-import Data.Generic.Rep (class Generic)
 import Data.Eq.Generic (genericEq)
+import Data.Generic.Rep (class Generic)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (class Newtype)
-import Simple.JSON as JSON
-
+import Gargantext.AsyncTasks as GAT
 import Gargantext.Prelude
-
 import Gargantext.Types  as GT
+import Simple.JSON as JSON
 
 -----------------------------------------------------------------------
 type ID   = Int
@@ -26,7 +25,7 @@ instance Eq a => Eq (NTree a) where
   eq (NTree a1 as1) (NTree a2 as2) = (eq a1 a2) && (eq as1 as2)
 
 type Tree = { tree       :: FTree
-            , tasks     :: Array GT.AsyncTaskWithType
+            , tasks     :: Array GAT.Task
             }
 
 fTreeID :: FTree -> ID

src/Gargantext/Components/Forest/Tree/Node/Tools/ProgressBar.purs

-module Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar where
-
-import Data.Int (floor)
-import Data.Maybe (Maybe(..))
-import Effect (Effect)
-import Effect.Aff (launchAff_)
-import Effect.Class (liftEffect)
-import Effect.Timer (clearInterval, setInterval)
-import Gargantext.Components.App.Store as AppStore
-import Gargantext.Config.REST (AffRESTError)
-import Gargantext.Config.Utils (handleErrorInAsyncProgress, handleRESTError)
-import Gargantext.Prelude
-import Gargantext.Routes (SessionRoute(..))
-import Gargantext.Sessions (Session, get)
-import Gargantext.Types as GT
-import Gargantext.Utils.Reactix as R2
-import Reactix as R
-import Reactix.DOM.HTML as H
-import Record.Extra as RX
-import Toestand as T
-
-
-here :: R2.Here
-here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar"
-
-
--- data BarType = Bar | Pie
-
--- type Props = (
---     asyncTask :: GT.AsyncTaskWithType
---   , barType   :: BarType
---   , nodeId    :: GT.ID
---   , onFinish  :: Unit -> Effect Unit
---   , session   :: Session
---   )
-
-
--- asyncProgressBar :: R2.Component Props
--- asyncProgressBar = R.createElement asyncProgressBarCpt
--- asyncProgressBarCpt :: R.Component Props
--- asyncProgressBarCpt = R2.hereComponent here "asyncProgressBar" hCpt where
---   hCpt hp props@{ asyncTask: (GT.AsyncTaskWithType {task: GT.AsyncTask {id}})
---                 , barType
---                 , onFinish
---                 } _ = do
---     { errors } <- AppStore.use
-    
---     progress <- T.useBox 0.0
---     intervalIdRef <- R.useRef Nothing
-
---     R.useEffectOnce' $ do
---       intervalId <- setInterval 1000 $ do
---         launchAff_ $ do
---           let rdata = (RX.pick props :: Record QueryProgressData)
---           eAsyncProgress <- queryProgress rdata
---           handleRESTError hp errors eAsyncProgress $
---             \asyncProgress -> liftEffect $ do
---               let GT.AsyncProgress { status } = asyncProgress
---               T.write_ (min 100.0 $ GT.progressPercent asyncProgress) progress
---               if (status == GT.IsFinished) || (status == GT.IsKilled) || (status == GT.IsFailure) then do
---                 _ <- case R.readRef intervalIdRef of
---                   Nothing -> pure unit
---                   Just iid -> clearInterval iid
---                 handleErrorInAsyncProgress errors asyncProgress
---                 onFinish unit
---               else
---                 pure unit
-
---       R.setRef intervalIdRef $ Just intervalId
-
---       pure unit
-
-
---     pure $ progressIndicator { barType, label: id, progress }
-
---------------------------------------------------------------
-
-
--- type ProgressIndicatorProps =
---   ( barType  :: BarType
---   , label    :: String
---   , progress :: T.Box Number
---   )
-
--- progressIndicator :: Record ProgressIndicatorProps -> R.Element
--- progressIndicator p = R.createElement progressIndicatorCpt p []
--- progressIndicatorCpt :: R.Component ProgressIndicatorProps
--- progressIndicatorCpt = here.component "progressIndicator" cpt
---   where
---     cpt { barType, progress } _ = do
---       progress' <- T.useLive T.unequal progress
---       let progressInt = floor progress'
-
---       case barType of
---         Bar -> pure $
---                 H.div { className: "progress" }
---                   [ H.div { className: "progress-bar"
---                         , role: "progressbar"
---                         , style: { width: (show $ progressInt) <> "%" }
---                         } [ ]
---                   ]
---         Pie -> pure $
---                 H.div { className: "progress-pie" }
---                   [ H.div { className: "progress-pie-segment"
---                           , style: { "--over50": if progressInt < 50 then "0" else "1"
---                                    , "--value": show $ progressInt } } [
---                     ]
---                   ]
-
-
---------------------------------------------------------------
-
-type QueryProgressData =
-  ( asyncTask :: GT.AsyncTaskWithType
-  , nodeId    :: GT.ID
-  , session   :: Session
-  )
-
-queryProgress :: Record QueryProgressData -> AffRESTError GT.AsyncProgress
-queryProgress { asyncTask: GT.AsyncTaskWithType { task: GT.AsyncTask {id}
-                                                , typ
-                                                }
-              , nodeId
-              , session
-              } = get session (p typ)
-  where
-    -- TODO refactor path
-    p GT.ListCSVUpload      = NodeAPI GT.NodeList (Just nodeId) $ GT.asyncTaskTypePath GT.ListCSVUpload <> id <> "/poll?limit=1"
-    p GT.UpdateNgramsCharts = NodeAPI GT.Node   (Just nodeId) $ path <> id <> "/poll?limit=1"
-    p GT.UpdateNode         = NodeAPI GT.Node   (Just nodeId) $ path <> id <> "/poll?limit=1"
-    p _                     = NodeAPI GT.Corpus (Just nodeId) $ path <> id <> "/poll?limit=1"
-    path = GT.asyncTaskTypePath typ
-
-    -- TODO wait route: take the result if failure then message

src/Gargantext/Components/GraphExplorer/API.purs

@@ -3,6 +3,7 @@ module Gargantext.Components.GraphExplorer.API where
 import Gargantext.Prelude
 
 import Data.Maybe (Maybe(..))
+import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.GraphExplorer.Types as GET
 import Gargantext.Config.REST (AffRESTError)
 import Gargantext.Core.NgramsTable.Types as CNT
@@ -23,10 +24,9 @@ type GraphAsyncUpdateParams =
   , version :: CNT.Version
   )
 
-graphAsyncUpdate :: Record GraphAsyncUpdateParams -> AffRESTError GT.AsyncTaskWithType
+graphAsyncUpdate :: Record GraphAsyncUpdateParams -> AffRESTError GAT.Task
 graphAsyncUpdate { graphId, listId, nodes, session, termList, version } = do
-  eTask <- post session p q
-  pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.GraphRecompute }) <$> eTask
+  post session p q
   where
     p = GR.GraphAPI graphId $ GT.asyncTaskTypePath GT.GraphRecompute
     q = { listId
@@ -40,24 +40,13 @@ type GraphAsyncRecomputeParams =
   , session :: Session
   )
 
-graphAsyncRecompute :: Record GraphAsyncRecomputeParams -> AffRESTError GT.AsyncTaskWithType
+graphAsyncRecompute :: Record GraphAsyncRecomputeParams -> AffRESTError GAT.Task
 graphAsyncRecompute { graphId, session } = do
-  eTask <- post session p q
-  pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.GraphRecompute }) <$> eTask
+  post session p q
   where
     p = GR.GraphAPI graphId $ GT.asyncTaskTypePath GT.GraphRecompute
     q = {}
 
-type QueryProgressParams =
-  ( graphId :: Int
-  , session :: Session
-  , taskId  :: String
-  )
-
-queryProgress :: Record QueryProgressParams -> AffRESTError GT.AsyncProgress
-queryProgress { graphId, session, taskId } = do
-  get session $ GR.GraphAPI graphId $ "async/" <> taskId <> "/poll"
-
 type GraphVersions =
   ( gv_graph :: Maybe Int
   , gv_repo :: Int

src/Gargantext/Components/GraphQL/Task.purs

-module Gargantext.Components.GraphQL.Task where
-
-import Gargantext.Types (AsyncTaskID)
-
-type AsyncTaskStatus = String
-type AsyncTaskType = String
-
-type AsyncTask =
-  { id     :: AsyncTaskID
-  , status :: AsyncTaskStatus}
-
-type AsyncTaskWithType =
-  { task :: AsyncTask
-  , typ  :: AsyncTaskType }

src/Gargantext/Components/Login/PasswordForm.purs

@@ -19,6 +19,7 @@ import Gargantext.Hooks.FormValidation (VForm, useFormValidation)
 import Gargantext.Hooks.FormValidation.Unboxed as FV
 import Gargantext.Hooks.StateRecord (useStateRecord)
 import Gargantext.Sessions (postForgotPasswordRequest)
+import Gargantext.Types as GT
 import Gargantext.Utils ((?))
 import Gargantext.Utils.Reactix as R2
 import Reactix as R
@@ -195,5 +196,5 @@ formValidation r = foldl append mempty rules
 sendEmail ::
       Backend
   ->  FormData
-  ->  Aff (Either String { status :: String })
+  ->  Aff (Either String GT.WorkerTask)
 sendEmail backend { email } = postForgotPasswordRequest backend email

src/Gargantext/Components/Notifications.purs

@@ -51,16 +51,19 @@ removeCallback (State state@{ callbacks }) topic uuid =
 
 -- | Execute all callbacks for a given Notification
 callNotification :: State -> Notification -> Effect Unit
-callNotification (State { callbacks }) (Notification topic message) = do
+callNotification (State { callbacks }) n = do
   -- here.log2 "[callTopic] topic" topic
   -- here.log2 "[callTopic] callbacks" (HM.values callbacks)
   -- here.log2 "[callTopic] topicCallbacks" (HM.values topicCallbacks)
-  _ <- for (HM.values topicCallbacks) $ \cb -> do
-    cb message
-  pure unit
+
+  let topics = notificationTopics n
+
+  void $ for topics $ \topic -> do
+    void $ for (HM.values $ topicCallbacks topic) $ \cb -> do
+      cb n
   where
-    topicCallbacks :: CallbacksHM
-    topicCallbacks = fromMaybe HM.empty $ HM.lookup topic callbacks
+    topicCallbacks :: Topic -> CallbacksHM
+    topicCallbacks topic = fromMaybe HM.empty $ HM.lookup topic callbacks
 
 
 
@@ -174,7 +177,7 @@ connect ws@(WSNotification ws') url session = do
                 case parsed of
                   Left err -> do
                     here.log2 "[connect] Can't parse message" err
-                  Right n@(Notification topic _message) -> do
+                  Right n -> do
                     -- here.log2 "[connect] notification" topic
                     performAction ws (Call n)
                   -- Right parsed' -> do

src/Gargantext/Components/Notifications/Types.purs

@@ -37,7 +37,7 @@ type NodeId = Int
 type UUID = String
 
 data Topic =
-    UpdateJobProgress GT.AsyncTaskID
+    UpdateWorkerProgress GT.WorkerTask
   | UpdateTree NodeId
 derive instance Generic Topic _
 instance Eq Topic where eq = genericEq
@@ -48,16 +48,16 @@ instance JSON.ReadForeign Topic where
   readImpl f = do
     { type: type_ } <- JSON.readImpl f :: F.F { type :: String }
     case type_ of
-      "update_job_progress" -> do
-        { j_id } <- JSON.readImpl f :: F.F { j_id :: GT.AsyncTaskID }
-        pure $ UpdateJobProgress j_id
+      "update_worker_progress" -> do
+        { ji } <- JSON.readImpl f :: F.F { ji :: GT.WorkerTask }
+        pure $ UpdateWorkerProgress ji
       "update_tree" -> do
         { node_id } <- JSON.readImpl f :: F.F { node_id :: NodeId }
         pure $ UpdateTree node_id
       s -> F.fail $ F.ErrorAtProperty "type" $ F.ForeignError $ "unknown Topic type: " <> s
 instance JSON.WriteForeign Topic where
-  writeImpl (UpdateJobProgress j_id) = JSON.writeImpl { "type": "update_job_progress"
-                                                      , j_id }
+  writeImpl (UpdateWorkerProgress ji) = JSON.writeImpl { "type": "update_worker_progress"
+                                                       , ji }
   writeImpl (UpdateTree node_id) = JSON.writeImpl { "type": "update_tree"
                                                   , node_id }
 
@@ -78,42 +78,36 @@ instance JSON.WriteForeign WSRequest where
   writeImpl WSDeauthorize = JSON.writeImpl { request: "deauthorize" }
 
 
-
-data Message =
-    -- TODO
-    -- MJobProgress GT.AsyncProgress
-    -- MJobProgress GT.AsyncTaskLog
-    MJobProgress GT.AsyncProgress
-  | MEmpty
-derive instance Generic Message _
-instance JSON.ReadForeign Message where
-  readImpl f = do
-    { type: type_ } <- JSON.readImpl f :: F.F { type :: String }
-    case type_ of
-      "MJobProgress" -> do
-        -- TODO
-        -- { job_progress } <- JSON.readImpl f :: F.F { job_progress :: GT.AsyncProgress }
-        -- { job_progress } <- JSON.readImpl f :: F.F { job_progress :: GT.AsyncTaskLog }
-        { job_status } <- JSON.readImpl f :: F.F { job_status :: GT.AsyncProgress }
-        pure $ MJobProgress job_status
-      "MEmpty" -> do
-        pure MEmpty
-      s -> do F.fail $ F.ErrorAtProperty "type" $ F.ForeignError $ "unknown Message type: " <> s
-
 data Notification =
-    Notification Topic Message
+    NUpdateWorkerProgress GT.WorkerTask GT.AsyncTaskLog
+  | NUpdateTree NodeId
 derive instance Generic Notification _
 instance JSON.ReadForeign Notification where
   readImpl f = do
-    let str = JSON.read_ f :: Maybe String
-    case str of
-      Nothing -> do
-        { notification } <- JSON.readImpl f :: F.F { notification :: { topic :: Topic, message :: Message } }
-        pure $ Notification notification.topic notification.message
-      Just s -> F.fail $ F.ErrorAtProperty "_" $ F.ForeignError $ "unkown string: " <> s
-
-
-type Callback = Message -> Effect Unit
+    { type: type_ } <- JSON.readImpl f :: F.F { type :: String }
+    case type_ of
+      "update_worker_progress" -> do
+        { job_info, job_log } <- JSON.readImpl f :: F.F { job_info :: GT.WorkerTask, job_log :: GT.AsyncTaskLog }
+        pure $ NUpdateWorkerProgress job_info job_log
+      "update_tree" -> do
+        { node_id } <- JSON.readImpl f :: F.F { node_id :: NodeId }
+        pure $ NUpdateTree node_id
+      s -> F.fail $ F.ErrorAtProperty "type" $ F.ForeignError $ "unkown type: " <> s
+
+notificationTopics :: Notification -> Array Topic
+notificationTopics (NUpdateWorkerProgress workerTask@(GT.WorkerTask { node_id }) _) =
+  [ UpdateWorkerProgress workerTask ] <> updateTree
+  where
+    -- when receiving a worker progress notification, we are also
+    -- interested in 'update tree' subscriptions, because there might
+    -- be a new job that we didn't subscribe to
+    updateTree = case node_id of
+      Nothing -> []
+      Just nId -> [ UpdateTree nId ]
+notificationTopics (NUpdateTree nodeId) = [ UpdateTree nodeId ]
+
+
+type Callback = Notification -> Effect Unit
 
 type CallbacksHM = HM.HashMap UUID Callback
 

src/Gargantext/Components/PhyloExplorer/API.purs

@@ -5,7 +5,7 @@ module Gargantext.Components.PhyloExplorer.API
   , Clique(..), ReflexiveClique(..), CliqueFilter(..)
   , toReflexiveTimeUnit, fromReflexiveTimeUnit, extractCriteria
   , toReflexiveClique
-  , update, updateProgress
+  , update
   ) where
 
 import Gargantext.Prelude
@@ -15,6 +15,7 @@ import Data.Generic.Rep (class Generic)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (class Newtype)
 import Data.Show.Generic (genericShow)
+import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.PhyloExplorer.JSON (PhyloJSON)
 import Gargantext.Components.PhyloExplorer.Types (PhyloSet, parseToPhyloSet)
 import Gargantext.Config.REST (AffRESTError)
@@ -306,37 +307,10 @@ update ::
      Session
   -> NodeID
   -> Unit
-  -> AffRESTError GT.AsyncTaskWithType
+  -> AffRESTError GAT.Task
 update session nodeId _
     = S.post session request {}
-  >>= case _ of
-    Left err   -> pure $ Left err
-    Right task -> pure $ Right $ GT.AsyncTaskWithType
-      { task
-      , typ: GT.UpdateNode
-      }
-
   where
 
     request = GR.NodeAPI GT.Node (Just nodeId)
       (GT.asyncTaskTypePath GT.UpdateNode)
-
-
-updateProgress ::
-     Session
-  -> NodeID
-  -> GT.AsyncTaskWithType
-  -> AffRESTError GT.AsyncProgress
-updateProgress
-  session
-  nodeId
-  (GT.AsyncTaskWithType { task: GT.AsyncTask { id } })
-  =
-    S.get session request
-
-  where
-
-    request = GR.NodeAPI GT.Node (Just nodeId)
-      (GT.asyncTaskTypePath GT.UpdateNode <> pollParams)
-
-    pollParams = "/" <> id <> "/poll?limit1"

src/Gargantext/Config/Utils.purs

@@ -5,12 +5,12 @@ import Gargantext.Prelude
 import Data.Array as A
 import Data.Either (Either(..))
 import Data.Foldable (foldl)
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, Maybe(..))
 import Effect (Effect)
 import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
 import Gargantext.Config.REST (RESTError, logRESTError)
-import Gargantext.Types (AsyncEvent(..), AsyncProgress(..), AsyncTaskLog(..), AsyncTaskStatus(..), FrontendError(..))
+import Gargantext.Types (AsyncEvent(..), AsyncTaskLog(..), FrontendError(..), asyncTaskLogEventsErrorMessage)
 import Gargantext.Utils.Reactix as R2
 import Toestand as T
 
@@ -29,23 +29,31 @@ handleRESTError herePrefix errors (Left error) _ = liftEffect $ do
   -- here.warn2 "[handleTaskError] RESTError" error
 handleRESTError _ _ (Right task) handler = handler task
 
-handleErrorInAsyncProgress :: T.Box (Array FrontendError)
-                           -> AsyncProgress
-                           -> Effect Unit
-handleErrorInAsyncProgress errors ap@(AsyncProgress { status: IsFailure }) = do
-  T.modify_ (A.cons $ FStringError { error: concatErrors ap }) errors
-handleErrorInAsyncProgress errors ap@(AsyncProgress { log, status: IsFinished }) = do
-  if countFailed > 0 then
-    T.modify_ (A.cons $ FStringError { error: concatErrors ap }) errors
-  else
-    pure unit
-  where
-    countFailed = foldl (+) 0 $ (\(AsyncTaskLog { failed }) -> failed) <$> log
-handleErrorInAsyncProgress _ _ = pure unit
-
-concatErrors :: AsyncProgress -> String
-concatErrors (AsyncProgress { error, log }) = foldl eventsErrorMessage (fromMaybe "" error) log
-  where
-    eventsErrorMessage acc (AsyncTaskLog { events }) = (foldl eventErrorMessage "" events) <> "\n" <> acc
-    eventErrorMessage acc (AsyncEvent { level: "ERROR", message }) = message <> "\n" <> acc
-    eventErrorMessage acc _ = acc
+-- handleErrorInAsyncProgress :: T.Box (Array FrontendError)
+--                            -> AsyncProgress
+--                            -> Effect Unit
+-- handleErrorInAsyncProgress errors ap@(AsyncProgress { status: IsFailure }) = do
+--   T.modify_ (A.cons $ FStringError { error: concatErrors ap }) errors
+-- handleErrorInAsyncProgress errors ap@(AsyncProgress { log, status: IsFinished }) = do
+--   if countFailed > 0 then
+--     T.modify_ (A.cons $ FStringError { error: concatErrors ap }) errors
+--   else
+--     pure unit
+--   where
+--     countFailed = foldl (+) 0 $ (\(AsyncTaskLog { failed }) -> failed) <$> log
+-- handleErrorInAsyncProgress _ _ = pure unit
+
+-- concatErrors :: AsyncProgress -> String
+-- concatErrors (AsyncProgress { error, log }) = foldl eventsErrorMessage (fromMaybe "" error) log
+--   where
+--     eventsErrorMessage acc atl = asyncTaskLogEventsErrorMessage atl <> "\n" <> acc
+
+
+handleErrorInAsyncTaskLog :: T.Box (Array FrontendError)
+                          -> AsyncTaskLog
+                          -> Effect Unit
+handleErrorInAsyncTaskLog errors atl =
+  case asyncTaskLogEventsErrorMessage atl of
+    Nothing -> pure unit
+    Just error ->
+      T.modify_ (A.cons $ FStringError { error }) errors

src/Gargantext/Context/Progress.purs

@@ -5,6 +5,7 @@ module Gargantext.Context.Progress
   ) where
 
 import Data.Either (Either(..))
+import Data.Foldable (foldl)
 import Data.Maybe (Maybe(..))
 import Data.Tuple.Nested ((/\))
 import Effect (Effect)
@@ -13,14 +14,12 @@ import Effect.Class (liftEffect)
 import Effect.Timer (IntervalId, clearInterval, setInterval)
 import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.App.Store as AppStore
-import Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar (QueryProgressData, queryProgress)
 import Gargantext.Components.Notifications as Notifications
-import Gargantext.Components.Notifications.Types as NotificationsT
-import Gargantext.Config.Utils (handleErrorInAsyncProgress, handleRESTError)
+import Gargantext.Components.Notifications.Types as NT
+import Gargantext.Config.Utils (handleErrorInAsyncTaskLog, handleRESTError)
 import Gargantext.Hooks.FirstEffect (useFirstEffect')
 import Gargantext.Prelude
 import Gargantext.Sessions (Session)
-import Gargantext.Types (AsyncProgress)
 import Gargantext.Types as GT
 import Gargantext.Utils.Reactix as R2
 import Reactix as R
@@ -29,7 +28,7 @@ import Toestand as T
 
 
 type AsyncProps =
-  ( asyncTask :: GT.AsyncTaskWithType
+  ( asyncTask :: GAT.Task
   , nodeId    :: GT.ID
   , onFinish  :: Unit -> Effect Unit
   , session   :: Session
@@ -60,89 +59,52 @@ asyncProgressCpt = R2.hereComponent here "asyncProgress" hCpt where
     interval <- T.useBox 1000
 
     -- Methods
+
     let
-      -- TODO Manage somehow to get the whole job status sent here via
-      -- websockets, then we can remove the 'Maybe'
-      fetchJobProgress :: Effect Unit
-      fetchJobProgress = launchAff_ do
-        let rdata = (RX.pick props :: Record QueryProgressData)
-
-        eAsyncProgress <- queryProgress rdata
-        -- liftEffect $ here.log2 "[progress] received asyncProgress" eAsyncProgress
-
-        -- exponential backoff in case of errors
-        -- liftEffect $ do
-        --   case eAsyncProgress of
-        --     Left _  -> T.modify_ (_ * 2) interval
-        --     Right _ -> T.write_ 1000 interval
-        --   interval' <- T.read interval
-        --   resetInterval intervalIdRef (Just interval') exec
-
-        -- Handle removal of task in case of 500 error (e.g. server
-        -- was restarted and task id is not found anymore).
-        -- Error logging will be done below, in handleRESTError
-        case eAsyncProgress of
-          Right _ -> pure unit
-          Left err -> do
-            liftEffect $ do
-              resetInterval intervalIdRef Nothing (pure unit)
-              GAT.finish props.nodeId props.asyncTask tasks
-
-        handleRESTError hp errors eAsyncProgress onProgress
-
-      -- TODO Ideally we should use this function
-      -- onProgress jobProgress = do
-      --   launchAff_ $ onProgress jobProgress
-        
-
-      onProgress :: AsyncProgress -> Aff Unit
-      onProgress value@(GT.AsyncProgress { status }) = liftEffect do
-
-        T.write_ (min 100.0 $ GT.progressPercent value) progressBox
-
-        if (status == GT.IsFinished) ||
-           (status == GT.IsKilled) ||
-           (status == GT.IsFailure)
+      onProgress :: GT.AsyncTaskLog -> Aff Unit
+      onProgress atl@(GT.AsyncTaskLog log) = liftEffect $ do
+
+        T.write_ (min 100.0 $ GT.asyncTaskLogPercent atl) progressBox
+
+        here.log "[onProgress] TODO: Implement status killed"
+        if GT.asyncTaskLogIsFinished atl ||
+           GT.asyncTaskLogIsError atl
         then do
-          -- resetInterval intervalIdRef Nothing exec
-          -- case R.readRef intervalIdRef of
-          --   Nothing  -> R.nothing
-          --   Just iid -> clearInterval iid
-          handleErrorInAsyncProgress errors value
-          resetInterval intervalIdRef Nothing (pure unit)
+          handleErrorInAsyncTaskLog errors atl
+          -- resetInterval intervalIdRef Nothing (pure unit)
           onFinish unit
         else
           R.nothing
 
+        -- if (status == GT.IsFinished) ||
+        --    (status == GT.IsKilled) ||
+        --    (status == GT.IsFailure)
+        -- then do
+        --   -- resetInterval intervalIdRef Nothing exec
+        --   -- case R.readRef intervalIdRef of
+        --   --   Nothing  -> R.nothing
+        --   --   Just iid -> clearInterval iid
+        --   handleErrorInAsyncProgress errors value
+        --   resetInterval intervalIdRef Nothing (pure unit)
+        --   onFinish unit
+        -- else
+        --   R.nothing
+
     useFirstEffect' $ do
-      let (GT.AsyncTaskWithType { task: GT.AsyncTask { id: taskId } }) = props.asyncTask
-      let cb msg = do
+      let (GT.WorkerTask { message_id }) = props.asyncTask
+      let cb n = do
             -- here.log2 "callback! for job update" taskId
-            case msg of
-              NotificationsT.MJobProgress jobProgress -> launchAff_ $ onProgress jobProgress
-              NotificationsT.MEmpty -> fetchJobProgress
+            case n of
+              NT.NUpdateWorkerProgress _wt jobProgress -> launchAff_ $ onProgress jobProgress
+              _ -> pure unit
 
-            resetInterval intervalIdRef (Just defaultJobPollInterval) fetchJobProgress
+            -- resetInterval intervalIdRef (Just defaultJobPollInterval) fetchJobProgress
 
             -- The modal window has some problems closing when we refresh too early. This is a HACK
             -- void $ setTimeout 400 $ T2.reload reload
-      let action = NotificationsT.InsertCallback (NotificationsT.UpdateJobProgress taskId) ("task-" <> show taskId) cb
       ws <- T.read wsNotification
+      let action = NT.InsertCallback (NT.UpdateWorkerProgress props.asyncTask) ("task-" <> show message_id) cb
       Notifications.performAction ws action
-      fetchJobProgress
- 
-    -- Hooks
-    -- useFirstEffect' do
-    --   resetInterval intervalIdRef (Just 1000) exec
-      -- intervalId <- setInterval interval' $ exec unit
-      -- R.setRef intervalIdRef $ Just intervalId
-
-    -- TODO Current backend job implementation is that it cannot, by
-    -- itself, notify us when a job finished. Hence, we are forced to
-    -- poll for job still. However, we will keep canceling the timer
-    -- unless there is no progress report for some time.
-    useFirstEffect' $ do
-      resetInterval intervalIdRef (Just defaultJobPollInterval) fetchJobProgress
 
     -- Render
     pure $

src/Gargantext/Core/NgramsTable/Functions.purs

@@ -44,7 +44,7 @@ import Gargantext.Config.Utils (handleRESTError)
 import Gargantext.Core.NgramsTable.Types
 import Gargantext.Routes (SessionRoute(..))
 import Gargantext.Sessions (Session, get, post, put)
-import Gargantext.Types (AsyncTask, AsyncTaskType(..), AsyncTaskWithType(..), CTabNgramType(..), FrontendError, OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..))
+import Gargantext.Types (CTabNgramType(..), FrontendError, OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..))
 import Gargantext.Utils.Either (eitherMap)
 --import Gargantext.Utils.KarpRabin (indicesOfAny)
 import Gargantext.Utils.Reactix as R2
@@ -584,12 +584,13 @@ chartsAfterSync :: forall props discard.
 chartsAfterSync path'@{ nodeId } errors tasks _ = do
   eTask <- postNgramsChartsAsync path'
   handleRESTError (R2.herePrefix here "[chartsAfterSync]") errors eTask $ \task -> liftEffect $ do
-    GAT.insert nodeId task tasks
+    -- GAT.insert nodeId task tasks
+    here.log "[chartsAfterSync] TODO: IMPLEMENT ME!"
 
-postNgramsChartsAsync :: forall s. CoreParams s -> AffRESTError AsyncTaskWithType
+
+postNgramsChartsAsync :: forall s. CoreParams s -> AffRESTError GAT.Task
 postNgramsChartsAsync { listIds, nodeId, session, tabType } = do
-    eTask :: Either RESTError AsyncTask <- post session putNgramsAsync acu
-    pure $ (\task -> AsyncTaskWithType { task, typ: UpdateNgramsCharts }) <$> eTask
+    post session putNgramsAsync acu
   where
     acu = AsyncNgramsChartsUpdate { listId: head listIds
                                   , tabType }

src/Gargantext/Sessions.purs

@@ -21,6 +21,7 @@ import Gargantext.Config.REST as REST
 import Gargantext.Ends (class ToUrl, Backend, toUrl)
 import Gargantext.Prelude
 import Gargantext.Sessions.Types (Session(..), Sessions(..), OpenNodes, NodeId, mkNodeId, sessionUrl, sessionId, empty, null, unSessions, lookup, cons, tryCons, update, remove, tryRemove)
+import Gargantext.Types as GT
 import Gargantext.Utils.Reactix as R2
 import Reactix as R
 import Simple.JSON as JSON
@@ -118,7 +119,7 @@ postAuthRequest backend ar@(AuthRequest {username}) =
     decode (Right (AuthData { token, tree_id, user_id })) =
       Right $ Session { backend, caches: Map.empty, token, treeId: tree_id, username, userId: user_id }
 
-postForgotPasswordRequest :: Backend -> String -> Aff (Either String { status :: String })
+postForgotPasswordRequest :: Backend -> String -> Aff (Either String GT.WorkerTask)
 postForgotPasswordRequest backend email =
   decode <$> REST.post Nothing (toUrl backend "async/forgot-password") { email }
   where

src/Gargantext/Types.purs

@@ -5,6 +5,7 @@ import Gargantext.Prelude
 import Data.Argonaut as Argonaut
 import Data.Array as A
 import Data.Eq.Generic (genericEq)
+import Data.Foldable (foldl)
 import Data.Generic.Rep (class Generic)
 import Data.Int (toNumber)
 import Data.Maybe (Maybe(..), maybe)
@@ -749,64 +750,6 @@ asyncTaskTypePath UploadFile         = "async/file/add/"
 asyncTaskTypePath UploadFrameCalc    = "add/framecalc/async/"
 
 
-type AsyncTaskID = String
-
-data AsyncTaskStatus = IsRunning
-                     | IsPending
-                     | IsReceived
-                     | IsStarted
-                     | IsFailure
-                     | IsFinished
-                     | IsKilled
-derive instance Generic AsyncTaskStatus _
-instance JSON.ReadForeign AsyncTaskStatus where
-  readImpl = JSONG.enumSumRep
-instance JSON.WriteForeign AsyncTaskStatus where
-  writeImpl = JSON.writeImpl <<< show
-instance Show AsyncTaskStatus where
-  show = genericShow
-derive instance Eq AsyncTaskStatus
--- instance Read AsyncTaskStatus where
---   read "IsFailure"  = Just Failed
---   read "IsFinished" = Just Finished
---   read "IsKilled"   = Just Killed
---   read "IsPending"  = Just Pending
---   read "IsReceived" = Just Received
---   read "IsRunning"  = Just Running
---   read "IsStarted"  = Just Started
---   read _            = Nothing
-
-newtype AsyncTask =
-  AsyncTask { id     :: AsyncTaskID
-            , status :: AsyncTaskStatus
-            }
-
-derive instance Generic AsyncTask _
-derive instance Newtype AsyncTask _
-derive newtype instance JSON.ReadForeign AsyncTask
-derive newtype instance JSON.WriteForeign AsyncTask
-instance Eq AsyncTask where eq = genericEq
-
-newtype AsyncTaskWithType = AsyncTaskWithType
-  { task :: AsyncTask
-  , typ  :: AsyncTaskType
-  }
-derive instance Generic AsyncTaskWithType _
-derive instance Newtype AsyncTaskWithType _
-derive newtype instance JSON.ReadForeign AsyncTaskWithType
-derive newtype instance JSON.WriteForeign AsyncTaskWithType
-instance Eq AsyncTaskWithType where eq = genericEq
-
-newtype AsyncProgress = AsyncProgress
-  { id     :: AsyncTaskID
-  , error  :: Maybe String
-  , log    :: Array AsyncTaskLog
-  , status :: AsyncTaskStatus
-  }
-derive instance Generic AsyncProgress _
-derive instance Newtype AsyncProgress _
-derive newtype instance JSON.ReadForeign AsyncProgress
-
 newtype AsyncEvent = AsyncEvent
   { level :: String
   , message :: String
@@ -815,6 +758,10 @@ derive instance Generic AsyncEvent _
 derive instance Newtype AsyncEvent _
 derive newtype instance JSON.ReadForeign AsyncEvent
 
+asyncEventErrorMessage :: AsyncEvent -> Maybe String
+asyncEventErrorMessage (AsyncEvent { level: "ERROR", message }) = Just message
+asyncEventErrorMessage _ = Nothing
+
 newtype AsyncTaskLog = AsyncTaskLog
   { events :: Array AsyncEvent
   , failed :: Int
@@ -825,15 +772,45 @@ derive instance Generic AsyncTaskLog _
 derive instance Newtype AsyncTaskLog _
 derive newtype instance JSON.ReadForeign AsyncTaskLog
 
-progressPercent :: AsyncProgress -> Number
-progressPercent (AsyncProgress { log }) = perc
+asyncTaskLogEventsErrorMessage :: AsyncTaskLog -> Maybe String
+asyncTaskLogEventsErrorMessage (AsyncTaskLog { events }) =
+  foldl eventErrorMessage' Nothing events
+  where
+    eventErrorMessage' acc ae =
+      case asyncEventErrorMessage ae of
+        Nothing -> acc
+        Just e' ->
+          case acc of
+               Nothing -> Just e'
+               Just acc' -> Just $ e' <> "\n" <> acc'
+asyncTaskLogPercent :: AsyncTaskLog -> Number
+asyncTaskLogPercent (AsyncTaskLog { failed, remaining, succeeded }) = 100.0 * nom / denom
   where
-    perc = case A.head log of
-      Nothing -> 0.0
-      Just (AsyncTaskLog {failed, remaining, succeeded}) -> 100.0*nom/denom
-        where
-          nom = toNumber $ failed + succeeded
-          denom = toNumber $ failed + succeeded + remaining
+    nom = toNumber $ failed + succeeded
+    denom = toNumber $ failed + succeeded + remaining
+
+asyncTaskLogIsFinished :: AsyncTaskLog -> Boolean
+asyncTaskLogIsFinished (AsyncTaskLog { remaining }) = remaining == 0
+
+asyncTaskLogIsError :: AsyncTaskLog -> Boolean
+asyncTaskLogIsError atl@(AsyncTaskLog { events }) =
+  asyncTaskLogIsFinished atl &&
+  (A.length $ A.filter (\(AsyncEvent { level }) -> level == "ERROR") events) > 0
+
+
+-- New type tasks (async workers)
+newtype WorkerTask = WorkerTask { message_id :: Number
+                                , node_id    :: Maybe NodeID }
+derive instance Generic WorkerTask _
+derive instance Newtype WorkerTask _
+instance Eq WorkerTask where
+  eq = genericEq
+instance Ord WorkerTask where
+  compare = genericCompare
+instance Show WorkerTask where
+  show = genericShow
+derive newtype instance JSON.ReadForeign WorkerTask
+derive newtype instance JSON.WriteForeign WorkerTask
 
 ---------------------------------------------------------------------------
 -- | GarganText Internal Sugar
@@ -881,3 +858,76 @@ defaultCacheParams = CacheParams
   { expandTableEdition    : false
   , showTree              : true
   }
+
+
+
+
+
+--- Old-style tasks
+
+
+-- type AsyncTaskID = String
+
+-- data AsyncTaskStatus = IsRunning
+--                      | IsPending
+--                      | IsReceived
+--                      | IsStarted
+--                      | IsFailure
+--                      | IsFinished
+--                      | IsKilled
+-- derive instance Generic AsyncTaskStatus _
+-- instance JSON.ReadForeign AsyncTaskStatus where
+--   readImpl = JSONG.enumSumRep
+-- instance JSON.WriteForeign AsyncTaskStatus where
+--   writeImpl = JSON.writeImpl <<< show
+-- instance Show AsyncTaskStatus where
+--   show = genericShow
+-- derive instance Eq AsyncTaskStatus
+-- instance Read AsyncTaskStatus where
+--   read "IsFailure"  = Just Failed
+--   read "IsFinished" = Just Finished
+--   read "IsKilled"   = Just Killed
+--   read "IsPending"  = Just Pending
+--   read "IsReceived" = Just Received
+--   read "IsRunning"  = Just Running
+--   read "IsStarted"  = Just Started
+--   read _            = Nothing
+
+-- newtype AsyncTask =
+--   AsyncTask { id     :: AsyncTaskID
+--             , status :: AsyncTaskStatus
+--             }
+
+-- derive instance Generic AsyncTask _
+-- derive instance Newtype AsyncTask _
+-- derive newtype instance JSON.ReadForeign AsyncTask
+-- derive newtype instance JSON.WriteForeign AsyncTask
+-- instance Eq AsyncTask where eq = genericEq
+
+-- newtype AsyncTaskWithType = AsyncTaskWithType
+--   { task :: AsyncTask
+--   , typ  :: AsyncTaskType
+--   }
+-- derive instance Generic AsyncTaskWithType _
+-- derive instance Newtype AsyncTaskWithType _
+-- derive newtype instance JSON.ReadForeign AsyncTaskWithType
+-- derive newtype instance JSON.WriteForeign AsyncTaskWithType
+-- instance Eq AsyncTaskWithType where eq = genericEq
+
+-- newtype AsyncProgress = AsyncProgress
+--   { id     :: AsyncTaskID
+--   , error  :: Maybe String
+--   , log    :: Array AsyncTaskLog
+--   , status :: AsyncTaskStatus
+--   }
+-- derive instance Generic AsyncProgress _
+-- derive instance Newtype AsyncProgress _
+-- derive newtype instance JSON.ReadForeign AsyncProgress
+
+
+-- progressPercent :: AsyncProgress -> Number
+-- progressPercent (AsyncProgress { log }) = perc
+--   where
+--     perc = case A.head log of
+--       Nothing -> 0.0
+--       Just atl -> asyncTaskLogPercent atl