Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
158
Issues
158
List
Board
Labels
Milestones
Merge Requests
11
Merge Requests
11
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-gargantext
Commits
2e7ec2f4
Commit
2e7ec2f4
authored
Nov 24, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FIX] Shared lists is taken into account now
parent
3e0a647d
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
28 additions
and
27 deletions
+28
-27
List.hs
src/Gargantext/Core/Text/List.hs
+2
-4
Find.hs
src/Gargantext/Core/Text/List/Social/Find.hs
+13
-9
Scores.hs
src/Gargantext/Core/Text/List/Social/Scores.hs
+1
-3
Tree.hs
src/Gargantext/Database/Query/Tree.hs
+12
-11
No files found.
src/Gargantext/Core/Text/List.hs
View file @
2e7ec2f4
...
@@ -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
...
...
src/Gargantext/Core/Text/List/Social/Find.hs
View file @
2e7ec2f4
...
@@ -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
r
ootId
<-
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
]
src/Gargantext/Core/Text/List/Social/Scores.hs
View file @
2e7ec2f4
...
@@ -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
)
...
...
src/Gargantext/Database/Query/Tree.hs
View file @
2e7ec2f4
...
@@ -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'
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment