From ccda3cd486d083b93e741b711a47de87a984475d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Alexandre=20Delano=C3=AB?= <devel+git@delanoe.org>
Date: Tue, 24 Nov 2020 22:19:42 +0100
Subject: [PATCH] [FIX] Shared lists is taken into account now
---
src/Gargantext/Core/Text/List.hs | 6 ++---
src/Gargantext/Core/Text/List/Social/Find.hs | 22 ++++++++++--------
.../Core/Text/List/Social/Scores.hs | 4 +---
src/Gargantext/Database/Query/Tree.hs | 23 ++++++++++---------
4 files changed, 28 insertions(+), 27 deletions(-)
diff --git a/src/Gargantext/Core/Text/List.hs b/src/Gargantext/Core/Text/List.hs
index d730f2a5..c2151b7b 100644
--- a/src/Gargantext/Core/Text/List.hs
+++ b/src/Gargantext/Core/Text/List.hs
@@ -16,7 +16,7 @@ module Gargantext.Core.Text.List
where
-import Control.Lens ((^.), view, set, over)
+import Control.Lens ((^.), view, over)
import Data.Map (Map)
import Data.Maybe (catMaybes)
import Data.Monoid (mempty)
@@ -103,10 +103,8 @@ buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do
let
groupedWithList = toGroupedTreeText groupIt socialLists' ngs'
-{-
printDebug "groupedWithList"
- $ view flc_scores groupedWithList
--}
+ $ view flc_cont groupedWithList
let
(stopTerms, tailTerms) = Map.partition ((== Just StopTerm) . viewListType) $ view flc_scores groupedWithList
diff --git a/src/Gargantext/Core/Text/List/Social/Find.hs b/src/Gargantext/Core/Text/List/Social/Find.hs
index bc0febcf..ec43a6d3 100644
--- a/src/Gargantext/Core/Text/List/Social/Find.hs
+++ b/src/Gargantext/Core/Text/List/Social/Find.hs
@@ -12,6 +12,7 @@ module Gargantext.Core.Text.List.Social.Find
where
-- findList imports
+import Control.Lens (view)
import Gargantext.Core.Types.Individu
import Gargantext.Database.Admin.Config
import Gargantext.Database.Admin.Types.Node
@@ -25,18 +26,21 @@ import Gargantext.Prelude
findListsId :: (HasNodeError err, HasTreeError err)
=> User -> NodeMode -> Cmd err [NodeId]
findListsId u mode = do
- r <- getRootId u
- ns <- map _dt_nodeId <$> filter (\n -> _dt_typeId n == nodeTypeId NodeList)
- <$> findNodes' mode r
+ rootId <- getRootId u
+ ns <- map (view dt_nodeId) <$> filter ((== nodeTypeId NodeList) . (view dt_typeId))
+ <$> findNodes' rootId mode
pure ns
-
+-- | TODO not clear enough:
+-- | Shared is for Shared with me but I am not the owner of it
+-- | Private is for all Lists I have created
findNodes' :: HasTreeError err
- => NodeMode -> RootId
+ => RootId
+ -> NodeMode
-> Cmd err [DbTreeNode]
-findNodes' Private r = findNodes Private r $ [NodeFolderPrivate] <> commonNodes
-findNodes' Shared r = findNodes Shared r $ [NodeFolderShared ] <> commonNodes
-findNodes' Public r = findNodes Public r $ [NodeFolderPublic ] <> commonNodes
+findNodes' r Private = findNodes r Private $ [NodeFolderPrivate] <> commonNodes
+findNodes' r Shared = findNodes r Shared $ [NodeFolderShared, NodeTeam] <> commonNodes
+findNodes' r Public = findNodes r Public $ [NodeFolderPublic ] <> commonNodes
commonNodes:: [NodeType]
-commonNodes = [NodeFolder, NodeCorpus, NodeList]
+commonNodes = [NodeFolder, NodeCorpus, NodeList, NodeFolderShared, NodeTeam]
diff --git a/src/Gargantext/Core/Text/List/Social/Scores.hs b/src/Gargantext/Core/Text/List/Social/Scores.hs
index feb8ba62..e4b23408 100644
--- a/src/Gargantext/Core/Text/List/Social/Scores.hs
+++ b/src/Gargantext/Core/Text/List/Social/Scores.hs
@@ -38,7 +38,6 @@ toFlowListScores :: KeepAllParents
toFlowListScores k flc_origin = foldl' (toFlowListScores_Level1 k flc_origin) mempty
where
-
toFlowListScores_Level1 :: KeepAllParents
-> FlowCont Text FlowListScores
-> FlowCont Text FlowListScores
@@ -49,7 +48,6 @@ toFlowListScores k flc_origin = foldl' (toFlowListScores_Level1 k flc_origin) me
flc_dest
(Set.fromList $ Map.keys $ view flc_cont flc_origin')
-
toFlowListScores_Level2 :: KeepAllParents
-> Map Text NgramsRepoElement
-> FlowCont Text FlowListScores
@@ -58,7 +56,7 @@ toFlowListScores k flc_origin = foldl' (toFlowListScores_Level1 k flc_origin) me
-> FlowCont Text FlowListScores
toFlowListScores_Level2 k'' ngramsRepo flc_origin'' flc_dest' t =
case Map.lookup t ngramsRepo of
- Nothing -> over flc_cont (Map.insert t mempty) flc_dest'
+ Nothing -> over flc_cont (Map.union (Map.singleton t mempty)) flc_dest'
Just nre -> over flc_scores
( (Map.alter (addParent k'' nre (Set.fromList $ Map.keys $ view flc_cont flc_origin'')) t)
. (Map.alter (addList $ _nre_list nre) t)
diff --git a/src/Gargantext/Database/Query/Tree.hs b/src/Gargantext/Database/Query/Tree.hs
index a0ae6817..3800b1de 100644
--- a/src/Gargantext/Database/Query/Tree.hs
+++ b/src/Gargantext/Database/Query/Tree.hs
@@ -34,7 +34,7 @@ module Gargantext.Database.Query.Tree
)
where
-import Control.Lens ({-(^..)-} toListOf, at, each, _Just, to, set, makeLenses)
+import Control.Lens (view, toListOf, at, each, _Just, to, set, makeLenses)
import Control.Monad.Error.Class (MonadError())
import Data.List (tail, concat, nub)
import Data.Map (Map, fromListWith, lookup)
@@ -93,22 +93,22 @@ tree_advanced :: HasTreeError err
-> [NodeType]
-> Cmd err (Tree NodeTree)
tree_advanced r nodeTypes = do
- mainRoot <- findNodes Private r nodeTypes
- sharedRoots <- findNodes Shared r nodeTypes
- publicRoots <- findNodes Public r nodeTypes
+ mainRoot <- findNodes r Private nodeTypes
+ sharedRoots <- findNodes r Shared nodeTypes
+ publicRoots <- findNodes r Public nodeTypes
toTree $ toTreeParent (mainRoot <> sharedRoots <> publicRoots)
------------------------------------------------------------------------
data NodeMode = Private | Shared | Public
findNodes :: HasTreeError err
- => NodeMode
- -> RootId -> [NodeType]
+ => RootId
+ -> NodeMode
+ -> [NodeType]
-> Cmd err [DbTreeNode]
-findNodes Private r nt = dbTree r nt
-findNodes Shared r nt = findShared r NodeFolderShared nt sharedTreeUpdate
-findNodes Public r nt = findShared r NodeFolderPublic nt publicTreeUpdate
-
+findNodes r Private nt = dbTree r nt
+findNodes r Shared nt = findShared r NodeFolderShared nt sharedTreeUpdate
+findNodes r Public nt = findShared r NodeFolderPublic nt publicTreeUpdate
------------------------------------------------------------------------
-- | Collaborative Nodes in the Tree
@@ -120,6 +120,7 @@ findShared r nt nts fun = do
trees <- mapM (updateTree nts fun) foldersSharedId
pure $ concat trees
+
type UpdateTree err = ParentId -> [NodeType] -> NodeId -> Cmd err [DbTreeNode]
updateTree :: HasTreeError err
@@ -134,7 +135,7 @@ updateTree nts fun r = do
sharedTreeUpdate :: HasTreeError err => UpdateTree err
sharedTreeUpdate p nt n = dbTree n nt
- <&> map (\n' -> if _dt_nodeId n' == n
+ <&> map (\n' -> if (view dt_nodeId n') == n
-- && elem (fromNodeTypeId $ _dt_typeId n') [NodeGraph]
-- && not (elem (fromNodeTypeId $ _dt_typeId n') [NodeFile])
then set dt_parentId (Just p) n'
--
2.21.0