[Tree/Box] UpdateNode start

1aded978 · Alexandre Delanoë · 914fc19b · 1aded978 · 1aded978 · 1aded978
Commit 1aded978 authored May 30, 2020 by Alexandre Delanoë
6 changed files
--- a/src/Gargantext/Components/App.purs
+++ b/src/Gargantext/Components/App.purs
@@ -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

--- a/src/Gargantext/Components/Forest/Tree.purs
+++ b/src/Gargantext/Components/Forest/Tree.purs
@@ -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,44 +40,50 @@ 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
-    cpt { root, mCurrentRoute, session, frontends, openNodes, reload } _children = do
-      pure $ treeLoadView
-        { root, mCurrentRoute, session, frontends, openNodes, reload }
+    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
-    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
+    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

 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
-    cpt {tree, mCurrentRoute, session, frontends, openNodes, reload} _ = do
-      tasks <- R.useState' []
+    loadedTreeViewCpt :: R.Component TreeViewProps
+    loadedTreeViewCpt = R.hooksComponent "LoadedTreeView" cpt
+      where
+        cpt {tree, mCurrentRoute, session, frontends, openNodes, reload} _ = do
+          tasks <- R.useState' []

-      pure $ H.div {className: "tree"}
-        [ toHtml { frontends, mCurrentRoute, openNodes, reload, session, tasks, tree } ]
+          pure $ H.div {className: "tree"}
+            [ 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
-    , folderOpen :: R.State Boolean
-    | CommonProps
+  ( 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

--- a/src/Gargantext/Components/Forest/Tree/Node/Action.purs
+++ b/src/Gargantext/Components/Forest/Tree/Node/Action.purs
@@ -17,8 +17,9 @@ import Gargantext.Types  as GT

 data Action = CreateSubmit String GT.NodeType
            | DeleteNode
+            | UpdateNode  GT.AsyncTaskWithType
            | SearchQuery GT.AsyncTaskWithType
-            | Submit       String
+            | Submit      String
            | UploadFile  GT.NodeType FileType (Maybe String) UploadFileContents
            | RefreshTree

@@ -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
  }


--- a/src/Gargantext/Components/Forest/Tree/Node/Box.purs
+++ b/src/Gargantext/Components/Forest/Tree/Node/Box.purs
@@ -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)

--- a/src/Gargantext/Components/Search/SearchBar.purs
+++ b/src/Gargantext/Components/Search/SearchBar.purs
@@ -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
+                      }
+        ]
--- a/src/Gargantext/Types.purs
+++ b/src/Gargantext/Types.purs
@@ -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,44 +507,46 @@ readAsyncTaskStatus "IsRunning"  = Running
 readAsyncTaskStatus "IsStarted"  = Started
 readAsyncTaskStatus _ = Running

-newtype AsyncTask = AsyncTask {
-    id     :: AsyncTaskID
-  , status :: AsyncTaskStatus
-  }
+newtype AsyncTask =
+  AsyncTask { id     :: AsyncTaskID
+            , status :: AsyncTaskStatus
+            }
 derive instance genericAsyncTask :: Generic AsyncTask _

 instance decodeJsonAsyncTask :: DecodeJson AsyncTask where
  decodeJson json = do
    obj <- decodeJson json
-    id <- obj .: "id"
+    id  <- obj .: "id"
    status <- obj .: "status"
    pure $ AsyncTask {id, status}

-newtype AsyncTaskWithType = AsyncTaskWithType {
-    task :: AsyncTask
-  , typ  :: AsyncTaskType
-  }
+newtype AsyncTaskWithType =
+  AsyncTaskWithType { task :: AsyncTask
+                    , typ  :: AsyncTaskType
+                    }
+
+newtype AsyncProgress =
+  AsyncProgress { id :: AsyncTaskID
+                , log :: Array AsyncTaskLog
+                , status :: AsyncTaskStatus
+                }

-newtype AsyncProgress = AsyncProgress {
-    id :: AsyncTaskID
-  , log :: Array AsyncTaskLog
-  , status :: AsyncTaskStatus
-  }
 derive instance genericAsyncProgress :: Generic AsyncProgress _
 instance decodeJsonAsyncProgress :: DecodeJson AsyncProgress where
  decodeJson json = do
    obj <- decodeJson json
-    id <- obj .: "id"
+    id  <- obj .: "id"
    log <- obj .: "log"
    status <- obj .: "status"
    pure $ AsyncProgress {id, log, status}

-newtype AsyncTaskLog = AsyncTaskLog {
-    events :: Array String
-  , failed :: Int
-  , remaining :: Int
-  , succeeded :: Int
-  }
+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