Commit 3c4ff4f6 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev-ngrams-table-cache-in-local-storage' of...

Merge branch 'dev-ngrams-table-cache-in-local-storage' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev-merge
parents 88ba14e3 c37cc12f
......@@ -5,9 +5,11 @@ import Data.Argonaut.Parser (jsonParser)
import Data.Array as A
import Data.Either (Either(..))
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Tuple (snd)
import DOM.Simple.Console (log2)
import Effect (Effect)
import Reactix as R
import Web.Storage.Storage as WSS
import Gargantext.Prelude
......@@ -19,7 +21,9 @@ import Gargantext.Utils.Reactix as R2
localStorageKey :: String
localStorageKey = "garg-async-tasks"
type Storage = Map.Map Int (Array GT.AsyncTaskWithType)
type NodeId = Int
type Storage = Map.Map NodeId (Array GT.AsyncTaskWithType)
empty :: Storage
empty = Map.empty
......@@ -37,6 +41,39 @@ getAsyncTasks = R2.getls >>= WSS.getItem localStorageKey >>= handleMaybe
parse s = GU.mapLeft (log2 "Error parsing serialised sessions:") (jsonParser s)
decode j = GU.mapLeft (log2 "Error decoding serialised sessions:") (decodeJson j)
getTasks :: Record ReductorProps -> NodeId -> Array GT.AsyncTaskWithType
getTasks { storage } nodeId = fromMaybe [] $ Map.lookup nodeId storage
removeTaskFromList :: Array GT.AsyncTaskWithType -> GT.AsyncTaskWithType -> Array GT.AsyncTaskWithType
removeTaskFromList ts (GT.AsyncTaskWithType { task: GT.AsyncTask { id: id' } }) =
A.filter (\(GT.AsyncTaskWithType { task: GT.AsyncTask { id: id'' } }) -> id' /= id'') ts
type ReductorProps = (
reload :: R.State Int
, storage :: Storage
)
type Reductor = R2.Reductor (Record ReductorProps) Action
useTasks :: R.State Int -> R.Hooks Reductor
useTasks reload = R2.useReductor act initializer unit
where
act :: R2.Actor (Record ReductorProps) Action
act a s = action s a
initializer _ = do
storage <- getAsyncTasks
pure { reload, storage }
data Action =
Insert NodeId GT.AsyncTaskWithType
| Remove NodeId GT.AsyncTaskWithType
action :: Record ReductorProps -> Action -> Effect (Record ReductorProps)
action { reload, storage } (Insert nodeId t) = do
_ <- snd reload $ (_ + 1)
let newStorage = Map.alter (maybe (Just [t]) (\ts -> Just $ A.cons t ts)) nodeId storage
pure { reload, storage: newStorage }
action { reload, storage } (Remove nodeId t) = do
_ <- snd reload $ (_ + 1)
let newStorage = Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts t)) nodeId storage
pure { reload, storage: newStorage }
......@@ -10,6 +10,7 @@ import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest (forest)
import Gargantext.Components.GraphExplorer (explorerLayout)
import Gargantext.Components.Lang (LandingLang(..))
......@@ -54,15 +55,18 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
showLogin <- R.useState' false
backend <- R.useState' Nothing
showCorpus <- R.useState' false
treeReload <- R.useState' 0
asyncTasks <- GAT.useTasks treeReload
showCorpus <- R.useState' false
handed <- R.useState' GT.RightHanded
let backends = fromFoldable defaultBackends
let ff f session = R.fragment [ f session, footer { session } ]
let forested child = forestLayout { child
let forested child = forestLayout { asyncTasks
, child
, frontends
, handed
, reload: treeReload
......@@ -71,68 +75,69 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
, showLogin: snd showLogin
, backend
}
let defaultView _ = forested $ homeLayout { backend
, lang: LL_EN
, publicBackend
, sessions
, visible: showLogin
}
let mCurrentRoute = fst route
let withSession sid f = maybe' ( const $ forested
$ homeLayout { lang: LL_EN
, backend
, publicBackend
, sessions
, visible:showLogin
}
)
(ff f)
(Sessions.lookup sid (fst sessions))
let withSession sid f = maybe' defaultView (ff f) (Sessions.lookup sid (fst sessions))
let sessionUpdate s = snd sessions $ Sessions.Update s
pure $ case fst showLogin of
true -> forested $ login { backend, backends, sessions, visible: showLogin }
false ->
case fst route of
Home -> forested $ homeLayout {lang:LL_EN, backend, publicBackend, sessions, visible:showLogin}
Login -> login { backends, sessions, visible: showLogin, backend}
Folder sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
FolderPrivate 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 }
Team sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
RouteFrameWrite sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session, nodeType: GT.NodeFrameWrite}
RouteFrameCalc sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session, nodeType: GT.NodeFrameCalc }
RouteFrameCode sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session, nodeType: GT.NodeFrameCode }
RouteFile sid nodeId -> withSession sid $ \session -> forested $ fileLayout { nodeId, session }
Corpus sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
Texts sid nodeId -> withSession sid $ \session -> forested $ textsLayout { nodeId, session, frontends }
Lists sid nodeId -> withSession sid $ \session -> forested $ listsLayout { nodeId, session }
Dashboard sid nodeId -> withSession sid $ \session -> forested $ dashboardLayout { nodeId, session }
Annuaire sid nodeId -> withSession sid $ \session -> forested $ annuaireLayout { frontends, nodeId, session }
UserPage sid nodeId -> withSession sid $ \session -> forested $ userLayout { frontends, nodeId, session }
ContactPage sid aId nodeId -> withSession sid $ \session -> forested $ annuaireUserLayout { annuaireId: aId, frontends, nodeId, session }
ContactPage sid aId nodeId -> withSession sid $ \session -> forested $ annuaireUserLayout { annuaireId: aId, asyncTasks, frontends, nodeId, session }
Corpus sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
CorpusDocument sid corpusId listId nodeId -> withSession sid $ \session -> forested $ documentLayout { nodeId, listId, session, corpusId: Just corpusId }
Dashboard sid nodeId -> withSession sid $ \session -> forested $ dashboardLayout { nodeId, session }
Document sid listId nodeId ->
withSession sid $
\session -> forested $ documentLayout { nodeId, listId, session, corpusId: Nothing }
Folder sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
FolderPrivate 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 }
Home -> forested $ homeLayout { backend, lang:LL_EN, publicBackend, sessions, visible: showLogin }
Lists sid nodeId -> withSession sid $ \session -> forested $ listsLayout { asyncTasks, nodeId, session, sessionUpdate }
Login -> login { backend, backends, sessions, visible: showLogin }
PGraphExplorer sid graphId ->
withSession sid $
\session ->
simpleLayout handed $
explorerLayout { frontends
explorerLayout { asyncTasks
, backend
, frontends
, graphId
, handed: fst handed
, mCurrentRoute
, session
, sessions: (fst sessions)
, showLogin
, backend
--, treeReload
}
RouteFile sid nodeId -> withSession sid $ \session -> forested $ fileLayout { nodeId, session }
RouteFrameCalc sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session, nodeType: GT.NodeFrameCalc }
RouteFrameCode sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session, nodeType: GT.NodeFrameCode }
RouteFrameWrite sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session, nodeType: GT.NodeFrameWrite}
Team sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
Texts sid nodeId -> withSession sid $ \session -> forested $ textsLayout { frontends, nodeId, session, sessionUpdate }
UserPage sid nodeId -> withSession sid $ \session -> forested $ userLayout { asyncTasks, frontends, nodeId, session }
type ForestLayoutProps =
( child :: R.Element
( asyncTasks :: GAT.Reductor
, backend :: R.State (Maybe Backend)
, child :: R.Element
, frontends :: Frontends
, handed :: R.State GT.Handed
, reload :: R.State Int
, route :: AppRoute
, sessions :: Sessions
, showLogin :: R.Setter Boolean
, backend :: R.State (Maybe Backend)
)
forestLayout :: Record ForestLayoutProps -> R.Element
......@@ -150,7 +155,7 @@ forestLayoutMain props = R.createElement forestLayoutMainCpt props []
forestLayoutMainCpt :: R.Component ForestLayoutProps
forestLayoutMainCpt = R.hooksComponentWithModule thisModule "forestLayoutMain" cpt
where
cpt { child, frontends, handed, reload, route, sessions, showLogin, backend} _ = do
cpt { asyncTasks, child, frontends, handed, reload, route, sessions, showLogin, backend} _ = do
let ordering =
case fst handed of
GT.LeftHanded -> reverse
......@@ -158,7 +163,7 @@ forestLayoutMainCpt = R.hooksComponentWithModule thisModule "forestLayoutMain" c
pure $ R2.row $ ordering [
H.div { className: "col-md-2", style: { paddingTop: "60px" } }
[ forest { frontends, handed: fst handed, reload, route, sessions, showLogin, backend} ]
[ forest { asyncTasks, backend, frontends, handed: fst handed, reload, route, sessions, showLogin } ]
, mainPage child
]
......
......@@ -267,9 +267,9 @@ mock :: Boolean
mock = false
type PageParams =
{ nodeId :: Int
{ corpusId :: Maybe Int
, listId :: Int
, corpusId :: Maybe Int
, nodeId :: Int
, tabType :: TabType
, query :: Query
, params :: T.Params}
......
......@@ -6,6 +6,9 @@ import Data.Maybe (Maybe(..))
import Data.Set as Set
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree (treeView)
import Gargantext.Ends (Frontends, Backend(..))
......@@ -14,19 +17,19 @@ import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (Session(..), Sessions, OpenNodes, unSessions)
import Gargantext.Types (Reload, Handed(..))
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
thisModule :: String
thisModule = "Gargantext.Components.Forest"
type Props =
( frontends :: Frontends
, handed :: Handed
, reload :: R.State Int
, route :: AppRoute
, sessions :: Sessions
, showLogin :: R.Setter Boolean
, backend :: R.State (Maybe Backend)
( asyncTasks :: GAT.Reductor
, backend :: R.State (Maybe Backend)
, frontends :: Frontends
, handed :: Handed
, reload :: R.State Int
, route :: AppRoute
, sessions :: Sessions
, showLogin :: R.Setter Boolean
)
forest :: Record Props -> R.Element
......@@ -34,11 +37,10 @@ forest props = R.createElement forestCpt props []
forestCpt :: R.Component Props
forestCpt = R.hooksComponentWithModule thisModule "forest" cpt where
cpt { frontends, handed, reload: extReload, route, sessions, showLogin, backend} _ = do
cpt { asyncTasks, frontends, handed, reload: extReload, route, sessions, showLogin, backend} _ = do
-- NOTE: this is a hack to reload the tree view on demand
reload <- R.useState' (0 :: Reload)
openNodes <- R2.useLocalStorageState R2.openNodesKey (Set.empty :: OpenNodes)
asyncTasks <- R2.useLocalStorageState GAT.localStorageKey GAT.empty
R2.useCache
( frontends
/\ route
......@@ -46,7 +48,7 @@ forestCpt = R.hooksComponentWithModule thisModule "forest" cpt where
/\ fst openNodes
/\ fst extReload
/\ fst reload
/\ fst asyncTasks
/\ (fst asyncTasks).storage
/\ handed
)
(cpt' openNodes asyncTasks reload showLogin backend)
......@@ -55,21 +57,18 @@ forestCpt = R.hooksComponentWithModule thisModule "forest" cpt where
where
trees = tree <$> unSessions sessions
tree s@(Session {treeId}) =
treeView { root: treeId
, asyncTasks
treeView { asyncTasks
, frontends
, handed
, mCurrentRoute: Just route
, openNodes
, reload
, root: treeId
, session: s
}
plus :: Handed -> R.Setter Boolean -> R.State (Maybe Backend) -> R.Element
plus handed showLogin backend = H.div {className: if handed == RightHanded
then "flex-start" -- TODO we should use lefthanded SASS class here
else "flex-end"
} [
plus handed showLogin backend = H.div { className: handedClass } [
H.button { title: "Add or remove connections to the server(s)."
, on: {click}
, className: "btn btn-default"
......@@ -81,9 +80,14 @@ plus handed showLogin backend = H.div {className: if handed == RightHanded
--, H.div { "type": "", className: "fa fa-plus-circle fa-lg"} []
--, H.div { "type": "", className: "fa fa-minus-circle fa-lg"} []
]
]
]
-- TODO same as the one in the Login Modal (same CSS)
-- [ H.i { className: "material-icons md-36"} [] ]
where
handedClass = if handed == RightHanded then
"flex-start" -- TODO we should use lefthanded SASS class here
else
"flex-end"
click _ = (snd backend) (const Nothing)
*> showLogin (const true)
This diff is collapsed.
......@@ -10,6 +10,9 @@ import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..))
......@@ -17,7 +20,6 @@ import Gargantext.Components.Forest.Tree.Node.Action.Upload (DroppedFile(..), fi
import Gargantext.Components.Forest.Tree.Node.Box (nodePopupView)
import Gargantext.Components.Forest.Tree.Node.Box.Types (CommonProps)
import Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar (asyncProgressBar, BarType(..))
import Gargantext.Components.Forest.Tree.Node.Tools.Task (Tasks)
import Gargantext.Components.Forest.Tree.Node.Tools.Sync (nodeActionsGraph, nodeActionsNodeList)
import Gargantext.Components.Forest.Tree.Node.Tools (nodeLink)
import Gargantext.Components.GraphExplorer.API as GraphAPI
......@@ -25,7 +27,6 @@ import Gargantext.Components.Lang (Lang(EN))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, const, discard, map, pure, show, unit, void, ($), (<>), (==), identity)
import Gargantext.Routes as Routes
import Gargantext.Version as GV
import Gargantext.Sessions (Session, sessionId)
......@@ -34,30 +35,44 @@ import Gargantext.Types as GT
import Gargantext.Utils.Popover as Popover
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.Forest.Tree.Node"
-- Main Node
type NodeMainSpanProps =
( id :: ID
( asyncTasks :: GAT.Reductor
, folderOpen :: R.State Boolean
, frontends :: Frontends
, id :: ID
, isLeaf :: IsLeaf
, mCurrentRoute :: Maybe Routes.AppRoute
, name :: Name
, nodeType :: GT.NodeType
, tasks :: Record Tasks
| CommonProps
)
type IsLeaf = Boolean
nodeMainSpan :: IsLeaf
-> Record NodeMainSpanProps
nodeMainSpan :: Record NodeMainSpanProps
-> R.Element
nodeMainSpan isLeaf p@{ dispatch, folderOpen, frontends, handed, session } = R.createElement el p []
nodeMainSpan p = R.createElement nodeMainSpanCpt p []
nodeMainSpanCpt :: R.Component NodeMainSpanProps
nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt
where
el = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt
cpt props@{id, mCurrentRoute, name, nodeType, tasks: { onTaskFinish, tasks }} _ = do
cpt props@{ asyncTasks: (asyncTasks /\ dispatchAsyncTasks)
, dispatch
, folderOpen
, frontends
, handed
, id
, isLeaf
, mCurrentRoute
, name
, nodeType
, session
} _ = do
-- only 1 popup at a time is allowed to be opened
droppedFile <- R.useState' (Nothing :: Maybe DroppedFile)
isDragOver <- R.useState' false
......@@ -69,31 +84,30 @@ nodeMainSpan isLeaf p@{ dispatch, folderOpen, frontends, handed, session } = R.c
GT.LeftHanded -> reverse
GT.RightHanded -> identity
let isSelected = mCurrentRoute == Routes.nodeTypeAppRoute nodeType (sessionId session) id
pure $ H.span (dropProps droppedFile isDragOver)
$ ordering
[ folderIcon nodeType folderOpen
, chevronIcon isLeaf handed nodeType folderOpen
, nodeLink { frontends
, id
, handed
, folderOpen
, isSelected: mCurrentRoute
== Routes.nodeTypeAppRoute
nodeType
(sessionId session) id
, id
, isSelected
, name: name' props
, nodeType
, session
, handed
}
, fileTypeView { dispatch, droppedFile, id, isDragOver, nodeType }
, H.div {} (map (\t -> asyncProgressBar { asyncTask: t
, barType: Pie
, corpusId: id
, onFinish: const $ onTaskFinish t
, session
}
) tasks
, barType: Pie
, nodeId: id
, onFinish: const $ dispatchAsyncTasks $ GAT.Remove id t
, session
}
) $ GAT.getTasks asyncTasks id
)
, if nodeType == GT.NodeUser
then GV.versionView {session}
......@@ -119,20 +133,28 @@ nodeMainSpan isLeaf p@{ dispatch, folderOpen, frontends, handed, session } = R.c
]
where
SettingsBox {show: showBox} = settingsBox nodeType
onPopoverClose popoverRef _ = Popover.setOpen popoverRef false
name' {name, nodeType} = if nodeType == GT.NodeUser
then show session
else name
chevronIcon isLeaf handed' nodeType folderOpen'@(open /\ _) =
where
SettingsBox {show: showBox} = settingsBox nodeType
onPopoverClose popoverRef _ = Popover.setOpen popoverRef false
name' {name, nodeType} = if nodeType == GT.NodeUser then show session else name
mNodePopupView props@{id, nodeType} onPopoverClose =
nodePopupView { dispatch
, handed : props.handed
, id
, name: name' props
, nodeType
, onPopoverClose
, session
}
chevronIcon isLeaf handed' nodeType (open /\ setOpen) =
if isLeaf
then H.div {} []
else
H.a { className: "chevron-icon"
, onClick: R2.effToggler folderOpen'
, on: { click: \_ -> setOpen $ not }
}
[ H.i {
className: if open
......@@ -142,28 +164,18 @@ nodeMainSpan isLeaf p@{ dispatch, folderOpen, frontends, handed, session } = R.c
else "fa fa-chevron-left"
} [] ]
folderIcon nodeType folderOpen'@(open /\ _) =
folderIcon nodeType (open /\ setOpen) =
H.a { className: "folder-icon"
, onClick: R2.effToggler folderOpen'
, on: { click: \_ -> setOpen $ not }
} [
H.i {className: GT.fldr nodeType open} []
]
H.i {className: GT.fldr nodeType open} []
]
popOverIcon = H.a { className: "settings fa fa-cog"
, title : "Each node of the Tree can perform some actions.\n"
<> "Click here to execute one of them."
} []
mNodePopupView props@{id, nodeType} onPopoverClose =
nodePopupView { id
, dispatch
, name: name' props
, nodeType
, onPopoverClose
, session
, handed : props.handed
}
dropProps droppedFile isDragOver =
{ className: "leaf " <> (dropClass droppedFile isDragOver)
, on: { drop: dropHandler droppedFile
......
......@@ -282,11 +282,19 @@ nodeLink p = R.createElement nodeLinkCpt p []
nodeLinkCpt :: R.Component NodeLinkProps
nodeLinkCpt = R.hooksComponentWithModule thisModule "nodeLink" cpt
where
cpt { frontends, id, isSelected, name, nodeType, session, handed, folderOpen} _ = do
cpt { folderOpen: (_ /\ setFolderOpen)
, frontends
, handed
, id
, isSelected
, name
, nodeType
, session
} _ = do
popoverRef <- R.useRef null
pure $
H.div { onClick: R2.effToggler folderOpen }
H.div { on: { click: \_ -> setFolderOpen $ not } }
[ H.a { data: { for: tooltipId
, tip: true
}
......
......@@ -16,15 +16,16 @@ import Gargantext.Sessions (Session, get)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar"
data BarType = Bar | Pie
type Props =
( asyncTask :: GT.AsyncTaskWithType
type Props = (
asyncTask :: GT.AsyncTaskWithType
, barType :: BarType
, corpusId :: GT.ID
, nodeId :: GT.ID
, onFinish :: Unit -> Effect Unit
, session :: Session
)
......@@ -38,7 +39,7 @@ asyncProgressBarCpt = R.hooksComponentWithModule thisModule "asyncProgressBar" c
where
cpt props@{ asyncTask: (GT.AsyncTaskWithType {task: GT.AsyncTask {id}})
, barType
, corpusId
, nodeId
, onFinish
} _ = do
(progress /\ setProgress) <- R.useState' 0.0
......@@ -104,13 +105,14 @@ queryProgress :: Record Props -> Aff GT.AsyncProgress
queryProgress { asyncTask: GT.AsyncTaskWithType { task: GT.AsyncTask {id}
, typ
}
, corpusId
, nodeId
, session
} = get session (p typ)
where
-- TODO refactor path
p GT.UpdateNode = NodeAPI GT.Node (Just corpusId) $ path <> id <> "/poll?limit=1"
p _ = NodeAPI GT.Corpus (Just corpusId) $ path <> id <> "/poll?limit=1"
p GT.UpdateNode = NodeAPI GT.Node (Just nodeId) $ path <> id <> "/poll?limit=1"
p GT.UpdateNgramsCharts = NodeAPI GT.Node (Just nodeId) $ path <> id <> "/poll?limit=1"
p _ = NodeAPI GT.Corpus (Just nodeId) $ path <> id <> "/poll?limit=1"
path = GT.asyncTaskTypePath typ
-- TODO wait route: take the result if failure then message
......@@ -6,11 +6,12 @@ import Data.Map as Map
import Data.Maybe (Maybe(..), maybe)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Reactix as R
import Gargantext.AsyncTasks as GAT
import Gargantext.Prelude (Unit, discard, identity, ($), (+))
import Gargantext.Types (Reload)
import Gargantext.Types as GT
import Reactix as R
type Tasks =
......@@ -20,19 +21,14 @@ type Tasks =
)
tasksStruct :: Int
-> R.State GAT.Storage
-> GAT.Reductor
-> R.State Reload
-> Record Tasks
tasksStruct id (asyncTasks /\ setAsyncTasks) (_ /\ setReload) =
tasksStruct id ({ storage } /\ dispatch) (_ /\ setReload) =
{ onTaskAdd, onTaskFinish, tasks }
where
tasks = maybe [] identity $ Map.lookup id asyncTasks
tasks = maybe [] identity $ Map.lookup id storage
onTaskAdd t = do
setReload (_ + 1)
setAsyncTasks $ Map.alter (maybe (Just [t])
$ (\ts -> Just $ A.cons t ts)) id
onTaskAdd t = dispatch $ GAT.Insert id t
onTaskFinish t = do
setReload (_ + 1)
setAsyncTasks $ Map.alter (maybe Nothing $ (\ts -> Just $ GAT.removeTaskFromList ts t)) id
onTaskFinish t = dispatch $ GAT.Remove id t
......@@ -20,6 +20,7 @@ import Reactix as R
import Reactix.DOM.HTML as RH
import Record as Record
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest (forest)
import Gargantext.Components.Graph as Graph
import Gargantext.Components.GraphExplorer.Controls as Controls
......@@ -40,15 +41,16 @@ import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.GraphExplorer"
type LayoutProps =
( frontends :: Frontends
type LayoutProps = (
asyncTasks :: GAT.Reductor
, backend :: R.State (Maybe Backend)
, frontends :: Frontends
, graphId :: GET.GraphId
, handed :: Types.Handed
, mCurrentRoute :: AppRoute
, session :: Session
, sessions :: Sessions
, showLogin :: R.State Boolean
, backend :: R.State (Maybe Backend)
)
type Props =
......@@ -90,7 +92,8 @@ explorer props = R.createElement explorerCpt props []
explorerCpt :: R.Component Props
explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt
where
cpt props@{ frontends
cpt props@{ asyncTasks
, frontends
, graph
, graphId
, graphVersion
......@@ -154,14 +157,15 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt
[ inner handed
[ rowControls [ Controls.controls controls ]
, R2.row $ mainLayout handed $
tree { frontends
, handed
, mCurrentRoute
, reload: treeReload
, sessions
, show: fst controls.showTree
, showLogin: snd showLogin
, backend}
tree { asyncTasks
, backend
, frontends
, handed
, mCurrentRoute
, reload: treeReload
, sessions
, show: fst controls.showTree
, showLogin: snd showLogin }
/\
RH.div { ref: graphRef, id: "graph-view", className: "col-md-12" } []
/\
......@@ -208,9 +212,9 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt
tree :: Record TreeProps -> R.Element
tree { show: false } = RH.div { id: "tree" } []
tree { frontends, handed, mCurrentRoute: route, reload, sessions, showLogin, backend} =
tree { asyncTasks, backend, frontends, handed, mCurrentRoute: route, reload, sessions, showLogin } =
RH.div {className: "col-md-2 graph-tree"} [
forest { frontends, handed, reload, route, sessions, showLogin, backend}
forest { asyncTasks, backend, frontends, handed, reload, route, sessions, showLogin }
]
mSidebar :: Maybe GET.MetaData
......@@ -222,14 +226,15 @@ explorerCpt = R.hooksComponentWithModule thisModule "explorer" cpt
type TreeProps =
(
frontends :: Frontends
, handed :: Types.Handed
asyncTasks :: GAT.Reductor
, backend :: R.State (Maybe Backend)
, frontends :: Frontends
, handed :: Types.Handed
, mCurrentRoute :: AppRoute
, reload :: R.State Int
, sessions :: Sessions
, show :: Boolean
, showLogin :: R.Setter Boolean
, backend :: R.State (Maybe Backend)
, reload :: R.State Int
, sessions :: Sessions
, show :: Boolean
, showLogin :: R.Setter Boolean
)
type MSidebarProps =
......
......@@ -223,7 +223,10 @@ deleteNode :: TermList
-> GET.MetaData
-> Record SigmaxT.Node
-> Aff NTC.VersionedNgramsPatches
deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches coreParams versioned
deleteNode termList session (GET.MetaData metaData) node = do
ret <- NTC.putNgramsPatches coreParams versioned
task <- NTC.postNgramsChartsAsync coreParams -- TODO add task
pure ret
where
nodeId :: Int
nodeId = unsafePartial $ fromJust $ fromString node.id
......
......@@ -38,10 +38,10 @@ thisModule = "Gargantext.Components.Login"
-- if not logged user can not save his work
type LoginProps =
( backends :: Array Backend
( backend :: R.State (Maybe Backend)
, backends :: Array Backend
, sessions :: R2.Reductor Sessions Sessions.Action
, visible :: R.State Boolean
, backend :: R.State (Maybe Backend)
)
login :: Record LoginProps -> R.Element
......@@ -104,7 +104,7 @@ chooser props = R.createElement chooserCpt props []
chooserCpt :: R.Component LoginProps
chooserCpt = R.staticComponent "G.C.Login.chooser" cpt where
cpt :: Record LoginProps -> Array R.Element -> R.Element
cpt {backend, backends, sessions} _ =
cpt { backend, backends, sessions } _ =
R.fragment $ title <> active <> new <> search
where
title = [H.h2 { className: "center modal-title" } [H.text "Instances manager"]]
......@@ -152,7 +152,7 @@ renderSessions sessions = R.fragment (renderSession sessions <$> unSessions (fst
GHL.clearCache unit
NTL.clearCache unit
liftEffect $ log "[renderSessions] cache cleared"
logOutClick _ = (snd sessions') (Sessions.Logout session)
logOutClick _ = snd sessions' $ Sessions.Logout session
renderBackend :: R.State (Maybe Backend) -> Backend -> R.Element
renderBackend state backend@(Backend {name}) =
......
......@@ -20,14 +20,18 @@ import Data.Sequence (Seq, length) as Seq
import Data.Set (Set)
import Data.Set as Set
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), fst)
import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff)
import Reactix (Component, Element, State, createElement, fragment, hooksComponentWithModule, unsafeEventValue, useState') as R
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.NgramsTable.Components as NTC
......@@ -274,12 +278,13 @@ tableContainerCpt { dispatch
]
-- NEXT
type Props =
( afterSync :: Unit -> Aff Unit
, path :: R.State PageParams
, state :: R.State State
, tabNgramType :: CTabNgramType
, versioned :: VersionedNgramsTable
type Props = (
afterSync :: Unit -> Aff Unit
, asyncTasks :: GAT.Reductor
, path :: R.State PageParams
, state :: R.State State
, tabNgramType :: CTabNgramType
, versioned :: VersionedNgramsTable
, withAutoUpdate :: Boolean
)
......@@ -290,7 +295,8 @@ loadedNgramsTableCpt :: R.Component Props
loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable" cpt
where
cpt { afterSync
, path: path@(path'@{ searchQuery, scoreType, params, termListFilter, termSizeFilter } /\ setPath)
, asyncTasks
, path: path@(path'@{ listIds, nodeId, params, searchQuery, scoreType, termListFilter, termSizeFilter } /\ setPath)
, state: (state@{ ngramsChildren
, ngramsLocalPatch
, ngramsParent
......@@ -300,7 +306,8 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable"
, versioned: Versioned { data: initTable }
, withAutoUpdate } _ = do
let syncResetBtns = [syncResetButtons { afterSync, ngramsLocalPatch
let syncResetBtns = [syncResetButtons { afterSync: chartsAfterSync
, ngramsLocalPatch
, performAction: performAction <<< CoreAction
}]
......@@ -330,11 +337,17 @@ loadedNgramsTableCpt = R.hooksComponentWithModule thisModule "loadedNgramsTable"
}
] <> syncResetBtns
where
chartsAfterSync _ = do
task <- postNgramsChartsAsync path'
liftEffect $ do
log2 "[performAction] Synchronize task" task
snd asyncTasks $ GAT.Insert nodeId task
autoUpdate :: Array R.Element
autoUpdate = if withAutoUpdate then
[ R2.buff $ autoUpdateElt {
duration: 5000
, effect: performAction $ CoreAction $ Synchronize { afterSync }
, effect: performAction $ CoreAction $ Synchronize { afterSync: chartsAfterSync }
} ]
else []
......@@ -480,8 +493,9 @@ selectNgramsOnFirstPage :: PreConversionRows -> Set NgramsTerm
selectNgramsOnFirstPage rows = Set.fromFoldable $ (view $ _NgramsElement <<< _ngrams) <$> rows
type MainNgramsTableProps =
( afterSync :: Unit -> Aff Unit
type MainNgramsTableProps = (
afterSync :: Unit -> Aff Unit
, asyncTasks :: GAT.Reductor
, cacheState :: R.State NT.CacheState
, defaultListId :: Int
, nodeId :: Int
......@@ -499,6 +513,7 @@ mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = R.hooksComponentWithModule thisModule "mainNgramsTable" cpt
where
cpt props@{ afterSync
, asyncTasks
, cacheState
, defaultListId
, nodeId
......@@ -506,11 +521,16 @@ mainNgramsTableCpt = R.hooksComponentWithModule thisModule "mainNgramsTable" cpt
, tabNgramType
, tabType
, withAutoUpdate } _ = do
let path = initialPageParams session nodeId [defaultListId] tabType
let render versioned = mainNgramsTablePaint { afterSync
, asyncTasks
, path
, tabNgramType
, versioned
, withAutoUpdate }
case cacheState of
(NT.CacheOn /\ _) -> do
let path = initialPageParams session nodeId [defaultListId] tabType
let render versioned = mainNgramsTablePaint { afterSync, path, tabNgramType, versioned, withAutoUpdate }
useLoaderWithCacheAPI {
cacheEndpoint: versionEndpoint props
, handleResponse
......@@ -519,10 +539,7 @@ mainNgramsTableCpt = R.hooksComponentWithModule thisModule "mainNgramsTable" cpt
, renderer: render
}
(NT.CacheOff /\ _) -> do
path <- R.useState' $ initialPageParams session nodeId [defaultListId] tabType
let render versioned = mainNgramsTablePaintWithState { afterSync, path, tabNgramType, versioned, withAutoUpdate }
useLoader (fst path) loader render
useLoader path loader render
versionEndpoint :: Record MainNgramsTableProps -> PageParams -> Aff Version
versionEndpoint { defaultListId, nodeId, session, tabType } _ = get session $ R.GetNgramsTableVersion { listId: defaultListId, tabType } (Just nodeId)
......@@ -568,8 +585,9 @@ mainNgramsTableCpt = R.hooksComponentWithModule thisModule "mainNgramsTable" cpt
handleResponse :: VersionedNgramsTable -> VersionedNgramsTable
handleResponse v = v
type MainNgramsTablePaintProps =
( afterSync :: Unit -> Aff Unit
type MainNgramsTablePaintProps = (
afterSync :: Unit -> Aff Unit
, asyncTasks :: GAT.Reductor
, path :: PageParams
, tabNgramType :: CTabNgramType
, versioned :: VersionedNgramsTable
......@@ -582,12 +600,13 @@ mainNgramsTablePaint p = R.createElement mainNgramsTablePaintCpt p []
mainNgramsTablePaintCpt :: R.Component MainNgramsTablePaintProps
mainNgramsTablePaintCpt = R.hooksComponentWithModule thisModule "mainNgramsTablePaint" cpt
where
cpt { afterSync, path, tabNgramType, versioned, withAutoUpdate } _ = do
cpt props@{ afterSync, asyncTasks, path, tabNgramType, versioned, withAutoUpdate } _ = do
pathS <- R.useState' path
state <- R.useState' $ initialState versioned
pure $ loadedNgramsTable {
afterSync
, asyncTasks
, path: pathS
, state
, tabNgramType
......@@ -595,8 +614,9 @@ mainNgramsTablePaintCpt = R.hooksComponentWithModule thisModule "mainNgramsTable
, withAutoUpdate
}
type MainNgramsTablePaintWithStateProps =
( afterSync :: Unit -> Aff Unit
type MainNgramsTablePaintWithStateProps = (
afterSync :: Unit -> Aff Unit
, asyncTasks :: GAT.Reductor
, path :: R.State PageParams
, tabNgramType :: CTabNgramType
, versioned :: VersionedNgramsTable
......@@ -609,11 +629,12 @@ mainNgramsTablePaintWithState p = R.createElement mainNgramsTablePaintWithStateC
mainNgramsTablePaintWithStateCpt :: R.Component MainNgramsTablePaintWithStateProps
mainNgramsTablePaintWithStateCpt = R.hooksComponentWithModule thisModule "mainNgramsTablePaintWithState" cpt
where
cpt { afterSync, path, tabNgramType, versioned, withAutoUpdate } _ = do
cpt { afterSync, asyncTasks, path, tabNgramType, versioned, withAutoUpdate } _ = do
state <- R.useState' $ initialState versioned
pure $ loadedNgramsTable {
afterSync
, asyncTasks
, path
, state
, tabNgramType
......
......@@ -20,6 +20,7 @@ module Gargantext.Components.NgramsTable.Core
, Version
, Versioned(..)
, VersionedNgramsPatches
, AsyncNgramsChartsUpdate
, VersionedNgramsTable
, CoreState
, highlightNgrams
......@@ -51,6 +52,7 @@ module Gargantext.Components.NgramsTable.Core
, _ngrams_scores
, commitPatch
, putNgramsPatches
, postNgramsChartsAsync
, syncPatches
, addNewNgramP
, addNewNgramA
......@@ -109,7 +111,7 @@ import Data.Symbol (SProxy(..))
import Data.These (These(..))
import Data.Traversable (for, traverse_)
import Data.TraversableWithIndex (traverseWithIndex)
import Data.Tuple (Tuple(..))
import Data.Tuple (Tuple(..), snd)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect.Aff (Aff, launchAff_)
......@@ -123,11 +125,12 @@ import Reactix.DOM.HTML as H
import Partial (crashWith)
import Partial.Unsafe (unsafePartial)
import Gargantext.Prelude
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Table as T
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, put)
import Gargantext.Types (CTabNgramType(..), OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..))
import Gargantext.Sessions (Session, get, post, put)
import Gargantext.Types (AsyncTaskType(..), AsyncTaskWithType(..), CTabNgramType(..), ListId, OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..))
import Gargantext.Utils.KarpRabin (indicesOfAny)
thisModule :: String
......@@ -749,6 +752,15 @@ applyPatchMap applyPatchValue (PatchMap pm) m = mergeMap f pm m
type NgramsPatches = PatchMap NgramsTerm NgramsPatch
type VersionedNgramsPatches = Versioned NgramsPatches
newtype AsyncNgramsChartsUpdate = AsyncNgramsChartsUpdate {
listId :: Maybe ListId
, tabType :: TabType
}
instance encodeAsyncNgramsChartsUpdate :: EncodeJson AsyncNgramsChartsUpdate where
encodeJson (AsyncNgramsChartsUpdate { listId, tabType }) = do
"list_id" := listId
~> "tab_type" := tabType
~> jsonEmptyObject
type NewElems = Map NgramsTerm TermList
......@@ -901,9 +913,18 @@ setTermListA :: NgramsTerm -> Replace TermList -> CoreAction
setTermListA ngram termList = CommitPatch $ setTermListP ngram termList
putNgramsPatches :: forall s. CoreParams s -> VersionedNgramsPatches -> Aff VersionedNgramsPatches
putNgramsPatches {session, nodeId, listIds, tabType} = put session putNgrams
putNgramsPatches { listIds, nodeId, session, tabType } = put session putNgrams
where putNgrams = PutNgrams tabType (head listIds) Nothing (Just nodeId)
postNgramsChartsAsync :: forall s. CoreParams s -> Aff AsyncTaskWithType
postNgramsChartsAsync { listIds, nodeId, session, tabType } = do
task <- post session putNgramsAsync acu
pure $ AsyncTaskWithType { task, typ: UpdateNgramsCharts }
where
acu = AsyncNgramsChartsUpdate { listId: head listIds
, tabType }
putNgramsAsync = PostNgramsChartsAsync (Just nodeId)
syncPatches :: forall p s. CoreParams p -> R.State (CoreState s) -> (Unit -> Aff Unit) -> Effect Unit
syncPatches props ({ ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches }
, ngramsStagePatch
......@@ -919,6 +940,7 @@ syncPatches props ({ ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches }
launchAff_ $ do
Versioned { data: newPatch, version: newVersion } <- putNgramsPatches props pt
callback unit
-- task <- postNgramsChartsAsync props
liftEffect $ do
log2 "[syncPatches] setting state, newVersion" newVersion
setState $ \s ->
......@@ -933,6 +955,33 @@ syncPatches props ({ ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches }
, ngramsVersion = newVersion
}
log2 "[syncPatches] ngramsVersion" newVersion
pure unit
{-
syncPatchesAsync :: forall p s. CoreParams p -> R.State (CoreState s) -> (Unit -> Aff Unit) -> Effect Unit
syncPatchesAsync props@{ listIds, tabType }
({ ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches }
, ngramsStagePatch
, ngramsValidPatch
, ngramsVersion
} /\ setState) callback = do
when (isEmptyNgramsTablePatch ngramsStagePatch) $ do
let patch = Versioned { data: ngramsPatches, version: ngramsVersion }
launchAff_ $ do
Versioned { data: newPatch, version: newVersion } <- postNgramsPatchesAsync props patch
callback unit
liftEffect $ do
log2 "[syncPatches] setting state, newVersion" newVersion
setState $ \s ->
s {
ngramsLocalPatch = fromNgramsPatches mempty
, ngramsStagePatch = fromNgramsPatches mempty
, ngramsValidPatch = fromNgramsPatches newPatch <> ngramsLocalPatch <> s.ngramsValidPatch
-- First the already valid patch, then the local patch, then the newly received newPatch.
, ngramsVersion = newVersion
}
log2 "[syncPatches] ngramsVersion" newVersion
-}
commitPatch :: forall s. Versioned NgramsTablePatch -> R.State (CoreState s) -> Effect Unit
commitPatch (Versioned {version, data: tablePatch}) (_ /\ setState) = do
......@@ -983,7 +1032,7 @@ convOrderBy (T.DESC _) = TermDesc
data CoreAction
= CommitPatch NgramsTablePatch
| Synchronize { afterSync :: Unit -> Aff Unit }
| Synchronize { afterSync :: Unit -> Aff Unit }
| ResetPatches
data Action
......@@ -1057,4 +1106,4 @@ syncResetButtonsCpt = R.hooksComponentWithModule thisModule "syncResetButtons" c
, H.button { className: "btn btn-primary " <> (if s || (not hasChanges) then "disabled" else "")
, on: { click: synchronizeClick }
} [ H.text "Sync" ]
]
\ No newline at end of file
]
......@@ -15,6 +15,7 @@ import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), ContactData, ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser)
......@@ -144,7 +145,8 @@ infoRender (Tuple title content) =
, H.span {} [H.text content] ]
type LayoutProps = (
frontends :: Frontends
asyncTasks :: GAT.Reductor
, frontends :: Frontends
, nodeId :: Int
, session :: Session
)
......@@ -160,10 +162,10 @@ userLayout props = R.createElement userLayoutCpt props []
userLayoutCpt :: R.Component LayoutProps
userLayoutCpt = R.hooksComponentWithModule thisModule "userLayout" cpt
where
cpt { frontends, nodeId, session } _ = do
cpt { asyncTasks, frontends, nodeId, session } _ = do
let sid = sessionId session
pure $ userLayoutWithKey { frontends, key: show sid <> "-" <> show nodeId, nodeId, session }
pure $ userLayoutWithKey { asyncTasks, frontends, key: show sid <> "-" <> show nodeId, nodeId, session }
userLayoutWithKey :: Record KeyLayoutProps -> R.Element
userLayoutWithKey props = R.createElement userLayoutWithKeyCpt props []
......@@ -171,7 +173,7 @@ userLayoutWithKey props = R.createElement userLayoutWithKeyCpt props []
userLayoutWithKeyCpt :: R.Component KeyLayoutProps
userLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "userLayoutWithKey" cpt
where
cpt { frontends, nodeId, session } _ = do
cpt { asyncTasks, frontends, nodeId, session } _ = do
reload <- R.useState' 0
cacheState <- R.useState' NT.CacheOn
......@@ -180,7 +182,7 @@ userLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "userLayoutWithKey"
\contactData@{contactNode: Contact {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" } [
display (fromMaybe "no name" name) (contactInfos hyperdata (onUpdateHyperdata reload))
, Tabs.tabs { cacheState, contactData, frontends, nodeId, session }
, Tabs.tabs { asyncTasks, cacheState, contactData, frontends, nodeId, session }
]
where
onUpdateHyperdata :: R.State Int -> HyperdataUser -> Effect Unit
......@@ -211,8 +213,8 @@ saveContactHyperdata session id h = do
put session (Routes.NodeAPI Node (Just id) "") h
type AnnuaireLayoutProps =
( annuaireId :: Int
type AnnuaireLayoutProps = (
annuaireId :: Int
| LayoutProps )
......@@ -222,14 +224,14 @@ annuaireUserLayout props = R.createElement annuaireUserLayoutCpt props []
annuaireUserLayoutCpt :: R.Component AnnuaireLayoutProps
annuaireUserLayoutCpt = R.hooksComponentWithModule thisModule "annuaireUserLayout" cpt
where
cpt { annuaireId, frontends, nodeId, session } _ = do
cpt { annuaireId, asyncTasks, frontends, nodeId, session } _ = do
cacheState <- R.useState' NT.CacheOn
useLoader nodeId (getAnnuaireContact session annuaireId) $
\contactData@{contactNode: Contact {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" }
[ display (fromMaybe "no name" name) (contactInfos hyperdata onUpdateHyperdata)
, Tabs.tabs { cacheState, contactData, frontends, nodeId, session } ]
, Tabs.tabs { asyncTasks, cacheState, contactData, frontends, nodeId, session } ]
where
onUpdateHyperdata :: HyperdataUser -> Effect Unit
......
......@@ -9,6 +9,7 @@ import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Reactix as R
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.DocsTable as DT
import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.Tab as Tab
......@@ -42,8 +43,9 @@ modeTabType' Patents = CTabAuthors
modeTabType' Books = CTabAuthors
modeTabType' Communication = CTabAuthors
type TabsProps =
( cacheState :: R.State NTypes.CacheState
type TabsProps = (
asyncTasks :: GAT.Reductor
, cacheState :: R.State NTypes.CacheState
, contactData :: ContactData
, frontends :: Frontends
, nodeId :: Int
......@@ -56,7 +58,7 @@ tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component TabsProps
tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
where
cpt { cacheState, contactData: {defaultListId}, frontends, nodeId, session} _ = do
cpt { asyncTasks, cacheState, contactData: {defaultListId}, frontends, nodeId, session} _ = do
active <- R.useState' 0
pure $
Tab.tabs { selected: fst active, tabs: tabs' }
......@@ -69,9 +71,9 @@ tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
, "Trash" /\ docs -- TODO pass-in trash mode
]
where
patentsView = { cacheState, defaultListId, mode: Patents, nodeId, session }
booksView = { cacheState, defaultListId, mode: Books, nodeId, session }
commView = { cacheState, defaultListId, mode: Communication, nodeId, session }
patentsView = { asyncTasks, cacheState, defaultListId, mode: Patents, nodeId, session }
booksView = { asyncTasks, cacheState, defaultListId, mode: Books, nodeId, session }
commView = { asyncTasks, cacheState, defaultListId, mode: Communication, nodeId, session }
chart = mempty
totalRecords = 4736 -- TODO
docs = DT.docViewLayout
......@@ -88,8 +90,9 @@ tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
}
type NgramsViewTabsProps =
( cacheState :: R.State NTypes.CacheState
type NgramsViewTabsProps = (
asyncTasks :: GAT.Reductor
, cacheState :: R.State NTypes.CacheState
, defaultListId :: Int
, mode :: Mode
, nodeId :: Int
......@@ -97,9 +100,10 @@ type NgramsViewTabsProps =
)
ngramsView :: Record NgramsViewTabsProps -> R.Element
ngramsView { cacheState, defaultListId, mode, nodeId, session } =
ngramsView { asyncTasks, cacheState, defaultListId, mode, nodeId, session } =
NT.mainNgramsTable {
afterSync: \_ -> pure unit
, asyncTasks
, cacheState
, defaultListId
, nodeId
......
module Gargantext.Components.Nodes.Lists where
import Data.Tuple (fst)
import Effect (Effect)
import Effect.Aff (launchAff_)
import Reactix as R
import Record as Record
------------------------------------------------------------------------
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.NgramsTable.Loader (clearCache)
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
......@@ -13,7 +16,8 @@ import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Table as Table
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude
import Gargantext.Sessions (Session, sessionId)
import Gargantext.Sessions (Session, sessionId, getCacheState, setCacheState)
import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.Nodes.Lists"
......@@ -21,8 +25,10 @@ thisModule = "Gargantext.Components.Nodes.Lists"
------------------------------------------------------------------------
type Props = (
nodeId :: Int
, session :: Session
asyncTasks :: GAT.Reductor
, nodeId :: Int
, session :: Session
, sessionUpdate :: Session -> Effect Unit
)
listsLayout :: Record Props -> R.Element
......@@ -34,7 +40,7 @@ listsLayoutCpt = R.hooksComponentWithModule thisModule "listsLayout" cpt
cpt path@{ nodeId, session } _ = do
let sid = sessionId session
pure $ listsLayoutWithKey { key: show sid <> "-" <> show nodeId, nodeId, session }
pure $ listsLayoutWithKey $ Record.merge path { key: show sid <> "-" <> show nodeId }
type KeyProps = (
key :: String
......@@ -47,10 +53,10 @@ listsLayoutWithKey props = R.createElement listsLayoutWithKeyCpt props []
listsLayoutWithKeyCpt :: R.Component KeyProps
listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKey" cpt
where
cpt { nodeId, session } _ = do
cpt { asyncTasks, nodeId, session, sessionUpdate } _ = do
let path = { nodeId, session }
cacheState <- R.useState' NT.CacheOn
cacheState <- R.useState' $ getCacheState NT.CacheOn session nodeId
useLoader path loadCorpusWithChild $
\corpusData@{ corpusId, corpusNode: NodePoly poly, defaultListId } ->
......@@ -59,7 +65,7 @@ listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKe
in
R.fragment [
Table.tableHeaderLayout {
afterCacheStateChange: \_ -> launchAff_ $ clearCache unit
afterCacheStateChange
, cacheState
, date
, desc
......@@ -68,10 +74,15 @@ listsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "listsLayoutWithKe
, title: "Corpus " <> name
, user: authors }
, Tabs.tabs {
cacheState
asyncTasks
, cacheState
, corpusData
, corpusId
, key: "listsLayoutWithKey-tabs-" <> (show $ fst cacheState)
, session }
]
where
afterCacheStateChange cacheState = do
launchAff_ $ clearCache unit
sessionUpdate $ setCacheState session nodeId cacheState
------------------------------------------------------------------------
......@@ -8,6 +8,7 @@ import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.Nodes.Corpus.Types (CorpusData)
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
......@@ -24,11 +25,13 @@ import Gargantext.Utils.Reactix as R2
thisModule :: String
thisModule = "Gargantext.Components.Nodes.Lists.Tabs"
type Props = ( cacheState :: R.State NTypes.CacheState
, corpusData :: CorpusData
, corpusId :: Int
, session :: Session
)
type Props = (
asyncTasks :: GAT.Reductor
, cacheState :: R.State NTypes.CacheState
, corpusData :: CorpusData
, corpusId :: Int
, session :: Session
)
type PropsWithKey = (
key :: String
......@@ -41,7 +44,7 @@ tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component PropsWithKey
tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
where
cpt { cacheState, corpusData: corpusData@{ defaultListId }, corpusId, session } _ = do
cpt { asyncTasks, cacheState, corpusData: corpusData@{ defaultListId }, corpusId, session } _ = do
(selected /\ setSelected) <- R.useState' 0
pure $ Tab.tabs { selected, tabs: tabs' }
......@@ -50,7 +53,7 @@ tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
, "Institutes" /\ view Institutes
, "Sources" /\ view Sources
, "Terms" /\ view Terms ]
view mode = ngramsView { cacheState, corpusData, corpusId, mode, session }
view mode = ngramsView { asyncTasks, cacheState, corpusData, corpusId, mode, session }
type NgramsViewProps = ( mode :: Mode | Props )
......@@ -60,7 +63,8 @@ ngramsView props = R.createElement ngramsViewCpt props []
ngramsViewCpt :: R.Component NgramsViewProps
ngramsViewCpt = R.hooksComponentWithModule thisModule "ngramsView" cpt
where
cpt { cacheState
cpt { asyncTasks
, cacheState
, corpusData: { defaultListId }
, corpusId
, mode
......@@ -72,6 +76,7 @@ ngramsViewCpt = R.hooksComponentWithModule thisModule "ngramsView" cpt
pure $ R.fragment
( charts tabNgramType chartType chartsReload
<> [ NT.mainNgramsTable { afterSync: afterSync chartsReload
, asyncTasks
, cacheState
, defaultListId
, nodeId: corpusId
......
module Gargantext.Components.Nodes.Lists.Types where
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson, (~>), (:=))
import Data.Argonaut.Decode.Error (JsonDecodeError(..))
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Gargantext.Prelude
thisModule :: String
thisModule = "Gargantext.Components.Nodes.Lists.Types"
data CacheState = CacheOn | CacheOff
......@@ -13,5 +17,15 @@ data CacheState = CacheOn | CacheOff
derive instance genericCacheState :: Generic CacheState _
instance eqCacheState :: Eq CacheState where
eq = genericEq
instance decodeJsonCacheState :: DecodeJson CacheState where
decodeJson json = do
obj <- decodeJson json
case obj of
"CacheOn" -> pure CacheOn
"CacheOff" -> pure CacheOff
s -> Left $ AtKey s $ TypeMismatch $ "Unknown cache value"
instance encodeJsonCacheState :: EncodeJson CacheState where
encodeJson CacheOn = encodeJson "CacheOn"
encodeJson CacheOff = encodeJson "CacheOff"
instance showCacheState :: Show CacheState where
show = genericShow
......@@ -6,6 +6,7 @@ import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -21,7 +22,7 @@ import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Tab as Tab
import Gargantext.Components.Table as Table
import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session, sessionId)
import Gargantext.Sessions (Session, Sessions, sessionId, getCacheState, setCacheState)
import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..))
thisModule :: String
......@@ -32,6 +33,7 @@ type Props = (
frontends :: Frontends
, nodeId :: Int
, session :: Session
, sessionUpdate :: Session -> Effect Unit
)
textsLayout :: Record Props -> R.Element
......@@ -40,10 +42,14 @@ textsLayout props = R.createElement textsLayoutCpt props []
------------------------------------------------------------------------
textsLayoutCpt :: R.Component Props
textsLayoutCpt = R.hooksComponentWithModule thisModule "textsLayout" cpt where
cpt { frontends, nodeId, session } _ = do
cpt { frontends, nodeId, session, sessionUpdate } _ = do
let sid = sessionId session
pure $ textsLayoutWithKey { frontends, key: show sid <> "-" <> show nodeId, nodeId, session }
pure $ textsLayoutWithKey { frontends
, key: show sid <> "-" <> show nodeId
, nodeId
, session
, sessionUpdate }
type KeyProps = (
key :: String
......@@ -56,17 +62,17 @@ textsLayoutWithKey props = R.createElement textsLayoutWithKeyCpt props []
textsLayoutWithKeyCpt :: R.Component KeyProps
textsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "textsLayoutWithKey" cpt
where
cpt { frontends, nodeId, session } _ = do
cacheState <- R.useState' NT.CacheOff
cpt { frontends, nodeId, session, sessionUpdate } _ = do
cacheState <- R.useState' $ getCacheState NT.CacheOff session nodeId
pure $ loader {session, nodeId} loadCorpusWithChild $
pure $ loader { nodeId, session } loadCorpusWithChild $
\corpusData@{ corpusId, corpusNode, defaultListId } -> do
let NodePoly { date, hyperdata: Hyperdata h, name } = corpusNode
CorpusInfo { authors, desc, query } = getCorpusInfo h.fields
title = "Corpus " <> name
R.fragment [
Table.tableHeaderLayout { afterCacheStateChange: \_ -> launchAff_ $ clearCache unit
Table.tableHeaderLayout { afterCacheStateChange
, cacheState
, date
, desc
......@@ -76,6 +82,10 @@ textsLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "textsLayoutWithKe
, user: authors }
, tabs { cacheState, corpusData, corpusId, frontends, session }
]
where
afterCacheStateChange cacheState = do
launchAff_ $ clearCache unit
sessionUpdate $ setCacheState session nodeId cacheState
data Mode = MoreLikeFav | MoreLikeTrash
......
......@@ -95,7 +95,7 @@ stateParams {pageSize, page, orderBy, searchType} = {offset, limit, orderBy, sea
offset = limit * (page - 1)
type TableHeaderLayoutProps =
( afterCacheStateChange :: Unit -> Effect Unit
( afterCacheStateChange :: NT.CacheState -> Effect Unit
, cacheState :: R.State NT.CacheState
, date :: String
, desc :: String
......@@ -159,9 +159,11 @@ tableHeaderLayoutCpt = R.hooksComponentWithModule thisModule "tableHeaderLayout"
cacheText (NT.CacheOn /\ _) = "Cache On"
cacheText (NT.CacheOff /\ _) = "Cache Off"
cacheClick (_ /\ setCacheState) after _ = do
setCacheState cacheStateToggle
after unit
cacheClick (cacheState /\ setCacheState) after _ = do
setCacheState $ const newCacheState
after newCacheState
where
newCacheState = cacheStateToggle cacheState
cacheStateToggle NT.CacheOn = NT.CacheOff
cacheStateToggle NT.CacheOff = NT.CacheOn
......
......@@ -167,6 +167,8 @@ sessionPath (R.PutNgrams t listId termList i) =
<> showTabType' t
<> maybe "" (\x -> "&list=" <> show x) listId
<> foldMap (\x -> "&listType=" <> show x) termList
sessionPath (R.PostNgramsChartsAsync i) =
sessionPath $ R.NodeAPI Node i $ "ngrams/async/charts/update"
sessionPath (R.NodeAPI nt i p) = nodeTypePath nt
<> (maybe "" (\i' -> "/" <> show i') i)
<> (if p == "" then "" else "/" <> p)
......
......@@ -45,6 +45,7 @@ data SessionRoute
| GetNgramsTableAll NgramsGetTableAllOpts (Maybe Id)
| GetNgramsTableVersion { listId :: ListId, tabType :: TabType } (Maybe Id)
| PutNgrams TabType (Maybe ListId) (Maybe TermList) (Maybe Id)
| PostNgramsChartsAsync (Maybe Id)
-- ^ This name is not good. In particular this URL is used both in PUT and POST.
| RecomputeNgrams (TabSubType CTabNgramType) Id ListId
| RecomputeListChart ChartType CTabNgramType Id ListId
......
-- | A module for authenticating to create sessions and handling them
module Gargantext.Sessions where
import DOM.Simple.Console (log2)
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), (.:))
import Data.Argonaut.Core (Json, fromArray, jsonEmptyObject, stringify)
import Data.Argonaut.Decode.Error (JsonDecodeError(..))
......@@ -10,32 +9,38 @@ import Data.Array as A
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Maybe (Maybe(..))
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Set (Set)
import Data.Traversable (traverse)
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff)
import Prelude (class Eq, class Show, Unit, const, otherwise, pure, show, unit, ($), (*>), (<*), (<$>), (<>), (==), (/=), (>>=), (<<<), bind)
import Reactix as R
import Web.Storage.Storage (getItem, removeItem, setItem)
import Gargantext.Components.Login.Types (AuthData(..), AuthInvalid(..), AuthRequest(..), AuthResponse(..), TreeId)
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Config.REST as REST
import Gargantext.Ends (class ToUrl, Backend(..), backendUrl, sessionPath, toUrl)
import Gargantext.Routes (SessionRoute)
import Gargantext.Types (NodePath, SessionId(..), nodePath)
import Gargantext.Utils.Reactix (getls)
import Gargantext.Utils.Reactix as R2
import Prelude (class Eq, class Show, Unit, const, otherwise, pure, show, unit, ($), (*>), (<*), (<$>), (<>), (==), (/=), (>>=), (<<<), bind)
import Reactix as R
import Web.Storage.Storage (getItem, removeItem, setItem)
-- | A Session represents an authenticated session for a user at a
-- | backend. It contains a token and root tree id.
newtype Session = Session
{ backend :: Backend
, username :: String
, caches :: Map Int NT.CacheState -- whether cache is turned on for node id
, token :: String
, treeId :: TreeId
, username :: String
}
------------------------------------------------------------------------
......@@ -64,21 +69,23 @@ sessionId = SessionId <<< show
--------------------
-- | JSON instances
instance encodeJsonSession :: EncodeJson Session where
encodeJson (Session {backend, username, token, treeId})
= "backend" := encodeJson backend
~> "username" := username
~> "token" := token
encodeJson (Session { backend, caches, username, token, treeId })
= "backend" := encodeJson backend
~> "caches" := encodeJson caches
~> "token" := token
~> "treeId" := treeId
~> "username" := username
~> jsonEmptyObject
instance decodeJsonSession :: DecodeJson Session where
decodeJson json = do
obj <- decodeJson json
backend <- obj .: "backend"
username <- obj .: "username"
caches <- obj .: "caches"
token <- obj .: "token"
treeId <- obj .: "treeId"
pure $ Session { backend, username, token, treeId}
username <- obj .: "username"
pure $ Session { backend, caches, token, treeId, username }
------------------------------------------------------------------------
......@@ -124,10 +131,18 @@ cons :: Session -> Sessions -> Sessions
cons s (Sessions {sessions:ss}) = Sessions {sessions:(Seq.cons s ss)}
tryCons :: Session -> Sessions -> Either Unit Sessions
tryCons s ss = try (lookup sid ss) where
sid = sessionId s
try Nothing = Right (cons s ss)
try _ = Left unit
tryCons s ss = try $ lookup sid ss
where
sid = sessionId s
try Nothing = Right (cons s ss)
try _ = Left unit
update :: Session -> Sessions -> Sessions
update s ss = up $ lookup sid ss
where
sid = sessionId s
up Nothing = cons s ss
up _ = cons s $ remove sid ss
remove :: SessionId -> Sessions -> Sessions
remove sid (Sessions {sessions:ss}) = Sessions {sessions: Seq.filter f ss} where
......@@ -157,6 +172,7 @@ instance toUrlSessionString :: ToUrl Session String where
data Action
= Login Session
| Logout Session
| Update Session
act :: Sessions -> Action -> Effect Sessions
act ss (Login s) =
......@@ -167,18 +183,26 @@ act old@(Sessions ss) (Logout s) =
case tryRemove (sessionId s) old of
Right new -> pure $ new
_ -> pure old <* log2 "Logged out of stale session:" (sessionId s)
act ss (Update s) = saveSessions $ update s ss
-- Key we will store the data under
localStorageKey :: String
localStorageKey = "garg-sessions"
empty :: Sessions
empty = Sessions {sessions:Seq.empty}
empty = Sessions { sessions: Seq.empty }
-- True if there are no sessions stored
null :: Sessions -> Boolean
null (Sessions {sessions:seq}) = Seq.null seq
null (Sessions { sessions: seq }) = Seq.null seq
getCacheState :: NT.CacheState -> Session -> Int -> NT.CacheState
getCacheState defaultCacheState (Session { caches }) nodeId =
fromMaybe defaultCacheState $ Map.lookup nodeId caches
setCacheState :: Session -> Int -> NT.CacheState -> Session
setCacheState (Session session@{ caches }) nodeId cacheState =
Session $ session { caches = Map.insert nodeId cacheState caches }
-- | Will attempt to load saved sessions from localstorage. should log
-- | if decoding fails
......@@ -208,6 +232,12 @@ saveSessions sessions = effect *> pure sessions where
| null sessions = rem
| otherwise = set (stringify $ encodeJson sessions)
updateSession :: Session -> Effect Unit
updateSession s = do
ss <- loadSessions
_ <- saveSessions $ update s ss
pure unit
postAuthRequest :: Backend -> AuthRequest -> Aff (Either String Session)
postAuthRequest backend ar@(AuthRequest {username}) =
decode <$> REST.post Nothing (toUrl backend "auth") ar
......@@ -215,7 +245,7 @@ postAuthRequest backend ar@(AuthRequest {username}) =
decode (AuthResponse ar2)
| {inval: Just (AuthInvalid {message})} <- ar2 = Left message
| {valid: Just (AuthData {token, tree_id})} <- ar2 =
Right $ Session { backend, username, token, treeId: tree_id }
Right $ Session { backend, caches: Map.empty, token, treeId: tree_id, username }
| otherwise = Left "Invalid response from server"
get :: forall a p. DecodeJson a => ToUrl Session p => Session -> p -> Aff a
......
......@@ -450,31 +450,33 @@ data CTabNgramType = CTabTerms | CTabSources | CTabAuthors | CTabInstitutes
derive instance eqCTabNgramType :: Eq CTabNgramType
derive instance ordCTabNgramType :: Ord CTabNgramType
instance showCTabNgramType :: Show CTabNgramType where
show CTabTerms = "Terms"
show CTabSources = "Sources"
show CTabAuthors = "Authors"
show CTabInstitutes = "Institutes"
instance encodeCTabNgramType :: EncodeJson CTabNgramType where
encodeJson t = encodeJson $ show t
data PTabNgramType = PTabPatents | PTabBooks | PTabCommunication
derive instance eqPTabNgramType :: Eq PTabNgramType
derive instance ordPTabNgramType :: Ord PTabNgramType
instance showPTabNgramType :: Show PTabNgramType where
show PTabPatents = "Patents"
show PTabBooks = "Books"
show PTabCommunication = "Communication"
instance encodePTabNgramType :: EncodeJson PTabNgramType where
encodeJson t = encodeJson $ show t
data TabSubType a = TabDocs | TabNgramType a | TabTrash | TabMoreLikeFav | TabMoreLikeTrash
derive instance eqTabSubType :: Eq a => Eq (TabSubType a)
derive instance ordTabSubType :: Ord a => Ord (TabSubType a)
{- instance encodeTabSubType a :: EncodeJson a => EncodeJson (TabSubType a) where
instance encodeTabSubType :: EncodeJson a => EncodeJson (TabSubType a) where
encodeJson TabDocs =
"type" := "TabDocs"
~> "data" := Nothing
~> "data" := (Nothing :: Maybe String)
~> jsonEmptyObject
encodeJson (TabNgramType a) =
"type" := "TabNgramType"
......@@ -482,16 +484,17 @@ derive instance ordTabSubType :: Ord a => Ord (TabSubType a)
~> jsonEmptyObject
encodeJson TabTrash =
"type" := "TabTrash"
~> "data" := Nothing
~> "data" := (Nothing :: Maybe String)
~> jsonEmptyObject
encodeJson TabMoreLikeFav =
"type" := "TabMoreLikeFav"
~> "data" := Nothing
~> "data" := (Nothing :: Maybe String)
~> jsonEmptyObject
encodeJson TabMoreLikeTrash =
"type" := "TabMoreLikeTrash"
~> "data" := Nothing
~> "data" := (Nothing :: Maybe String)
~> jsonEmptyObject
{-
instance decodeTabSubType a :: DecodeJson a => DecodeJson (TabSubType a) where
decodeJson j = do
obj <- decodeJson j
......@@ -522,19 +525,26 @@ derive instance eqTabType :: Eq TabType
derive instance ordTabType :: Ord TabType
instance showTabType :: Show TabType where
show = genericShow
{- instance encodeTabType :: EncodeJson TabType where
encodeJson (TabCorpus d) =
"type" := "TabCorpus"
~> "data" := encodeJson d
~> jsonEmptyObject
encodeJson (TabDocument d) =
"type" := "TabDocument"
~> "data" := encodeJson d
~> jsonEmptyObject
encodeJson (TabPairing d) =
"type" := "TabPairing"
~> "data" := encodeJson d
~> jsonEmptyObject
instance encodeTabType :: EncodeJson TabType where
encodeJson (TabCorpus TabDocs) = encodeJson "Docs"
encodeJson (TabCorpus (TabNgramType CTabAuthors)) = encodeJson "Authors"
encodeJson (TabCorpus (TabNgramType CTabInstitutes)) = encodeJson "Institutes"
encodeJson (TabCorpus (TabNgramType CTabSources)) = encodeJson "Sources"
encodeJson (TabCorpus (TabNgramType CTabTerms)) = encodeJson "Terms"
encodeJson (TabCorpus TabMoreLikeFav) = encodeJson "MoreFav"
encodeJson (TabCorpus TabMoreLikeTrash) = encodeJson "MoreTrash"
encodeJson (TabCorpus TabTrash) = encodeJson "Trash"
encodeJson (TabDocument TabDocs) = encodeJson "Docs"
encodeJson (TabDocument (TabNgramType CTabAuthors)) = encodeJson "Authors"
encodeJson (TabDocument (TabNgramType CTabInstitutes)) = encodeJson "Institutes"
encodeJson (TabDocument (TabNgramType CTabSources)) = encodeJson "Sources"
encodeJson (TabDocument (TabNgramType CTabTerms)) = encodeJson "Terms"
encodeJson (TabDocument TabMoreLikeFav) = encodeJson "MoreFav"
encodeJson (TabDocument TabMoreLikeTrash) = encodeJson "MoreTrash"
encodeJson (TabDocument TabTrash) = encodeJson "Trash"
encodeJson (TabPairing d) = encodeJson "TabPairing" -- TODO
-- ["Docs","Trash","MoreFav","MoreTrash","Terms","Sources","Authors","Institutes","Contacts"]
{-
instance decodeTabType :: DecodeJson TabType where
decodeJson j = do
obj <- decodeJson j
......@@ -579,12 +589,13 @@ modeFromString _ = Nothing
-- Async tasks
-- corresponds to /add/form/async or /add/query/async
data AsyncTaskType = Form
| UploadFile
data AsyncTaskType = AddNode
| Form
| GraphRecompute
| Query
| AddNode
| UpdateNgramsCharts
| UpdateNode
| UploadFile
derive instance genericAsyncTaskType :: Generic AsyncTaskType _
instance eqAsyncTaskType :: Eq AsyncTaskType where
......@@ -597,20 +608,23 @@ instance decodeJsonAsyncTaskType :: DecodeJson AsyncTaskType where
decodeJson json = do
obj <- decodeJson json
case obj of
"Form" -> pure Form
"UploadFile" -> pure UploadFile
"GraphRecompute" -> pure GraphRecompute
"Query" -> pure Query
"AddNode" -> pure AddNode
s -> Left $ AtKey s $ TypeMismatch "Unknown string"
"AddNode" -> pure AddNode
"Form" -> pure Form
"GraphRecompute" -> pure GraphRecompute
"Query" -> pure Query
"UpdateNgramsCharts" -> pure UpdateNgramsCharts
"UpdateNode" -> pure UpdateNode
"UploadFile" -> pure UploadFile
s -> Left $ AtKey s $ TypeMismatch "Unknown string"
asyncTaskTypePath :: AsyncTaskType -> String
asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath UploadFile = "async/file/add/"
asyncTaskTypePath Query = "query/"
asyncTaskTypePath GraphRecompute = "async/recompute/"
asyncTaskTypePath AddNode = "async/nobody/"
asyncTaskTypePath UpdateNode = "update/"
asyncTaskTypePath AddNode = "async/nobody/"
asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath GraphRecompute = "async/recompute/"
asyncTaskTypePath Query = "query/"
asyncTaskTypePath UpdateNgramsCharts = "ngrams/async/charts/update/"
asyncTaskTypePath UpdateNode = "update/"
asyncTaskTypePath UploadFile = "async/file/add/"
type AsyncTaskID = String
......
......@@ -109,9 +109,6 @@ select = createDOM "select"
menu :: ElemFactory
menu = createDOM "menu"
effToggler :: forall e. R.State Boolean -> EffectFn1 e Unit
effToggler (value /\ setValue) = mkEffectFn1 $ \_ -> setValue $ const $ not value
keyCode :: forall event. event -> Effect Int
keyCode = runEffectFn1 _keyCode
......
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