Merge branch 'dev-tree-reload' of...

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

src/Gargantext/Components/Forest.purs

@@ -85,7 +85,7 @@ forestCpt = R.hooksComponentWithModule thisModule "forest" cpt where
                  , reload
                  , root: treeId
                  , session: s
-                 }
+                 } []
 
 plus :: Handed -> R.Setter Boolean -> R.State (Maybe Backend) -> R.Element
 plus handed showLogin backend = H.div { className: handedClass } [

src/Gargantext/Components/Forest/Tree.purs

@@ -13,8 +13,10 @@ import Reactix.DOM.HTML as H
 import Record as Record
 import Record.Extra as RecordE
 
+import Gargantext.Prelude
+
 import Gargantext.AsyncTasks as GAT
-import Gargantext.Components.Forest.Tree.Node (nodeMainSpan)
+import Gargantext.Components.Forest.Tree.Node (nodeSpan)
 import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
 import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
 import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
@@ -28,9 +30,8 @@ import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact
 import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest)
 import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile, uploadArbitraryFile)
 import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
-import Gargantext.Ends (Frontends)
+import Gargantext.Ends (Frontends, toUrl)
 import Gargantext.Hooks.Loader (useLoader)
-import Gargantext.Prelude (Unit, bind, discard, map, pure, void, ($), (+), (<>), (==), (<<<), not)
 import Gargantext.Routes (AppRoute)
 import Gargantext.Routes as GR
 import Gargantext.Sessions (OpenNodes, Session, mkNodeId, get)
@@ -58,12 +59,12 @@ type Props = (
   | CommonProps
   )
 
-treeView :: Record Props -> R.Element
-treeView props = R.createElement treeViewCpt props []
-  where
-    treeViewCpt :: R.Component Props
-    treeViewCpt = R.hooksComponentWithModule thisModule "treeView" cpt
+treeView :: R2.Component Props
+treeView = R.createElement elCpt
   where
+    elCpt :: R.Component Props
+    elCpt = R.hooksComponentWithModule thisModule "treeView" cpt
+
     cpt { asyncTasks
         , frontends
         , handed
@@ -81,14 +82,14 @@ treeView props = R.createElement treeViewCpt props []
                           , reload
                           , root
                           , session
-                              }
+                          } []
 
-treeLoadView :: Record Props -> R.Element
-treeLoadView p = R.createElement treeLoadViewCpt p []
-  where
-    treeLoadViewCpt :: R.Component Props
-    treeLoadViewCpt = R.hooksComponentWithModule thisModule "treeLoadView" cpt
+treeLoadView :: R2.Component Props
+treeLoadView = R.createElement elCpt
   where
+    elCpt :: R.Component Props
+    elCpt = R.hooksComponentWithModule thisModule "treeLoadView" cpt
+
     cpt { asyncTasks
         , frontends
         , handed
@@ -99,7 +100,17 @@ treeLoadView p = R.createElement treeLoadViewCpt p []
         , session
         } _children = do
       let fetch _ = getNodeTree session root
-          let paint loaded = loadedTreeView { asyncTasks
+      -- let paint loaded = loadedTreeView { asyncTasks
+      --                                   , frontends
+      --                                   , handed
+      --                                   , mCurrentRoute
+      --                                   , openNodes
+      --                                   , reload
+      --                                   , session
+      --                                   -- , tasks: tasksStruct root asyncTasks reload
+      --                                   , tree: loaded
+      --                                   } []
+      let paint loaded = loadedTreeViewFirstLevel { asyncTasks
                                                   , frontends
                                                   , handed
                                                   , mCurrentRoute
@@ -108,13 +119,15 @@ treeLoadView p = R.createElement treeLoadViewCpt p []
                                                   , session
                                                   -- , tasks: tasksStruct root asyncTasks reload
                                                   , tree: loaded
-                                            }
+                                                  } []
       useLoader { root, counter: fst reload } fetch paint
 
 --------------
 getNodeTree :: Session -> GT.ID -> Aff FTree
 getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) ""
-
+--------------
+getNodeTreeFirstLevel :: Session -> GT.ID -> Aff FTree
+getNodeTreeFirstLevel session nodeId = get session $ GR.TreeFirstLevel (Just nodeId) ""
 --------------
 type TreeViewProps = (
     asyncTasks :: GAT.Reductor
@@ -122,12 +135,12 @@ type TreeViewProps = (
   | CommonProps
   )
 
-loadedTreeView :: Record TreeViewProps -> R.Element
-loadedTreeView p = R.createElement loadedTreeViewCpt p []
-  where
-    loadedTreeViewCpt :: R.Component TreeViewProps
-    loadedTreeViewCpt = R.hooksComponentWithModule thisModule "loadedTreeView" cpt
+loadedTreeView :: R2.Component TreeViewProps
+loadedTreeView = R.createElement elCpt
   where
+    elCpt :: R.Component TreeViewProps
+    elCpt = R.hooksComponentWithModule thisModule "loadedTreeView" cpt
+
     cpt { asyncTasks
         , frontends
         , handed
@@ -149,7 +162,38 @@ loadedTreeView p = R.createElement loadedTreeViewCpt p []
                  , session
                    -- , tasks
                  , tree
-                      }
+                 } []
+            ]
+        ]
+
+loadedTreeViewFirstLevel :: R2.Component TreeViewProps
+loadedTreeViewFirstLevel = R.createElement elCpt
+  where
+    elCpt :: R.Component TreeViewProps
+    elCpt = R.hooksComponentWithModule thisModule "loadedTreeViewFirstLevel" cpt
+
+    cpt { asyncTasks
+        , frontends
+        , handed
+        , mCurrentRoute
+        , openNodes
+        , reload
+        , session
+        -- , tasks
+        , tree
+      } _ = do
+      pure $ H.ul { className: "tree" } [
+        H.div { className: if handed == GT.RightHanded then "righthanded" else "lefthanded" } [
+          toHtmlFirstLevel { asyncTasks
+                           , frontends
+                           , handed
+                           , mCurrentRoute
+                           , openNodes
+                           , reload
+                           , session
+                             -- , tasks
+                           , tree
+                           } []
             ]
         ]
 
@@ -163,12 +207,12 @@ type ToHtmlProps = (
   | CommonProps
   )
 
-toHtml :: Record ToHtmlProps -> R.Element
-toHtml p = R.createElement toHtmlCpt p []
-
-toHtmlCpt :: R.Component ToHtmlProps
-toHtmlCpt = R.hooksComponentWithModule thisModule "nodeView" cpt
+toHtml :: R2.Component ToHtmlProps
+toHtml = R.createElement elCpt
   where
+    elCpt :: R.Component ToHtmlProps
+    elCpt = R.hooksComponentWithModule thisModule "toHtml" cpt
+
     cpt p@{ asyncTasks
           , frontends
           , handed
@@ -194,8 +238,14 @@ toHtmlCpt = R.hooksComponentWithModule thisModule "nodeView" cpt
 
       let withId (NTree (LNode {id: id'}) _) = id'
 
-        pure $ H.li { className: if A.null ary then "no-children" else "with-children" } $
-          [ nodeMainSpan { appReload: reload
+      let publicizedChildren = if isPublic nodeType
+                              then map (\t -> map (\(LNode n@{ nodeType: nt } )
+                                                    -> (LNode (n { nodeType = publicize nt }))
+                                                  ) t) ary
+                              else ary
+
+      pure $ H.li { className: if A.null ary then "no-children" else "with-children" }
+        [ nodeSpan { appReload: reload
                   , asyncTasks
                   , dispatch: pAction
                   , folderOpen
@@ -208,18 +258,98 @@ toHtmlCpt = R.hooksComponentWithModule thisModule "nodeView" cpt
                   , nodeType
                   , session
                   -- , tasks
-                         } ]
-          <> childNodes ( Record.merge commonProps
+                  }
+            (
+              childNodes ( Record.merge commonProps
                           { asyncTasks
-                          , children: if isPublic nodeType
+                          , children: publicizedChildren
+                          , folderOpen
+                          , handed
+                          }
+                        )
+            )
+        ]
+
+toHtmlFirstLevel :: R2.Component ToHtmlProps
+toHtmlFirstLevel = R.createElement elCpt
+  where
+    elCpt :: R.Component ToHtmlProps
+    elCpt = R.hooksComponentWithModule thisModule "toHtmlFirstLevel" cpt
+
+    cpt p@{ asyncTasks
+          , frontends
+          , handed
+          , mCurrentRoute
+          , openNodes
+          , reload: reload@(_ /\ setReload)
+          , session
+          , tree: tree@(NTree (LNode { id
+                                      , name
+                                      , nodeType
+                                      }
+                              ) ary
+                        )
+          } _ = do
+      let pAction a   = performAction a (RecordE.pick p :: Record PerformActionProps)
+
+      let nodeId               = mkNodeId session id
+      let folderIsOpen         = Set.member nodeId (fst openNodes)
+      let setFn                = if folderIsOpen then Set.delete else Set.insert
+      let toggleFolderIsOpen _ = (snd openNodes) (setFn nodeId)
+      let folderOpen           = Tuple folderIsOpen toggleFolderIsOpen
+
+      let withId (NTree (LNode {id: id'}) _) = id'
+
+      pure $ H.li { className: if A.null ary then "no-children" else "with-children" } $
+        [ nodeSpan { appReload: reload
+                    , asyncTasks
+                    , dispatch: pAction
+                    , folderOpen
+                    , frontends
+                    , handed
+                    , id
+                    , isLeaf: A.null ary
+                    , mCurrentRoute
+                    , name
+                    , nodeType
+                    , session
+                    -- , tasks
+                    }
+          $ renderChildren folderOpen publicizedChildren
+        ]
+      where
+        commonProps = RecordE.pick p :: Record CommonProps
+
+        publicizedChildren = if isPublic nodeType
                               then map (\t -> map (\(LNode n@{ nodeType:nt } )
-                                                               -> (LNode (n { nodeType= publicize nt }))
+                                                  -> (LNode (n { nodeType = publicize nt }))
                                                   ) t) ary
                               else ary
+
+        renderChildren (false /\ _) _ = []
+        renderChildren folderOpen@(true /\ _) cs =
+          (
+            map (\t@(NTree (LNode {id: cId}) _) ->
+                  childNodeFirstLevel ( Record.merge commonProps
+                                        { asyncTasks
                                         , folderOpen
                                         , handed
+                                        , id: cId
                                         }
+                                      ) []
+                ) publicizedChildren
           )
+          -- childNodesFirstLevel ( Record.merge commonProps
+          --                        { asyncTasks
+          --                        , children: if isPublic nodeType
+          --                                        then map (\t -> map (\(LNode n@{ nodeType:nt } )
+          --                                                              -> (LNode (n { nodeType= publicize nt }))
+          --                                                          ) t) ary
+          --                                        else ary
+          --                        , folderOpen
+          --                        , handed
+          --                        }
+          --                      )
 
 
 type ChildNodesProps =
@@ -239,13 +369,79 @@ childNodes props@{ asyncTasks, children, reload, handed } =
                                          -- , tasks: tasksStruct id asyncTasks reload
                                          , tree: ctree
                                          }
-               )]
+               ) []
+        ]
       ) $ sorted children
   where
     commonProps = RecordE.pick props :: Record CommonProps
     sorted :: Array FTree -> Array FTree
     sorted = A.sortWith (\(NTree (LNode {id}) _) -> id)
 
+type ChildNodeFirstLevelProps = (
+    asyncTasks :: GAT.Reductor
+  , folderOpen :: R.State Boolean
+  , id         :: ID
+  | CommonProps
+  )
+
+childNodeFirstLevel :: R2.Component ChildNodeFirstLevelProps
+childNodeFirstLevel = R.createElement elCpt
+  where
+    elCpt :: R.Component ChildNodeFirstLevelProps
+    elCpt = R.hooksComponentWithModule thisModule "childNodeFirstLevel" cpt
+
+    cpt props@{ asyncTasks, folderOpen, id, frontends, handed, mCurrentRoute, openNodes, reload, session } _ = do
+      cptReload <- R.useState' 0
+
+      let fetch _ = getNodeTreeFirstLevel session id
+      let paint loaded = childNodeFirstLevelPaint { asyncTasks
+                                                  , folderOpen
+                                                  , frontends
+                                                  , handed
+                                                  , mCurrentRoute
+                                                  , openNodes
+                                                  , reload: cptReload
+                                                  , session
+                                                  , tree: loaded } []
+
+      useLoader { counter: fst cptReload, root: id } fetch paint
+
+
+type ChildNodeFirstLevelPaintProps = (
+    asyncTasks :: GAT.Reductor
+  , folderOpen :: R.State Boolean
+  , tree       :: FTree
+  | CommonProps
+  )
+
+childNodeFirstLevelPaint :: R2.Component ChildNodeFirstLevelPaintProps
+childNodeFirstLevelPaint = R.createElement elCpt
+  where
+    elCpt :: R.Component ChildNodeFirstLevelPaintProps
+    elCpt = R.hooksComponentWithModule thisModule "childNodeFirstLevelPaint" cpt
+
+    cpt props@{ asyncTasks, handed, folderOpen: (false /\ _), reload, tree: ctree@(NTree (LNode { id }) _) } _ = do
+      pure $ H.ul {} [
+        toHtmlFirstLevel (Record.merge commonProps { asyncTasks
+                                                   , handed
+                                                   , tree: ctree }
+                        ) []
+        ]
+      -- pure $ H.div { } [ H.text $ "[closed] Node id " <> show id ]
+      where
+        commonProps = RecordE.pick props :: Record CommonProps
+    cpt props@{ asyncTasks, handed, folderOpen: (true /\ _), reload, tree: ctree@(NTree (LNode { id }) _) } _ = do
+      pure $ H.ul {} [
+        toHtmlFirstLevel (Record.merge commonProps { asyncTasks
+                                                   , handed
+                                                   , tree: ctree }
+                        ) []
+        ]
+      -- pure $ H.div { } [ H.text $ "[opened] Node id " <> show id ]
+      where
+        commonProps = RecordE.pick props :: Record CommonProps
+
+
 type PerformActionProps =
   ( asyncTasks :: GAT.Reductor
   , openNodes :: R.State OpenNodes

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

@@ -56,9 +56,17 @@ type NodeMainSpanProps = (
 
 type IsLeaf = Boolean
 
-nodeMainSpan :: Record NodeMainSpanProps
-            -> R.Element
-nodeMainSpan p = R.createElement nodeMainSpanCpt p []
+nodeSpan :: R2.Component NodeMainSpanProps
+nodeSpan = R.createElement nodeSpanCpt
+
+nodeSpanCpt :: R.Component NodeMainSpanProps
+nodeSpanCpt = R.hooksComponentWithModule thisModule "nodeSpan" cpt
+  where
+    cpt props children = do
+      pure $ H.div {} ([ nodeMainSpan props [] ] <> children)
+
+nodeMainSpan :: R2.Component NodeMainSpanProps
+nodeMainSpan = R.createElement nodeMainSpanCpt
 
 nodeMainSpanCpt :: R.Component NodeMainSpanProps
 nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt
@@ -155,15 +163,12 @@ nodeMainSpanCpt = R.hooksComponentWithModule thisModule "nodeMainSpan" cpt
                                               , session
                                               }
 
-    chevronIcon isLeaf handed' nodeType (open /\ setOpen) =
-      if isLeaf
-         then H.div {} []
-         else
+    chevronIcon true handed' nodeType (open /\ setOpen) = H.div {} []
+    chevronIcon false handed' nodeType (open /\ setOpen) =
       H.a { className: "chevron-icon"
           , on: { click: \_ -> setOpen $ not }
           }
-               [ H.i {
-                    className: if open
+        [ H.i { className: if open
                            then "fa fa-chevron-down"
                            else if handed' == GT.RightHanded
                                    then "fa fa-chevron-right"

src/Gargantext/Ends.purs

@@ -172,6 +172,8 @@ sessionPath (R.PostNgramsChartsAsync i) =
 sessionPath (R.NodeAPI nt i p) = nodeTypePath nt
                               <> (maybe "" (\i' -> "/" <> show i') i)
                               <> (if p == "" then "" else "/" <> p)
+sessionPath (R.TreeFirstLevel nId p) = nodeTypePath Tree
+                                    <> (maybe "" (\nId' -> "/" <> show nId') nId) <> "/first-level" <> p
 sessionPath (R.Search {listId, limit, offset, orderBy} Nothing) =
   sessionPath $ R.NodeAPI Corpus Nothing
      $ "search?list_id=" <> show listId

src/Gargantext/Routes.purs

@@ -50,6 +50,7 @@ data SessionRoute
   | RecomputeNgrams   (TabSubType CTabNgramType) Id ListId
   | RecomputeListChart ChartType  CTabNgramType  Id ListId
   | NodeAPI       NodeType (Maybe Id) String
+  | TreeFirstLevel (Maybe Id) String
   | GraphAPI      Id String
   | ListsRoute    ListId
   | ListDocument (Maybe ListId) (Maybe Id)