Merge branch 'dev' of ssh://gitlab.iscpif.fr:20022/gargantext/purescript-gargantext into dev

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

src/Gargantext/Components/Forest/Tree.purs

@@ -16,7 +16,8 @@ import Record as Record
 import Record.Extra as RecordE
 
 import Gargantext.AsyncTasks as GAT
-import Gargantext.Components.Forest.Tree.Node.Action (Action(..), CreateValue(..), FTree, ID, LNode(..), NTree(..), Reload, RenameValue(..), Tree, createNode, deleteNode, loadNode, renameNode)
+import Gargantext.Components.Forest.Tree.Node.Action (Action(..), FTree, ID, LNode(..), NTree(..), Reload, RenameValue(..), Tree, deleteNode, loadNode, renameNode)
+import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
 import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile)
 import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan, Tasks, tasksStruct)
 import Gargantext.Ends (Frontends)
@@ -26,6 +27,8 @@ import Gargantext.Routes (AppRoute)
 import Gargantext.Sessions (OpenNodes, Session, mkNodeId)
 import Gargantext.Types as GT
 
+------------------------------------------------------------------------
+
 type CommonProps =
   ( frontends     :: Frontends
   , mCurrentRoute :: Maybe AppRoute
@@ -42,23 +45,33 @@ 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, asyncTasks, mCurrentRoute, session, frontends, openNodes, reload } _children = do
-      let fetch _ = loadNode session root
-      let paint loaded = loadedTreeView {
-                                          asyncTasks
-                                        , frontends
-                                        , mCurrentRoute
-                                        , openNodes
-                                        , reload
-                                        , session
-                                        , tasks: tasksStruct root asyncTasks reload
-                                        , tree: loaded
-                                        }
-      useLoader { root, counter: fst reload } fetch paint
+    treeViewCpt :: R.Component Props
+    treeViewCpt = R.hooksComponent "G.C.Tree.treeView" cpt
+      where
+        cpt { root, mCurrentRoute, session, frontends, openNodes, reload, asyncTasks} _children = do
+          pure $ treeLoadView
+            { root, mCurrentRoute, session, frontends, openNodes, reload, asyncTasks}
+
+treeLoadView :: Record Props -> R.Element
+treeLoadView p = R.createElement treeLoadViewCpt p []
+  where
+    treeLoadViewCpt :: R.Component Props
+    treeLoadViewCpt = R.hooksComponent "TreeLoadView" cpt
+      where
+        cpt { root, asyncTasks, mCurrentRoute, session, frontends, openNodes, reload } _children = do
+          let fetch _ = loadNode session root
+          let paint loaded = loadedTreeView {
+                                              asyncTasks
+                                            , frontends
+                                            , mCurrentRoute
+                                            , openNodes
+                                            , reload
+                                            , session
+                                            , tasks: tasksStruct root asyncTasks reload
+                                            , tree: loaded
+                                            }
+          useLoader { root, counter: fst reload } fetch paint
 
 type TreeViewProps = ( asyncTasks    :: R.State GAT.Storage
                      , tree          :: FTree
@@ -66,19 +79,17 @@ type TreeViewProps = ( asyncTasks    :: R.State GAT.Storage
                      | 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 { asyncTasks, frontends, mCurrentRoute, openNodes, reload, tasks, tree, session } _ = do
-      pure $ H.div {className: "tree"}
-        [ toHtml { asyncTasks, frontends, mCurrentRoute, openNodes, reload, session, tasks, tree } ]
+    loadedTreeViewCpt :: R.Component TreeViewProps
+    loadedTreeViewCpt = R.hooksComponent "LoadedTreeView" cpt
+      where
+        cpt { asyncTasks, frontends, mCurrentRoute, openNodes, reload, tasks, tree, session } _ = do
+          pure $ H.div {className: "tree"}
+            [ toHtml { asyncTasks, frontends, mCurrentRoute, openNodes, reload, session, tasks, tree } ]
 
 ------------------------------------------------------------------------
-
 type ToHtmlProps =
   (
     asyncTasks :: R.State GAT.Storage
@@ -131,14 +142,12 @@ toHtml p@{ asyncTasks
 
 
 type ChildNodesProps =
-  (
-      asyncTasks :: R.State GAT.Storage
-    , children :: Array FTree
-    , folderOpen :: R.State Boolean
-    | CommonProps
+  ( asyncTasks :: R.State GAT.Storage
+  , children :: Array FTree
+  , folderOpen :: R.State Boolean
+  | CommonProps
   )
 
-
 childNodes :: Record ChildNodesProps -> Array R.Element
 childNodes { children: [] } = []
 childNodes { folderOpen: (false /\ _) } = []
@@ -181,6 +190,14 @@ performAction { reload: (_ /\ setReload)
   liftEffect $ onTaskAdd task
   liftEffect $ log2 "[performAction] SearchQuery task:" task
 
+performAction { reload: (_ /\ setReload)
+              , session
+              , tasks: {onTaskAdd}
+              , tree: (NTree (LNode {id}) _) } (UpdateNode task) = do
+  liftEffect $ onTaskAdd task
+  liftEffect $ log2 "[performAction] UpdateNode task:" task
+
+
 performAction p@{ reload: (_ /\ setReload)
                 , session
                 , tree: (NTree (LNode {id}) _) } (Submit name)  = do
@@ -191,7 +208,7 @@ performAction p@{ openNodes: (_ /\ setOpenNodes)
                 , reload:    (_ /\ setReload)
                 , session
                 , tree: (NTree (LNode {id}) _) } (CreateSubmit name nodeType) = do
-  task <- createNode session id $ CreateValue {name, nodeType}
+  task <- addNode session id $ AddNodeValue {name, nodeType}
   liftEffect do
     setOpenNodes (Set.insert (mkNodeId session id))
   performAction p RefreshTree

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
 
@@ -42,11 +43,12 @@ readFileType "PresseRIS" = Just PresseRIS
 readFileType "WOS"       = Just WOS
 readFileType _           = Nothing
 
-data DroppedFile = DroppedFile {
-    contents :: UploadFileContents
-  , fileType :: Maybe FileType
-  , lang     :: Maybe Lang
-    }
+data DroppedFile =
+  DroppedFile { contents :: UploadFileContents
+              , fileType :: Maybe FileType
+              , lang     :: Maybe Lang
+              }
+
 type FileHash = String
 
 type Name = String
@@ -54,23 +56,12 @@ type ID   = Int
 type Reload = Int
 
 newtype UploadFileContents = UploadFileContents String
-type UploadFile = {
-    contents :: UploadFileContents
+type UploadFile = 
+  { contents :: UploadFileContents
   , name     :: String
   }
 
-createNode :: Session -> ID -> CreateValue -> Aff (Array ID)
-createNode session parentId = post session $ NodeAPI GT.Node (Just parentId) ""
 
-createNodeAsync :: Session
-                -> ID
-                -> CreateValue
-                -> Aff GT.AsyncTaskWithType
-createNodeAsync session parentId q = do
-  task <- post session p q
-  pure $ GT.AsyncTaskWithType {task, typ: GT.CreateNode}
-  where
-    p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.CreateNode)
 
 renameNode :: Session -> ID -> RenameValue -> Aff (Array ID)
 renameNode session renameNodeId = put session $ NodeAPI GT.Node (Just renameNodeId) "rename"
@@ -81,32 +72,47 @@ 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
   encodeJson (RenameValue {name})
      = "r_name" := name
     ~> jsonEmptyObject
 
-newtype CreateValue = CreateValue
-  {
-    name :: Name
-  , nodeType :: GT.NodeType
-  }
+-----------------------------------------------------------------------
+-----------------------------------------------------------------------
+data UpdateNodeParams = UpdateNodeParamsList { method :: Int }
+                      | UpdateNodeParamsGraph { method :: String }
+                      | UpdateNodeParamsTexts { method :: Int }
+
+instance encodeJsonUpdateNodeParams :: EncodeJson UpdateNodeParams
+  where
+    encodeJson (UpdateNodeParamsList { method })
+      = "method" := method
+      ~> jsonEmptyObject
+    encodeJson (UpdateNodeParamsGraph { method })
+      = "method" := method
+      ~> jsonEmptyObject
+    encodeJson (UpdateNodeParamsTexts { method })
+      = "method" := method
+      ~> jsonEmptyObject
+
+
+-----------------------------------------------------------------------
 
-instance encodeJsonCreateValue :: EncodeJson CreateValue where
-  encodeJson (CreateValue {name, nodeType})
-     = "pn_name"     := name
-    ~> "pn_typename" := nodeType
-    ~> jsonEmptyObject
 
 data NTree a = NTree a (Array (NTree a))
 type FTree = NTree LNode
-type Tree = { tree :: FTree, asyncTasks :: Array GT.AsyncTaskWithType }
+type Tree = { tree       :: FTree
+            , asyncTasks :: Array GT.AsyncTaskWithType
+            }
 
 instance ntreeFunctor :: Functor NTree where
   map f (NTree x ary) = NTree (f x) (map (map f) ary)
@@ -126,7 +132,8 @@ instance decodeJsonLNode :: DecodeJson LNode where
     nodeType <- obj .: "type"
     pure $ LNode { id : id_
                  , name
-                 , nodeType}
+                 , nodeType
+                 }
 
 instance decodeJsonFTree :: DecodeJson (NTree LNode) where
   decodeJson json = do

src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs

 module Gargantext.Components.Forest.Tree.Node.Action.Add where
 
 import Data.Array (length, head)
+import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
 import Data.Maybe (Maybe(..), fromMaybe)
 -- import Data.Newtype (class Newtype)
 import Data.Tuple.Nested ((/\))
@@ -10,29 +11,58 @@ import Gargantext.Components.Forest.Tree.Node.Action (Action(..), ID, Name)
 import Gargantext.Components.Forest.Tree.Node (SettingsBox(..), settingsBox)
 import Gargantext.Types (NodeType(..), readNodeType)
 import Gargantext.Utils.Reactix as R2
+import Gargantext.Sessions (Session, post)
+import Gargantext.Routes as GR
+import Gargantext.Types  as GT
 import Prelude (Unit, bind, const, discard, map, pure, show, ($), (<>), (>), (<<<))
 import Reactix as R
 import Reactix.DOM.HTML as H
 
 -- START Create Node
 
-type Dispatch = Action -> Aff Unit
+addNode :: Session -> ID -> AddNodeValue -> Aff (Array ID)
+addNode session parentId = post session $ GR.NodeAPI GT.Node (Just parentId) ""
+
+addNodeAsync :: Session
+                -> ID
+                -> AddNodeValue
+                -> Aff GT.AsyncTaskWithType
+addNodeAsync session parentId q = do
+  task <- post session p q
+  pure $ GT.AsyncTaskWithType {task, typ: GT.AddNode}
+  where
+    p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.AddNode)
+
+----------------------------------------------------------------------
+newtype AddNodeValue = AddNodeValue
+  { name     :: Name
+  , nodeType :: GT.NodeType
+  }
+
+instance encodeJsonAddNodeValue :: EncodeJson AddNodeValue where
+  encodeJson (AddNodeValue {name, nodeType})
+     = "pn_name"     := name
+    ~> "pn_typename" := nodeType
+    ~> jsonEmptyObject
 
+----------------------------------------------------------------------
+
+type Dispatch = Action -> Aff Unit
 data NodePopup = CreatePopup | NodePopup
 
 type CreateNodeProps =
   ( id       :: ID
-  , dispatch :: Dispatch
+  , dispatch :: Action -> Aff Unit
   , name     :: Name
   , nodeType :: NodeType
   , nodeTypes :: Array NodeType
   )
 
-createNodeView :: Record CreateNodeProps
+addNodeView :: Record CreateNodeProps
                -> R.Element
-createNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
+addNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
   where
-    el = R.hooksComponent "CreateNodeView" cpt
+    el = R.hooksComponent "AddNodeView" cpt
     cpt {id, name} _ = do
       nodeName <- R.useState' "Name"
       nodeType' <- R.useState' $ fromMaybe NodeUser $ head nodeTypes
@@ -103,7 +133,6 @@ createNodeView p@{ dispatch, nodeType, nodeTypes } = R.createElement el p []
 
 -- END Create Node
 
-
 showConfig :: NodeType -> R.Element
 showConfig NodeUser      = H.div {} []
 showConfig FolderPrivate = H.div {} [H.text "This folder will be private only"]
@@ -111,4 +140,3 @@ showConfig FolderShared  = H.div {} [H.text "This folder will be shared"]
 showConfig FolderPublic  = H.div {} [H.text "This folder will be public"]
 showConfig nt            = H.div {} [H.h4  {} [H.text $ "Config of " <> show nt ]]
 
-

src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs

@@ -31,9 +31,9 @@ type Dispatch = Action -> Aff Unit
 
 type Props =
   ( dispatch :: Dispatch
-  , id :: Int
+  , id       :: Int
   , nodeType :: GT.NodeType
-  , session :: Session
+  , session  :: Session
   )
 
 
@@ -110,8 +110,7 @@ uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt
 
 
 type UploadButtonProps =
-  (
-    dispatch :: Dispatch
+  ( dispatch :: Dispatch
   , fileType :: R.State FileType
   , id :: Int
   , lang :: R.State (Maybe Lang)
@@ -285,8 +284,7 @@ uploadTermListViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadTermListView" cpt
 
 
 type UploadTermButtonProps =
-  (
-    dispatch :: Dispatch
+  ( dispatch :: Dispatch
   , id       :: Int
   , mFile    :: R.State (Maybe UploadFile)
   , nodeType :: GT.NodeType
@@ -324,9 +322,8 @@ copyFromCorpusViewCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusView" cpt
           copyFromCorpusViewLoaded {dispatch, id, nodeType, session, tree}
 
 type CorpusTreeProps =
-  (
-    tree :: FTree
-    | Props
+  ( tree :: FTree
+  | Props
   )
 
 copyFromCorpusViewLoaded :: Record CorpusTreeProps -> R.Element

src/Gargantext/Components/Forest/Tree/Node/Box.purs

@@ -28,7 +28,7 @@ import Gargantext.Prelude
 import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.Forest.Tree.Node (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox)
 import Gargantext.Components.Forest.Tree.Node.Action (Action(..), DroppedFile(..), FileType(..), ID, Name, Reload, UploadFileContents(..))
-import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), createNodeView)
+import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), addNodeView)
 import Gargantext.Components.Forest.Tree.Node.Action.Rename (renameBox)
 import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFileView, fileTypeView, uploadTermListView, copyFromCorpusView)
 import Gargantext.Components.Forest.Tree.Node.ProgressBar (asyncProgressBar, BarType(..))
@@ -539,7 +539,6 @@ type NodeProps =
   , nodeType :: GT.NodeType
   )
 
-type Open = Boolean
 
 type PanelActionProps =
   ( id       :: ID
@@ -564,7 +563,7 @@ panelActionCpt = R.hooksComponent "G.C.F.T.N.B.panelAction" cpt
     cpt {action: Delete, nodeType, dispatch}              _ = actionDelete   nodeType dispatch
 
     cpt {action: Add xs, dispatch, id, name, nodePopup: p, nodeType} _ = do
-      pure $ createNodeView {dispatch, id, name, nodeType, nodeTypes: xs}
+      pure $ addNodeView {dispatch, id, name, nodeType, nodeTypes: xs}
 
     cpt {action: CopyFromCorpus, dispatch, id, nodeType, session} _ = do
       pure $ copyFromCorpusView {dispatch, id, nodeType, session}
@@ -589,7 +588,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

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

@@ -463,7 +463,10 @@ modeFromString _ = Nothing
 -- Async tasks
 
 -- corresponds to /add/form/async or /add/query/async
-data AsyncTaskType = Form | GraphT | Query | CreateNode
+data AsyncTaskType = Form
+                   | GraphT
+                   | Query
+                   | AddNode
 derive instance genericAsyncTaskType :: Generic AsyncTaskType _
 instance eqAsyncTaskType :: Eq AsyncTaskType where
   eq = genericEq
@@ -478,14 +481,14 @@ instance decodeJsonAsyncTaskType :: DecodeJson AsyncTaskType where
       "Form"       -> pure Form
       "GraphT"     -> pure GraphT
       "Query"      -> pure Query
-      "CreateNode" -> pure CreateNode
+      "AddNode"    -> pure AddNode
       s            -> Left ("Unknown string " <> s)
 
 asyncTaskTypePath :: AsyncTaskType -> String
 asyncTaskTypePath Form   = "add/form/async/"
 asyncTaskTypePath Query  = "query/"
 asyncTaskTypePath GraphT = "async/"
-asyncTaskTypePath CreateNode = "async/nobody/"
+asyncTaskTypePath AddNode = "async/nobody/"
 
 type AsyncTaskID = String