[FrameWrite Analysis] Node selection

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

@@ -7,8 +7,9 @@ import Gargantext.Components.Forest.Tree.Node.Action.Update.Types (UpdateNodePar
 import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileFormat, FileType, UploadFileBlob)
 import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut)
 import Gargantext.Components.Lang (Lang(..))
-import Gargantext.Components.ListSelection.Types (Selection)
 import Gargantext.Prelude
+import Gargantext.Components.ListSelection.Types as ListSelection
+import Gargantext.Components.NodeSelection.Types as NodeSelection
 import Gargantext.Types as GT
 
 data Action = AddNode     String GT.NodeType
@@ -16,9 +17,9 @@ data Action = AddNode     String GT.NodeType
             | RenameNode  String
             | UpdateNode  UpdateNodeParams
             | DoSearch    GT.AsyncTaskWithType
-            | UploadFile  GT.NodeType FileType FileFormat Lang (Maybe String) String Selection
-            | UploadArbitraryFile FileFormat (Maybe String) UploadFileBlob Selection
-            | UploadFrameCalc Lang Selection
+            | UploadFile  GT.NodeType FileType FileFormat Lang (Maybe String) String ListSelection.Selection
+            | UploadArbitraryFile FileFormat (Maybe String) UploadFileBlob ListSelection.Selection
+            | UploadFrameCalc Lang ListSelection.Selection
             | DownloadNode
             | RefreshTree
             | CloseBox
@@ -30,7 +31,7 @@ data Action = AddNode     String GT.NodeType
             | MergeNode   {params :: Maybe SubTreeOut}
             | LinkNode    {nodeType :: Maybe GT.NodeType, params :: Maybe SubTreeOut}
 
-            | DocumentsFromWriteNodes { id :: GT.ID, lang :: Lang, selection :: Selection, paragraphs :: Int }
+            | DocumentsFromWriteNodes { id :: GT.ID, lang :: Lang, listSelection :: ListSelection.Selection, nodeSelection :: NodeSelection.Selection, paragraphs :: Int, recursive :: Boolean}
 
             | NoAction
 

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

@@ -9,11 +9,14 @@ import Data.Tuple.Nested ((/\))
 import Effect.Aff (Aff)
 import Gargantext.Components.App.Store (Boxes)
 import Gargantext.Components.Bootstrap as B
+import Gargantext.Components.Bootstrap.Types (ComponentStatus(..))
 import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
 import Gargantext.Components.Forest.Tree.Node.Tools (panel, submitButton)
 import Gargantext.Components.Lang (Lang(..))
 import Gargantext.Components.ListSelection as ListSelection
 import Gargantext.Components.ListSelection.Types as ListSelection
+import Gargantext.Components.NodeSelection as NodeSelection
+import Gargantext.Components.NodeSelection.Types as NodeSelection
 import Gargantext.Config.REST (AffRESTError, RESTError)
 import Gargantext.Routes (SessionRoute(..))
 import Gargantext.Sessions (Session, post)
@@ -42,10 +45,14 @@ actionWriteNodesDocumentsCpt = here.component "actionWriteNodesDocuments" cpt wh
 
     lang' /\ langBox
         <- R2.useBox' EN
-    selection' /\ selectionBox
+    listSelection' /\ listSelectionBox
         <- R2.useBox' ListSelection.MyListsFirst
+    nodeSelection' /\ nodeSelectionBox
+        <- R2.useBox' NodeSelection.ChildNodes
     paragraphs' /\ paragraphBox
         <- R2.useBox' "7"
+    recursive' /\ recursiveBox
+        <- R2.useBox' false
     
     let bodies = [
       H.div
@@ -98,7 +105,7 @@ actionWriteNodesDocumentsCpt = here.component "actionWriteNodesDocuments" cpt wh
         ]
       ]
     ,
-      --selection
+      -- list selection
       H.div
       { className: "form-group" }
       [
@@ -113,21 +120,71 @@ actionWriteNodesDocumentsCpt = here.component "actionWriteNodesDocuments" cpt wh
         { className: "form-group__field" }
         [
           ListSelection.selection
-          { selection: selectionBox
+          { selection: listSelectionBox
           , session
           } []
         ]
       ]
+    ,
+      -- node selection
+      H.div
+      { className: "form-group" }
+      [
+        H.div
+        { className: "form-group__label" }
+        [
+          B.label_ $
+            "Node selection"
+        ]
+      ,
+        H.div
+        { className: "form-group__field" }
+        [
+          NodeSelection.selection
+          { selection: nodeSelectionBox
+          , session
+          } []
+        ]
+      ]
+    ,
+      -- recursive
+      H.div
+      { className: "form-group" }
+      [
+        H.div
+        { className: "form-group__label" }
+        [
+          B.label_ $
+            "Recursive selection"
+        ]
+      ,
+        H.div
+        { className: "form-group__field" }
+        [
+          B.formCheckbox
+          { callback: flip T.write_ recursiveBox
+          , value: recursive'
+          , status: if nodeSelection' == NodeSelection.ChildNodes then Disabled else Enabled
+          }
+        ]
+      ]
     ]
 
-    pure $ panel bodies (submitButton (DocumentsFromWriteNodes { id, lang: lang', selection: selection', paragraphs: fromMaybe 7 $ fromString paragraphs' }) dispatch)
+    pure $ panel bodies (submitButton (DocumentsFromWriteNodes { id
+                                                               , lang: lang'
+                                                               , listSelection: listSelection'
+                                                               , nodeSelection: nodeSelection'
+                                                               , paragraphs: fromMaybe 7 $ fromString paragraphs'
+                                                               , recursive: recursive' }) dispatch)
 
 
 type Params =
-  ( id         :: GT.ID
-  , selection  :: ListSelection.Selection
-  , lang       :: Lang
-  , paragraphs :: Int
+  ( id            :: GT.ID
+  , listSelection :: ListSelection.Selection
+  , nodeSelection :: NodeSelection.Selection
+  , lang          :: Lang
+  , paragraphs    :: Int
+  , recursive     :: Boolean
   )
 
 documentsFromWriteNodesReq :: Session -> Record Params -> AffRESTError GT.AsyncTaskWithType

src/Gargantext/Components/NodeSelection.purs

+module Gargantext.Components.NodeSelection where
+
+import Gargantext.Prelude
+
+import Data.Array as A
+import Data.Either (Either)
+import Data.Maybe (Maybe(..))
+import Gargantext.Components.Bootstrap as B
+import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe)
+import Gargantext.Components.ListSelection.Types (NodeSimple(..))
+import Gargantext.Components.NodeSelection.Types (Selection(..), selectedNodesIds)
+import Gargantext.Config.REST (RESTError(..), AffRESTError)
+import Gargantext.Hooks.Loader (useLoader)
+import Gargantext.Routes (SessionRoute(..))
+import Gargantext.Sessions (Session(..), get)
+import Gargantext.Types (ID, NodeType(..), fldr)
+import Gargantext.Utils.Reactix as R2
+import Reactix as R
+import Reactix.DOM.HTML as H
+import Toestand as T
+
+here :: R2.Here
+here = R2.here "Gargantext.Components.NodeSelection"
+
+type Props =
+  ( selection :: T.Box Selection
+  , session   :: Session
+  )
+
+selection :: R2.Component Props
+selection = R.createElement selectionCpt
+selectionCpt :: R.Component Props
+selectionCpt = here.component "selection" cpt where
+  cpt { selection, session } _ = do
+    selection' <- R2.useLive' selection
+    pure $ H.div { className: "list-selection" }
+      [
+        B.formSelect'
+        { callback: flip T.write_ selection
+        , value: selection'
+        , list: [ ChildNodes
+                , SelectedNodes []
+                ]
+        }
+        []
+      , selectedIds { selection, session } []
+      ]
+
+selectedIds :: R2.Component Props
+selectedIds = R.createElement selectedIdsCpt
+selectedIdsCpt :: R.Component Props
+selectedIdsCpt = here.component "selectedIds" cpt where
+  cpt { selection, session } _ = do
+    selection' <- T.useLive T.unequal selection
+
+    pure $ case selection' of
+      SelectedNodes ids -> H.div {} [ idsSelector { selection, session } [] ]
+      _ -> H.div {} []
+
+type IdsSelectorProps =
+  ( selection :: T.Box Selection
+  , session   :: Session )
+
+idsSelector :: R2.Component IdsSelectorProps
+idsSelector = R.createElement idsSelectorCpt
+idsSelectorCpt :: R.Component IdsSelectorProps
+idsSelectorCpt = here.component "idsSelector" cpt where
+  cpt { selection, session } _ = do
+    pure $ H.div { className: "ids-selector" }
+      [ listTree { name: "", nodeType: NodeUser, root, selection, session } ] -- $ map checkbox [1, 2, 3, 4]
+    where
+      Session { treeId: root } = session
+
+listIdsRoute :: ID -> SessionRoute
+listIdsRoute = Children NodeList 0 1 Nothing <<< Just
+
+treeFirstLevelRoute :: ID -> SessionRoute
+treeFirstLevelRoute id = TreeFirstLevel (Just id) ""
+
+loadTreeChildren :: { root :: ID, session :: Session } -> AffRESTError (Array NodeSimple)
+loadTreeChildren { root, session } = do
+  eResult :: (Either RESTError { children :: Array NodeSimple }) <- get session $ treeFirstLevelRoute root
+  pure $ (\{ children } -> children) <$> eResult
+
+type ListTreeProps =
+  ( name      :: String
+  , nodeType  :: NodeType
+  , root      :: ID
+  , selection :: T.Box Selection
+  , session   :: Session
+  )
+
+listTree :: R2.Leaf ListTreeProps
+listTree props = R.createElement listTreeCpt props []
+listTreeCpt :: R.Component ListTreeProps
+listTreeCpt = here.component "listTree" cpt where
+  cpt { name, nodeType, root, selection, session } _ = do
+    pure $ H.div { className: "tree" }
+      [ H.div { className: "root" }
+        [ H.i { className: fldr nodeType true } []
+        , H.text $ "[" <> show root <> "] " <> name ]
+      , listTreeChildren { render: listTree
+                         , root
+                         , selection
+                         , session } []
+      ]
+
+type Render = Record ListTreeProps -> R.Element
+type ListTreeChildrenProps =
+  ( render    :: Render
+  , root      :: ID
+  , selection :: T.Box Selection
+  , session   :: Session
+  )
+
+listTreeChildren :: R2.Component ListTreeChildrenProps
+listTreeChildren = R.createElement listTreeChildrenCpt
+listTreeChildrenCpt :: R.Component ListTreeChildrenProps
+listTreeChildrenCpt = here.component "listTreeChildren" cpt where
+  cpt { render, root, selection, session } _ = do
+    useLoader { errorHandler
+              , loader: loadTreeChildren
+              , path: { root, session }
+              , render: \loaded ->
+                  listTreeChildrenLoaded { loaded
+                                         , render
+                                         , root
+                                         , selection
+                                         , session } [] }
+    where
+      errorHandler err = case err of
+        ReadJSONError err' -> here.warn2 "[listTreeChildren] ReadJSONError" $ show err'
+        _                  -> here.warn2 "[listTreeChildren] RESTError" err
+
+type ListTreeChildrenLoadedProps =
+  ( loaded    :: Array NodeSimple
+  , render    :: Render
+  , root      :: ID
+  , selection :: T.Box Selection
+  , session   :: Session )
+
+listTreeChildrenLoaded :: R2.Component ListTreeChildrenLoadedProps
+listTreeChildrenLoaded = R.createElement listTreeChildrenLoadedCpt
+listTreeChildrenLoadedCpt :: R.Component ListTreeChildrenLoadedProps
+listTreeChildrenLoadedCpt = here.component "listTreeChildrenLoaded" cpt where
+  cpt { loaded, render, root, selection, session } _  = do
+    pure $ H.div { className: "children" } (element <$> loaded)
+    where
+      element (NodeSimple { id, name, nodeType: nodeType@Corpus }) =
+        render { root: id, name, nodeType, selection, session }
+      element (NodeSimple { id, name, nodeType: nodeType@Folder }) =
+        render { root: id, name, nodeType, selection, session }
+      element (NodeSimple { id, name, nodeType: nodeType@FolderPrivate }) =
+        render { root: id, name, nodeType, selection, session }
+      element (NodeSimple { id, name, nodeType: nodeType@FolderPublic }) =
+        render { root: id, name, nodeType, selection, session }
+      element (NodeSimple { id, name, nodeType: nodeType@FolderShared }) =
+        render { root: id, name, nodeType, selection, session }
+      element (NodeSimple { id, name, nodeType: NodeList}) =
+        renderListElement { id, name, selection }
+      element (NodeSimple { id, name, nodeType: nodeType@Team }) =
+        render { root: id, name, nodeType, selection, session }
+      element _ = H.div {} []
+
+type RenderListElementProps =
+  ( id        :: ID
+  , name      :: String
+  , selection :: T.Box Selection )
+
+renderListElement :: R2.Leaf RenderListElementProps
+renderListElement = R2.leafComponent renderListElementCpt
+renderListElementCpt :: R.Component RenderListElementProps
+renderListElementCpt = here.component "renderListElement" cpt where
+  cpt { id, name, selection } _ = do
+    selection' <- T.useLive T.unequal selection
+
+    let ids = selectedNodesIds selection'
+
+    pure $ H.div { className: "leaf" }
+      [ H.input { defaultChecked: A.elem id ids
+                , on: { click: click ids }
+                , type: "checkbox" }
+      , H.i { className: fldr NodeList true } []
+      , H.text $ "[" <> show id <> "] " <> name
+      ]
+      where
+        click ids _ = do
+        -- TODO: Do not default to recursive
+          let f (SelectedNodes lst) =
+                if A.elem id ids
+                then SelectedNodes (A.delete id lst)
+                else SelectedNodes (A.cons id lst)
+              f x = x
+          T.modify_ f selection

src/Gargantext/Components/NodeSelection/Types.purs

+module Gargantext.Components.NodeSelection.Types where
+
+import Gargantext.Prelude
+
+import Data.Eq.Generic (genericEq)
+import Data.Generic.Rep (class Generic)
+import Data.Maybe (Maybe(..))
+import Gargantext.Types (ListId)
+import Simple.JSON as JSON
+
+data Selection = ChildNodes | SelectedNodes (Array ListId) 
+derive instance Generic Selection _
+instance Show Selection where
+  show ChildNodes = "Child Nodes"
+  show (SelectedNodes _) = "Selected Nodes"
+instance Eq Selection where eq = genericEq
+instance Read Selection where
+  read "Child Nodes" = Just ChildNodes
+  read "Selected Nodes" = Just $ SelectedNodes []
+  read _ = Nothing
+instance JSON.WriteForeign Selection where
+  writeImpl ChildNodes = JSON.writeImpl { "type": "ChildNodes" }
+  writeImpl (SelectedNodes ids) = JSON.writeImpl { "type": "SelectedNodes", value: ids }
+
+selectedNodesIds :: Selection -> Array ListId
+selectedNodesIds (SelectedNodes ids) = ids
+selectedNodesIds _                   = []
+