[async tasks] storing tasks to local storage is working now

src/Gargantext/AsyncTasks.purs

@@ -2,6 +2,7 @@ module Gargantext.AsyncTasks where
 
 import Data.Argonaut (decodeJson, class EncodeJson, encodeJson, (:=), (~>), (.:))
 import Data.Argonaut.Parser (jsonParser)
+import Data.Array as A
 import Data.Either (Either(..))
 import Data.Map as Map
 import Data.Maybe (Maybe(..))
@@ -17,10 +18,12 @@ import Gargantext.Utils.Reactix as R2
 localStorageKey :: String
 localStorageKey = "garg-async-tasks"
 
-empty :: Map.Map Int (Array GT.AsyncTaskWithType)
+type Storage = Map.Map Int (Array GT.AsyncTaskWithType)
+
+empty :: Storage
 empty = Map.empty
 
-getAsyncTasks :: Effect (Map.Map Int (Array GT.AsyncTaskWithType))
+getAsyncTasks :: Effect Storage
 getAsyncTasks = R2.getls >>= WSS.getItem localStorageKey >>= handleMaybe
   where
     handleMaybe (Just val) = handleEither (parse val >>= decode)
@@ -37,3 +40,7 @@ mapLeft :: forall l m r. (l -> m) -> Either l r -> Either m r
 mapLeft f (Left  l) = Left (f l)
 mapLeft _ (Right r) = Right r
 
+
+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

src/Gargantext/Components/Forest.purs

@@ -3,6 +3,7 @@ module Gargantext.Components.Forest where
 import Gargantext.Prelude
 
 import Data.Array as A
+import Data.Map as Map
 import Data.Maybe (Maybe(..))
 import Data.Set as Set
 import Data.Tuple (fst)
@@ -11,6 +12,7 @@ import Effect (Effect)
 import Reactix as R
 import Reactix.DOM.HTML as H
 
+import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.Forest.Tree (treeView)
 import Gargantext.Components.Forest.Tree.Node.Action (Reload)
 import Gargantext.Ends (Frontends)
@@ -35,15 +37,16 @@ forestCpt = R.hooksComponent "G.C.Forest.forest" cpt where
     -- 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 /\ sessions /\ fst openNodes /\ fst extReload /\ fst reload)
-      (cpt' openNodes reload showLogin)
-  cpt' openNodes reload showLogin (frontends /\ route /\ sessions /\ _ /\ _ /\ _) = do
+      (frontends /\ route /\ sessions /\ fst openNodes /\ fst extReload /\ fst reload /\ fst asyncTasks)
+      (cpt' openNodes asyncTasks reload showLogin)
+  cpt' openNodes asyncTasks reload showLogin (frontends /\ route /\ sessions /\ _ /\ _ /\ _ /\ _) = do
     pure $ R.fragment $ A.cons (plus showLogin) trees
     where
       trees = tree <$> unSessions sessions
       tree s@(Session {treeId}) =
-        treeView { root: treeId, frontends, mCurrentRoute: Just route, session: s, openNodes, reload }
+        treeView { root: treeId, asyncTasks, frontends, mCurrentRoute: Just route, session: s, openNodes, reload }
 
 plus :: R2.Setter Boolean -> R.Element
 plus showLogin =

src/Gargantext/Components/Forest/Tree.purs

 module Gargantext.Components.Forest.Tree where
 
-import DOM.Simple.Console (log2)
 import Data.Array as A
-import Data.Maybe (Maybe)
+import Data.Map as Map
+import Data.Maybe (Maybe(..), maybe)
 import Data.Set as Set
 import Data.Tuple (Tuple(..), fst, snd)
 import Data.Tuple.Nested ((/\))
+import DOM.Simple.Console (log2)
+import Effect (Effect)
 import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
 import Reactix as R
@@ -13,12 +15,13 @@ import Reactix.DOM.HTML as H
 import Record as Record
 import Record.Extra as RecordE
 
+import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.Forest.Tree.Node.Action (Action(..), CreateValue(..), FTree, ID, LNode(..), NTree(..), Reload, RenameValue(..), Tree, createNode, deleteNode, loadNode, renameNode)
 import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile)
-import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan)
+import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan, Tasks, tasksStruct)
 import Gargantext.Ends (Frontends)
 import Gargantext.Hooks.Loader (useLoader)
-import Gargantext.Prelude (Unit, bind, const, discard, map, pure, void, ($), (+), (/=), (<>))
+import Gargantext.Prelude (Unit, bind, const, discard, map, pure, void, ($), (+), (/=), (<>), identity)
 import Gargantext.Routes (AppRoute)
 import Gargantext.Sessions (OpenNodes, Session, mkNodeId)
 import Gargantext.Types as GT
@@ -33,6 +36,7 @@ type CommonProps =
 
 ------------------------------------------------------------------------
 type Props = ( root          :: ID
+             , asyncTasks    :: R.State GAT.Storage
              | CommonProps
              )
 
@@ -42,22 +46,23 @@ treeView props = R.createElement treeViewCpt props []
 treeViewCpt :: R.Component Props
 treeViewCpt = R.hooksComponent "G.C.Tree.treeView" cpt
   where
-    cpt { root, mCurrentRoute, session, frontends, openNodes, reload } _children = do
-      pure $ treeLoadView
-        { root, mCurrentRoute, session, frontends, openNodes, reload }
-
-treeLoadView :: Record Props -> R.Element
-treeLoadView p = R.createElement treeLoadView' p []
-
-treeLoadView' :: R.Component Props
-treeLoadView' = R.hooksComponent "TreeLoadView" cpt
-  where
-    cpt {root, mCurrentRoute, session, frontends, openNodes, reload} _ = do
+    cpt { root, asyncTasks, mCurrentRoute, session, frontends, openNodes, reload } _children = do
       let fetch _ = loadNode session root
-      let paint loaded = loadedTreeView {tree: loaded, mCurrentRoute, session, frontends, openNodes, reload}
-      useLoader {root, counter: fst reload} fetch paint
-
-type TreeViewProps = ( tree          :: FTree
+      let paint loaded = loadedTreeView {
+                                          asyncTasks
+                                        , frontends
+                                        , mCurrentRoute
+                                        , openNodes
+                                        , reload
+                                        , session
+                                        , tasks: tasksStruct root asyncTasks reload
+                                        , tree: loaded
+                                        }
+      useLoader { root, counter: fst reload } fetch paint
+
+type TreeViewProps = ( asyncTasks    :: R.State GAT.Storage
+                     , tree          :: FTree
+                     , tasks         :: Record Tasks
                      | CommonProps
                      )
 
@@ -68,28 +73,28 @@ loadedTreeView p = R.createElement loadedTreeView' p []
 loadedTreeView' :: R.Component TreeViewProps
 loadedTreeView' = R.hooksComponent "LoadedTreeView" cpt
   where
-    cpt {tree, mCurrentRoute, session, frontends, openNodes, reload} _ = do
-      tasks <- R.useState' []
-
+    cpt { asyncTasks, frontends, mCurrentRoute, openNodes, reload, tasks, tree, session } _ = do
       pure $ H.div {className: "tree"}
-        [ toHtml { frontends, mCurrentRoute, openNodes, reload, session, tasks, tree } ]
+        [ toHtml { asyncTasks, frontends, mCurrentRoute, openNodes, reload, session, tasks, tree } ]
 
 ------------------------------------------------------------------------
 
 type ToHtmlProps =
   (
-    tasks :: R.State (Array GT.AsyncTaskWithType)
+    asyncTasks :: R.State GAT.Storage
+  , tasks :: Record Tasks
   , tree :: FTree
   | CommonProps
   )
 
 toHtml :: Record ToHtmlProps -> R.Element
-toHtml p@{ frontends
+toHtml p@{ asyncTasks
+         , frontends
          , mCurrentRoute
          , openNodes
          , reload: reload@(_ /\ setReload)
          , session
-         , tasks: tasks@(asyncTasks /\ setAsyncTasks)
+         , tasks: tasks@{ onTaskAdd, onTaskFinish, tasks: tasks' }
          , tree: tree@(NTree (LNode {id, name, nodeType}) ary) } = R.createElement el {} []
   where
     el          = R.hooksComponent "NodeView" cpt
@@ -108,32 +113,27 @@ toHtml p@{ frontends
       pure $ H.ul {}
         [ H.li {}
           ( [ nodeMainSpan { id
-                           , asyncTasks
                            , dispatch: pAction
                            , folderOpen
                            , frontends
                            , mCurrentRoute
                            , name
                            , nodeType
-                           , onAsyncTaskFinish
                            , session
+                           , tasks
                            } ]
             <> childNodes (Record.merge commonProps
-                                        { children: ary
+                                        { asyncTasks
+                                        , children: ary
                                         , folderOpen })
           )
         ]
 
-    onAsyncTaskFinish (GT.AsyncTaskWithType {task: GT.AsyncTask {id: id'}}) = do
-      setAsyncTasks $ const newAsyncTasks
-      setReload (_ + 1)
-      where
-        newAsyncTasks = A.filter (\(GT.AsyncTaskWithType {task: GT.AsyncTask {id: id''}}) -> id' /= id'') asyncTasks
-
 
 type ChildNodesProps =
   (
-      children :: Array FTree
+      asyncTasks :: R.State GAT.Storage
+    , children :: Array FTree
     , folderOpen :: R.State Boolean
     | CommonProps
   )
@@ -142,24 +142,23 @@ type ChildNodesProps =
 childNodes :: Record ChildNodesProps -> Array R.Element
 childNodes { children: [] } = []
 childNodes { folderOpen: (false /\ _) } = []
-childNodes props@{ children } =
-  map (\ctree -> childNode {tree: ctree, asyncTasks: []}) $ sorted children
-    where
-      commonProps = RecordE.pick props :: Record CommonProps
-      sorted :: Array FTree -> Array FTree
-      sorted = A.sortWith (\(NTree (LNode {id}) _) -> id)
-      childNode :: Tree -> R.Element
-      childNode props = R.createElement el props []
-      el = R.hooksComponent "ChildNodeView" cpt
-      cpt {tree, asyncTasks} _ = do
-        tasks <- R.useState' asyncTasks
-        pure $ toHtml (Record.merge commonProps { tasks, tree })
+childNodes props@{ asyncTasks, children, reload } =
+  map (\ctree@(NTree (LNode {id}) _) ->
+        toHtml (Record.merge commonProps {
+                     asyncTasks
+                   , tasks: tasksStruct id asyncTasks reload
+                   , tree: ctree
+                   })) $ sorted children
+  where
+    commonProps = RecordE.pick props :: Record CommonProps
+    sorted :: Array FTree -> Array FTree
+    sorted = A.sortWith (\(NTree (LNode {id}) _) -> id)
 
 type PerformActionProps =
   ( openNodes :: R.State OpenNodes
   , reload    :: R.State Reload
   , session   :: Session
-  , tasks     :: R.State (Array GT.AsyncTaskWithType)
+  , tasks     :: Record Tasks
   , tree      :: FTree
   )
 
@@ -177,9 +176,9 @@ performAction p@{ openNodes: (_ /\ setOpenNodes)
 
 performAction { reload: (_ /\ setReload)
               , session
-              , tasks: (_ /\ setAsyncTasks)
+              , tasks: { onTaskAdd }
               , tree: (NTree (LNode {id}) _) } (SearchQuery task) = do
-  liftEffect $ setAsyncTasks $ A.cons task
+  liftEffect $ onTaskAdd task
   liftEffect $ log2 "[performAction] SearchQuery task:" task
 
 performAction p@{ reload: (_ /\ setReload)
@@ -190,21 +189,18 @@ performAction p@{ reload: (_ /\ setReload)
 
 performAction p@{ openNodes: (_ /\ setOpenNodes)
                 , reload:    (_ /\ setReload)
-                , tasks:     (_ /\ setAsyncTasks)
                 , session
                 , tree: (NTree (LNode {id}) _) } (CreateSubmit name nodeType) = do
-  -- task <- createNodeAsync session id $ CreateValue {name, nodeType}
   task <- createNode session id $ CreateValue {name, nodeType}
-  -- liftEffect $ setAsyncTasks $ A.cons task
   liftEffect do
     setOpenNodes (Set.insert (mkNodeId session id))
   performAction p RefreshTree
 
 performAction { session
-              , tasks: (_ /\ setAsyncTasks)
+              , tasks: { onTaskAdd }
               , tree: (NTree (LNode {id}) _) } (UploadFile nodeType fileType mName contents) = do
   task <- uploadFile session nodeType id fileType {mName, contents}
-  liftEffect $ setAsyncTasks $ A.cons task
+  liftEffect $ onTaskAdd task
   liftEffect $ log2 "uploaded, task:" task
 
 performAction { reload: (_ /\ setReload) } RefreshTree = do

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

 module Gargantext.Components.Forest.Tree.Node.Box where
 
-import Gargantext.Prelude
-
+import Data.Array as A
+import Data.Map as Map
+import Data.Maybe (Maybe(..), maybe)
+import Data.Nullable (Nullable, null)
+import Data.Tuple (fst, Tuple(..))
+import Data.Tuple.Nested ((/\))
 import DOM.Simple as DOM
 import DOM.Simple.Event
 import DOM.Simple.EventListener
 import DOM.Simple.Types
 import DOM.Simple.Window
-import Data.Maybe (Maybe(..))
-import Data.Nullable (Nullable, null)
-import Data.Tuple (fst, Tuple(..))
-import Data.Tuple.Nested ((/\))
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff, launchAff_)
 import Effect.Class (liftEffect)
 import Effect.Console
 import Effect.Uncurried (mkEffectFn1)
+import React.SyntheticEvent as E
+import Reactix as R
+import Reactix.DOM.HTML as H
+import URI.Extra.QueryPairs as NQP
+import URI.Query as Query
+import Web.File.FileReader.Aff (readAsText)
+
+import Gargantext.Prelude
+
+import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.Forest.Tree.Node (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox)
-import Gargantext.Components.Forest.Tree.Node.Action (Action(..), DroppedFile(..), FileType(..), ID, Name, UploadFileContents(..))
+import Gargantext.Components.Forest.Tree.Node.Action (Action(..), DroppedFile(..), FileType(..), ID, Name, Reload, UploadFileContents(..))
 import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), createNodeView)
 import Gargantext.Components.Forest.Tree.Node.Action.Rename (renameBox)
 import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFileView, fileTypeView, uploadTermListView, copyFromCorpusView)
@@ -38,15 +48,27 @@ import Gargantext.Types as GT
 import Gargantext.Utils (glyphicon, glyphiconActive)
 import Gargantext.Utils.Popover as Popover
 import Gargantext.Utils.Reactix as R2
-import React.SyntheticEvent as E
-import Reactix as R
-import Reactix.DOM.HTML as H
-import URI.Extra.QueryPairs as NQP
-import URI.Query as Query
-import Web.File.FileReader.Aff (readAsText)
 
 type Dispatch = Action -> Aff Unit
 
+type Tasks =
+  (
+    onTaskAdd :: GT.AsyncTaskWithType -> Effect Unit
+  , onTaskFinish :: GT.AsyncTaskWithType -> Effect Unit
+  , tasks :: Array GT.AsyncTaskWithType
+  )
+
+tasksStruct :: Int -> R.State GAT.Storage -> R.State Reload -> Record Tasks
+tasksStruct id (asyncTasks /\ setAsyncTasks) (_ /\ setReload) = { onTaskAdd, onTaskFinish, tasks }
+  where
+    tasks = maybe [] identity $ Map.lookup id asyncTasks
+    onTaskAdd t = do
+      setReload (_ + 1)
+      setAsyncTasks $ Map.alter (maybe (Just [t]) $ (\ts -> Just $ A.cons t ts)) id
+    onTaskFinish t = do
+      setReload (_ + 1)
+      setAsyncTasks $ Map.alter (maybe Nothing $ (\ts -> Just $ GAT.removeTaskFromList ts t)) id
+
 type CommonProps =
   ( dispatch :: Dispatch
   , session :: Session
@@ -55,13 +77,12 @@ type CommonProps =
 -- Main Node
 type NodeMainSpanProps =
   ( id                :: ID
-  , asyncTasks        :: Array GT.AsyncTaskWithType
   , folderOpen        :: R.State Boolean
   , frontends         :: Frontends
   , mCurrentRoute     :: Maybe Routes.AppRoute
   , name              :: Name
   , nodeType          :: GT.NodeType
-  , onAsyncTaskFinish :: GT.AsyncTaskWithType -> Effect Unit
+  , tasks             :: Record Tasks
   | CommonProps
   )
 
@@ -70,7 +91,7 @@ nodeMainSpan :: Record NodeMainSpanProps
 nodeMainSpan p@{ dispatch, folderOpen, frontends, session } = R.createElement el p []
   where
     el = R.hooksComponent "G.C.F.T.N.B.NodeMainSpan" cpt
-    cpt props@{id, asyncTasks, mCurrentRoute, name, nodeType, onAsyncTaskFinish} _ = do
+    cpt props@{id, mCurrentRoute, name, nodeType, tasks: { onTaskFinish, tasks }} _ = do
       -- only 1 popup at a time is allowed to be opened
       droppedFile   <- R.useState' (Nothing :: Maybe DroppedFile)
       isDragOver    <- R.useState' false
@@ -102,8 +123,8 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, session } = R.createElement el
         , H.div {} (map (\t -> asyncProgressBar { asyncTask: t
                                                 , barType: Pie
                                                 , corpusId: id
-                                                , onFinish: const $ onAsyncTaskFinish t
-                                                , session }) asyncTasks)
+                                                , onFinish: const $ onTaskFinish t
+                                                , session }) tasks)
         ]
           where
             SettingsBox {show: showBox} = settingsBox nodeType

src/Gargantext/Config.purs

@@ -11,8 +11,7 @@ defaultBackends = local :| [prod, partner, demo, dev]
     partner = backend V10 "/api/" "https://imtv4.gargantext.org" "institut-mines-telecom.imt"
     demo    = backend V10 "/api/" "https://demo.gargantext.org" "demo.inshs.cnrs"
     dev     = backend V10 "/api/" "https://dev.gargantext.org"  "devel.inshs.cnrs"
-    -- local   = backend V10 "/api/" "http://localhost:8008"       "local.cnrs"
-    local   = backend V10 "/api/" "http://192.168.1.6:8008"       "local.cnrs"
+    local   = backend V10 "/api/" "http://localhost:8008"       "local.cnrs"
 
 defaultApps :: NonEmpty Array Frontend
 defaultApps = relative :| [prod, dev, demo, haskell, caddy]
@@ -21,8 +20,7 @@ defaultApps = relative :| [prod, dev, demo, haskell, caddy]
     prod     = frontend "/#/" "https://v4.gargantext.org" "v4.gargantext.org"
     dev      = frontend "/#/" "https://dev.gargantext.org" "gargantext.org (dev)"
     demo     = frontend "/#/" "https://demo.gargantext.org" "gargantext.org (demo)"
-    -- haskell  = frontend "/#/" "http://localhost:8008" "localhost.gargantext"
-    haskell  = frontend "/#/" "http://192.168.1.6:8008" "localhost.gargantext"
+    haskell  = frontend "/#/" "http://localhost:8008" "localhost.gargantext"
     python   = frontend "/#/" "http://localhost:8000" "localhost.python"
     caddy    = frontend "/#/" "http://localhost:2015" "localhost.caddy"
 

src/Gargantext/Types.purs

@@ -439,14 +439,11 @@ type AffTableResult a = Aff (TableResult a)
 data Mode = Authors | Sources | Institutes | Terms
 
 derive instance genericMode :: Generic Mode _
-
 instance showMode :: Show Mode where
   show = genericShow
-
 derive instance eqMode :: Eq Mode
 instance ordMode :: Ord Mode where
   compare = genericCompare
-
 instance encodeMode :: EncodeJson Mode where
   encodeJson x = encodeJson $ show x
 
@@ -468,7 +465,12 @@ modeFromString _ = Nothing
 -- corresponds to /add/form/async or /add/query/async
 data AsyncTaskType = Form | GraphT | Query | CreateNode
 derive instance genericAsyncTaskType :: Generic AsyncTaskType _
-
+instance eqAsyncTaskType :: Eq AsyncTaskType where
+  eq = genericEq
+instance showAsyncTaskType :: Show AsyncTaskType where
+  show = genericShow
+instance encodeJsonAsyncTaskType :: EncodeJson AsyncTaskType where
+  encodeJson t     = encodeJson $ show t
 instance decodeJsonAsyncTaskType :: DecodeJson AsyncTaskType where
   decodeJson json = do
     obj <- decodeJson json
@@ -489,7 +491,11 @@ type AsyncTaskID = String
 
 data AsyncTaskStatus = Running | Pending | Received | Started | Failed | Finished | Killed
 derive instance genericAsyncTaskStatus :: Generic AsyncTaskStatus _
+instance showAsyncTaskStatus :: Show AsyncTaskStatus where
+  show = genericShow
 derive instance eqAsyncTaskStatus :: Eq AsyncTaskStatus
+instance encodeJsonAsyncTaskStatus :: EncodeJson AsyncTaskStatus where
+  encodeJson s = encodeJson $ show s
 instance decodeJsonAsyncTaskStatus :: DecodeJson AsyncTaskStatus where
   decodeJson json = do
     obj <- decodeJson json
@@ -510,7 +516,13 @@ newtype AsyncTask = AsyncTask {
   , status :: AsyncTaskStatus
   }
 derive instance genericAsyncTask :: Generic AsyncTask _
-
+instance eqAsyncTask :: Eq AsyncTask where
+  eq = genericEq
+instance encodeJsonAsyncTask :: EncodeJson AsyncTask where
+  encodeJson (AsyncTask { id, status }) =
+        "id"       := id
+     ~> "status"   := status
+     ~> jsonEmptyObject
 instance decodeJsonAsyncTask :: DecodeJson AsyncTask where
   decodeJson json = do
     obj <- decodeJson json
@@ -522,7 +534,14 @@ newtype AsyncTaskWithType = AsyncTaskWithType {
     task :: AsyncTask
   , typ  :: AsyncTaskType
   }
-
+derive instance genericAsyncTaskWithType :: Generic AsyncTaskWithType _
+instance eqAsyncTaskWithType :: Eq AsyncTaskWithType where
+  eq = genericEq
+instance encodeJsonAsyncTaskWithType :: EncodeJson AsyncTaskWithType where
+  encodeJson (AsyncTaskWithType { task, typ }) =
+        "task"       := task
+     ~> "typ"        := typ
+     ~> jsonEmptyObject
 instance decodeJsonAsyncTaskWithType :: DecodeJson AsyncTaskWithType where
   decodeJson json = do
     obj <- decodeJson json