Skip to content

P
purescript-gargantext
Commit 1aded978 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[Tree/Box] UpdateNode start

parent 914fc19b
Show whitespace changes
Inline Side-by-side
Showing with 107 additions and 66 deletions
src/Gargantext/Components/App.purs
View file @ 1aded978
......@@ -288,7 +288,7 @@ versionCpt = R.hooksComponent "G.C.A.version" cpt
showVersions frontendVer backendVer =
H.div { className: "row" }
[ H.h5 {} [ H.text $ "Frontend version: " <> frontendVer ]
, H.h5 {} [ H.text $ "backend version: " <> backendVer ]
, H.h5 {} [ H.text $ "Backend version: " <> backendVer ]
]
footer :: Record VersionProps -> R.Element
......
src/Gargantext/Components/Forest/Tree.purs
View file @ 1aded978
......@@ -23,6 +23,8 @@ import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (OpenNodes, Session, mkNodeId)
import Gargantext.Types as GT
------------------------------------------------------------------------
type CommonProps =
( frontends :: Frontends
, mCurrentRoute :: Maybe AppRoute
......@@ -38,35 +40,42 @@ type Props = ( root :: ID
treeView :: Record Props -> R.Element
treeView props = R.createElement treeViewCpt props []
treeViewCpt :: R.Component Props
treeViewCpt = R.hooksComponent "G.C.Tree.treeView" cpt
where
treeViewCpt :: R.Component Props
treeViewCpt = R.hooksComponent "G.C.Tree.treeView" cpt
where
cpt { root, mCurrentRoute, session, frontends, openNodes, reload } _children = do
pure $ treeLoadView
{ root, mCurrentRoute, session, frontends, openNodes, reload }
treeLoadView :: Record Props -> R.Element
treeLoadView p = R.createElement treeLoadView' p []
treeLoadView' :: R.Component Props
treeLoadView' = R.hooksComponent "TreeLoadView" cpt
treeLoadView p = R.createElement treeLoadViewCpt p []
where
treeLoadViewCpt :: R.Component Props
treeLoadViewCpt = R.hooksComponent "TreeLoadView" cpt
where
cpt {root, mCurrentRoute, session, frontends, openNodes, reload} _ = do
let fetch _ = loadNode session root
let paint loaded = loadedTreeView {tree: loaded, mCurrentRoute, session, frontends, openNodes, reload}
useLoader {root, counter: fst reload} fetch paint
let paint loaded = loadedTreeView { tree: loaded
, mCurrentRoute
, session
, frontends
, openNodes, reload
}
useLoader { root
, counter: fst reload
}
fetch paint
type TreeViewProps = ( tree :: FTree
| CommonProps
)
loadedTreeView :: Record TreeViewProps -> R.Element
loadedTreeView p = R.createElement loadedTreeView' p []
loadedTreeView' :: R.Component TreeViewProps
loadedTreeView' = R.hooksComponent "LoadedTreeView" cpt
loadedTreeView p = R.createElement loadedTreeViewCpt p []
where
loadedTreeViewCpt :: R.Component TreeViewProps
loadedTreeViewCpt = R.hooksComponent "LoadedTreeView" cpt
where
cpt {tree, mCurrentRoute, session, frontends, openNodes, reload} _ = do
tasks <- R.useState' []
......@@ -75,7 +84,6 @@ loadedTreeView' = R.hooksComponent "LoadedTreeView" cpt
[ toHtml { frontends, mCurrentRoute, openNodes, reload, session, tasks, tree } ]
------------------------------------------------------------------------
type ToHtmlProps =
(
tasks :: R.State (Array GT.AsyncTaskWithType)
......@@ -90,7 +98,8 @@ toHtml p@{ frontends
, reload: reload@(_ /\ setReload)
, session
, tasks: tasks@(asyncTasks /\ setAsyncTasks)
, tree: tree@(NTree (LNode {id, name, nodeType}) ary) } = R.createElement el {} []
, tree: tree@(NTree (LNode {id, name, nodeType}) ary)
} = R.createElement el {} []
where
el = R.hooksComponent "NodeView" cpt
commonProps = RecordE.pick p :: Record CommonProps
......@@ -132,13 +141,11 @@ toHtml p@{ frontends
type ChildNodesProps =
(
children :: Array FTree
( children :: Array FTree
, folderOpen :: R.State Boolean
| CommonProps
)
childNodes :: Record ChildNodesProps -> Array R.Element
childNodes { children: [] } = []
childNodes { folderOpen: (false /\ _) } = []
......@@ -178,10 +185,18 @@ performAction p@{ openNodes: (_ /\ setOpenNodes)
performAction { reload: (_ /\ setReload)
, session
, tasks: (_ /\ setAsyncTasks)
, tree: (NTree (LNode {id}) _) } (SearchQuery task) = do
, tree: (NTree (LNode {id}) _)
} (SearchQuery task) = do
liftEffect $ setAsyncTasks $ A.cons task
liftEffect $ log2 "[performAction] SearchQuery task:" task
performAction { reload: (_ /\ setReload)
, session
, tasks: (_ /\ setAsyncTasks)
, tree: (NTree (LNode {id}) _) } (UpdateNode task) = do
liftEffect $ setAsyncTasks $ A.cons task
liftEffect $ log2 "[performAction] UpdateNode task:" task
performAction p@{ reload: (_ /\ setReload)
, session
, tree: (NTree (LNode {id}) _) } (Submit name) = do
......
src/Gargantext/Components/Forest/Tree/Node/Action.purs
View file @ 1aded978
......@@ -17,6 +17,7 @@ import Gargantext.Types as GT
data Action = CreateSubmit String GT.NodeType
| DeleteNode
| UpdateNode GT.AsyncTaskWithType
| SearchQuery GT.AsyncTaskWithType
| Submit String
| UploadFile GT.NodeType FileType (Maybe String) UploadFileContents
......@@ -54,8 +55,8 @@ type ID = Int
type Reload = Int
newtype UploadFileContents = UploadFileContents String
type UploadFile = {
contents :: UploadFileContents
type UploadFile =
{ contents :: UploadFileContents
, name :: String
}
......@@ -81,10 +82,13 @@ deleteNode session nodeId = delete session $ NodeAPI GT.Node (Just nodeId) ""
loadNode :: Session -> ID -> Aff FTree
loadNode session nodeId = get session $ NodeAPI GT.Tree (Just nodeId) ""
{-
updateNode :: Session -> ID -> Aff ID
updateNode session nodeId = post session
-}
newtype RenameValue = RenameValue
{
name :: Name
{ name :: Name
}
instance encodeJsonRenameValue :: EncodeJson RenameValue where
......@@ -93,8 +97,7 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where
~> jsonEmptyObject
newtype CreateValue = CreateValue
{
name :: Name
{ name :: Name
, nodeType :: GT.NodeType
}
......
src/Gargantext/Components/Forest/Tree/Node/Box.purs
View file @ 1aded978
......@@ -518,7 +518,6 @@ type NodeProps =
, nodeType :: GT.NodeType
)
type Open = Boolean
type PanelActionProps =
( id :: ID
......@@ -568,7 +567,11 @@ actionSearch search session dispatch nodePopup =
pure $ R.fragment [ H.p {"style": {"margin" :"10px"}}
[ H.text $ "Search and create a private "
<> "corpus with the search query as corpus name." ]
, searchBar {langs: allLangs, onSearch: searchOn dispatch nodePopup, search, session}
, searchBar { langs: allLangs
, onSearch: searchOn dispatch nodePopup
, search
, session
}
]
where
searchOn :: (Action -> Aff Unit)
......
src/Gargantext/Components/Search/SearchBar.purs
View file @ 1aded978
......@@ -33,4 +33,10 @@ searchBarCpt = R.hooksComponent "G.C.Node.SearchBar.searchBar" cpt
cpt {langs, onSearch, search: search@(s /\ _), session} _ = do
--onSearchChange session s
pure $ H.div {"style": {"margin" :"10px"}}
[ searchField {databases:allDatabases, langs, onSearch, search, session}]
[ searchField { databases:allDatabases
, langs
, onSearch
, search
, session
}
]
src/Gargantext/Types.purs
View file @ 1aded978
......@@ -463,10 +463,14 @@ modeFromString "Institutes" = Just Institutes
modeFromString "Terms" = Just Terms
modeFromString _ = Nothing
-- Async tasks
-- | Async tasks
-- corresponds to /add/form/async or /add/query/async
data AsyncTaskType = Form | GraphT | Query | CreateNode
data AsyncTaskType = Form
| GraphT
| Query
| CreateNode
| UpdateNode
derive instance genericAsyncTaskType :: Generic AsyncTaskType _
asyncTaskTypePath :: AsyncTaskType -> String
......@@ -474,10 +478,18 @@ asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath Query = "query/"
asyncTaskTypePath GraphT = "async/"
asyncTaskTypePath CreateNode = "async/nobody/"
asyncTaskTypePath UpdateNode = "async/"
type AsyncTaskID = String
data AsyncTaskStatus = Running | Pending | Received | Started | Failed | Finished | Killed
data AsyncTaskStatus = Running
| Pending
| Received
| Started
| Failed
| Finished
| Killed
derive instance genericAsyncTaskStatus :: Generic AsyncTaskStatus _
derive instance eqAsyncTaskStatus :: Eq AsyncTaskStatus
instance decodeJsonAsyncTaskStatus :: DecodeJson AsyncTaskStatus where
......@@ -495,8 +507,8 @@ readAsyncTaskStatus "IsRunning" = Running
readAsyncTaskStatus "IsStarted" = Started
readAsyncTaskStatus _ = Running
newtype AsyncTask = AsyncTask {
id :: AsyncTaskID
newtype AsyncTask =
AsyncTask { id :: AsyncTaskID
, status :: AsyncTaskStatus
}
derive instance genericAsyncTask :: Generic AsyncTask _
......@@ -508,16 +520,17 @@ instance decodeJsonAsyncTask :: DecodeJson AsyncTask where
status <- obj .: "status"
pure $ AsyncTask {id, status}
newtype AsyncTaskWithType = AsyncTaskWithType {
task :: AsyncTask
newtype AsyncTaskWithType =
AsyncTaskWithType { task :: AsyncTask
, typ :: AsyncTaskType
}
newtype AsyncProgress = AsyncProgress {
id :: AsyncTaskID
newtype AsyncProgress =
AsyncProgress { id :: AsyncTaskID
, log :: Array AsyncTaskLog
, status :: AsyncTaskStatus
}
derive instance genericAsyncProgress :: Generic AsyncProgress _
instance decodeJsonAsyncProgress :: DecodeJson AsyncProgress where
decodeJson json = do
......@@ -527,12 +540,13 @@ instance decodeJsonAsyncProgress :: DecodeJson AsyncProgress where
status <- obj .: "status"
pure $ AsyncProgress {id, log, status}
newtype AsyncTaskLog = AsyncTaskLog {
events :: Array String
newtype AsyncTaskLog =
AsyncTaskLog { events :: Array String
, failed :: Int
, remaining :: Int
, succeeded :: Int
}
derive instance genericAsyncTaskLog :: Generic AsyncTaskLog _
instance decodeJsonAsyncTaskLog :: DecodeJson AsyncTaskLog where
decodeJson json = do
......
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