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