Commit d6d78ff1 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

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

parent 6e3f3063
......@@ -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
......@@ -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 =
......
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
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 = ( tree :: FTree
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
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)
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 })
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
......
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
......
......@@ -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"
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment