Commit 2e7ec2f4 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FIX] Shared lists is taken into account now

parent 3e0a647d
...@@ -16,7 +16,7 @@ module Gargantext.Core.Text.List ...@@ -16,7 +16,7 @@ module Gargantext.Core.Text.List
where where
import Control.Lens ((^.), view, set, over) import Control.Lens ((^.), view, over)
import Data.Map (Map) import Data.Map (Map)
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import Data.Monoid (mempty) import Data.Monoid (mempty)
...@@ -103,10 +103,8 @@ buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do ...@@ -103,10 +103,8 @@ buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do
let let
groupedWithList = toGroupedTreeText groupIt socialLists' ngs' groupedWithList = toGroupedTreeText groupIt socialLists' ngs'
{-
printDebug "groupedWithList" printDebug "groupedWithList"
$ view flc_scores groupedWithList $ view flc_cont groupedWithList
-}
let let
(stopTerms, tailTerms) = Map.partition ((== Just StopTerm) . viewListType) $ view flc_scores groupedWithList (stopTerms, tailTerms) = Map.partition ((== Just StopTerm) . viewListType) $ view flc_scores groupedWithList
......
...@@ -12,6 +12,7 @@ module Gargantext.Core.Text.List.Social.Find ...@@ -12,6 +12,7 @@ module Gargantext.Core.Text.List.Social.Find
where where
-- findList imports -- findList imports
import Control.Lens (view)
import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
import Gargantext.Database.Admin.Config import Gargantext.Database.Admin.Config
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
...@@ -25,18 +26,21 @@ import Gargantext.Prelude ...@@ -25,18 +26,21 @@ import Gargantext.Prelude
findListsId :: (HasNodeError err, HasTreeError err) findListsId :: (HasNodeError err, HasTreeError err)
=> User -> NodeMode -> Cmd err [NodeId] => User -> NodeMode -> Cmd err [NodeId]
findListsId u mode = do findListsId u mode = do
r <- getRootId u rootId <- getRootId u
ns <- map _dt_nodeId <$> filter (\n -> _dt_typeId n == nodeTypeId NodeList) ns <- map (view dt_nodeId) <$> filter ((== nodeTypeId NodeList) . (view dt_typeId))
<$> findNodes' mode r <$> findNodes' rootId mode
pure ns 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 findNodes' :: HasTreeError err
=> NodeMode -> RootId => RootId
-> NodeMode
-> Cmd err [DbTreeNode] -> Cmd err [DbTreeNode]
findNodes' Private r = findNodes Private r $ [NodeFolderPrivate] <> commonNodes findNodes' r Private = findNodes r Private $ [NodeFolderPrivate] <> commonNodes
findNodes' Shared r = findNodes Shared r $ [NodeFolderShared ] <> commonNodes findNodes' r Shared = findNodes r Shared $ [NodeFolderShared, NodeTeam] <> commonNodes
findNodes' Public r = findNodes Public r $ [NodeFolderPublic ] <> commonNodes findNodes' r Public = findNodes r Public $ [NodeFolderPublic ] <> commonNodes
commonNodes:: [NodeType] commonNodes:: [NodeType]
commonNodes = [NodeFolder, NodeCorpus, NodeList] commonNodes = [NodeFolder, NodeCorpus, NodeList, NodeFolderShared, NodeTeam]
...@@ -38,7 +38,6 @@ toFlowListScores :: KeepAllParents ...@@ -38,7 +38,6 @@ toFlowListScores :: KeepAllParents
toFlowListScores k flc_origin = foldl' (toFlowListScores_Level1 k flc_origin) mempty toFlowListScores k flc_origin = foldl' (toFlowListScores_Level1 k flc_origin) mempty
where where
toFlowListScores_Level1 :: KeepAllParents toFlowListScores_Level1 :: KeepAllParents
-> FlowCont Text FlowListScores -> FlowCont Text FlowListScores
-> FlowCont Text FlowListScores -> FlowCont Text FlowListScores
...@@ -49,7 +48,6 @@ toFlowListScores k flc_origin = foldl' (toFlowListScores_Level1 k flc_origin) me ...@@ -49,7 +48,6 @@ toFlowListScores k flc_origin = foldl' (toFlowListScores_Level1 k flc_origin) me
flc_dest flc_dest
(Set.fromList $ Map.keys $ view flc_cont flc_origin') (Set.fromList $ Map.keys $ view flc_cont flc_origin')
toFlowListScores_Level2 :: KeepAllParents toFlowListScores_Level2 :: KeepAllParents
-> Map Text NgramsRepoElement -> Map Text NgramsRepoElement
-> FlowCont Text FlowListScores -> FlowCont Text FlowListScores
...@@ -58,7 +56,7 @@ toFlowListScores k flc_origin = foldl' (toFlowListScores_Level1 k flc_origin) me ...@@ -58,7 +56,7 @@ toFlowListScores k flc_origin = foldl' (toFlowListScores_Level1 k flc_origin) me
-> FlowCont Text FlowListScores -> FlowCont Text FlowListScores
toFlowListScores_Level2 k'' ngramsRepo flc_origin'' flc_dest' t = toFlowListScores_Level2 k'' ngramsRepo flc_origin'' flc_dest' t =
case Map.lookup t ngramsRepo of 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 Just nre -> over flc_scores
( (Map.alter (addParent k'' nre (Set.fromList $ Map.keys $ view flc_cont flc_origin'')) t) ( (Map.alter (addParent k'' nre (Set.fromList $ Map.keys $ view flc_cont flc_origin'')) t)
. (Map.alter (addList $ _nre_list nre) t) . (Map.alter (addList $ _nre_list nre) t)
......
...@@ -34,7 +34,7 @@ module Gargantext.Database.Query.Tree ...@@ -34,7 +34,7 @@ module Gargantext.Database.Query.Tree
) )
where 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 Control.Monad.Error.Class (MonadError())
import Data.List (tail, concat, nub) import Data.List (tail, concat, nub)
import Data.Map (Map, fromListWith, lookup) import Data.Map (Map, fromListWith, lookup)
...@@ -93,22 +93,22 @@ tree_advanced :: HasTreeError err ...@@ -93,22 +93,22 @@ tree_advanced :: HasTreeError err
-> [NodeType] -> [NodeType]
-> Cmd err (Tree NodeTree) -> Cmd err (Tree NodeTree)
tree_advanced r nodeTypes = do tree_advanced r nodeTypes = do
mainRoot <- findNodes Private r nodeTypes mainRoot <- findNodes r Private nodeTypes
sharedRoots <- findNodes Shared r nodeTypes sharedRoots <- findNodes r Shared nodeTypes
publicRoots <- findNodes Public r nodeTypes publicRoots <- findNodes r Public nodeTypes
toTree $ toTreeParent (mainRoot <> sharedRoots <> publicRoots) toTree $ toTreeParent (mainRoot <> sharedRoots <> publicRoots)
------------------------------------------------------------------------ ------------------------------------------------------------------------
data NodeMode = Private | Shared | Public data NodeMode = Private | Shared | Public
findNodes :: HasTreeError err findNodes :: HasTreeError err
=> NodeMode => RootId
-> RootId -> [NodeType] -> NodeMode
-> [NodeType]
-> Cmd err [DbTreeNode] -> Cmd err [DbTreeNode]
findNodes Private r nt = dbTree r nt findNodes r Private nt = dbTree r nt
findNodes Shared r nt = findShared r NodeFolderShared nt sharedTreeUpdate findNodes r Shared nt = findShared r NodeFolderShared nt sharedTreeUpdate
findNodes Public r nt = findShared r NodeFolderPublic nt publicTreeUpdate findNodes r Public nt = findShared r NodeFolderPublic nt publicTreeUpdate
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Collaborative Nodes in the Tree -- | Collaborative Nodes in the Tree
...@@ -120,6 +120,7 @@ findShared r nt nts fun = do ...@@ -120,6 +120,7 @@ findShared r nt nts fun = do
trees <- mapM (updateTree nts fun) foldersSharedId trees <- mapM (updateTree nts fun) foldersSharedId
pure $ concat trees pure $ concat trees
type UpdateTree err = ParentId -> [NodeType] -> NodeId -> Cmd err [DbTreeNode] type UpdateTree err = ParentId -> [NodeType] -> NodeId -> Cmd err [DbTreeNode]
updateTree :: HasTreeError err updateTree :: HasTreeError err
...@@ -134,7 +135,7 @@ updateTree nts fun r = do ...@@ -134,7 +135,7 @@ updateTree nts fun r = do
sharedTreeUpdate :: HasTreeError err => UpdateTree err sharedTreeUpdate :: HasTreeError err => UpdateTree err
sharedTreeUpdate p nt n = dbTree n nt 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] -- && elem (fromNodeTypeId $ _dt_typeId n') [NodeGraph]
-- && not (elem (fromNodeTypeId $ _dt_typeId n') [NodeFile]) -- && not (elem (fromNodeTypeId $ _dt_typeId n') [NodeFile])
then set dt_parentId (Just p) n' then set dt_parentId (Just p) n'
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment