Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
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
Przemyslaw Kaminski
haskell-gargantext
Commits
978db810
Commit
978db810
authored
Sep 28, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FIX] Duplicates in the Tree since Public
parent
21743f58
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
25 additions
and
19 deletions
+25
-19
Tree.hs
src/Gargantext/Database/Query/Tree.hs
+25
-19
No files found.
src/Gargantext/Database/Query/Tree.hs
View file @
978db810
...
...
@@ -34,7 +34,7 @@ module Gargantext.Database.Query.Tree
import
Control.Lens
((
^..
),
at
,
each
,
_Just
,
to
,
set
,
makeLenses
)
import
Control.Monad.Error.Class
(
MonadError
())
import
Data.List
(
tail
,
concat
)
import
Data.List
(
tail
,
concat
,
nub
)
import
Data.Map
(
Map
,
fromListWith
,
lookup
)
import
Data.Text
(
Text
)
import
Database.PostgreSQL.Simple
...
...
@@ -49,23 +49,27 @@ import Gargantext.Database.Schema.NodeNode (NodeNodePoly(..))
import
Gargantext.Prelude
------------------------------------------------------------------------
data
DbTreeNode
=
DbTreeNode
{
_dt_nodeId
::
NodeId
,
_dt_typeId
::
Int
data
DbTreeNode
=
DbTreeNode
{
_dt_nodeId
::
NodeId
,
_dt_typeId
::
Int
,
_dt_parentId
::
Maybe
NodeId
,
_dt_name
::
Text
}
deriving
(
Show
)
makeLenses
''
D
bTreeNode
instance
Eq
DbTreeNode
where
(
==
)
d1
d2
=
(
==
)
(
_dt_nodeId
d1
)
(
_dt_nodeId
d2
)
------------------------------------------------------------------------
data
TreeMode
=
Basic
|
Advanced
-- | Returns the Tree of Nodes in Database
tree
::
HasTreeError
err
=>
TreeMode
->
RootId
->
[
NodeType
]
->
Cmd
err
(
Tree
NodeTree
)
=>
TreeMode
->
RootId
->
[
NodeType
]
->
Cmd
err
(
Tree
NodeTree
)
tree
Basic
=
tree_basic
tree
Advanced
=
tree_advanced
...
...
@@ -73,19 +77,19 @@ tree Advanced = tree_advanced
-- (without shared folders)
-- keeping this for teaching purpose only
tree_basic
::
HasTreeError
err
=>
RootId
->
[
NodeType
]
->
Cmd
err
(
Tree
NodeTree
)
tree_basic
r
nodeTypes
=
=>
RootId
->
[
NodeType
]
->
Cmd
err
(
Tree
NodeTree
)
tree_basic
r
nodeTypes
=
(
dbTree
r
nodeTypes
<&>
toTreeParent
)
>>=
toTree
-- Same as (but easier to read) :
-- toTree =<< (toTreeParent <$> dbTree r nodeTypes)
-- | Advanced mode of the Tree enables shared nodes
tree_advanced
::
HasTreeError
err
=>
RootId
->
[
NodeType
]
->
Cmd
err
(
Tree
NodeTree
)
=>
RootId
->
[
NodeType
]
->
Cmd
err
(
Tree
NodeTree
)
tree_advanced
r
nodeTypes
=
do
mainRoot
<-
dbTree
r
nodeTypes
sharedRoots
<-
findShared
r
NodeFolderShared
nodeTypes
sharedTreeUpdate
...
...
@@ -99,9 +103,10 @@ findShared :: HasTreeError err
->
Cmd
err
[
DbTreeNode
]
findShared
r
nt
nts
fun
=
do
foldersSharedId
<-
findNodesId
r
[
nt
]
trees
<-
mapM
(
updateTree
nts
fun
)
foldersSharedId
trees
<-
mapM
(
updateTree
nts
fun
)
foldersSharedId
pure
$
concat
trees
type
UpdateTree
err
=
ParentId
->
[
NodeType
]
->
NodeId
->
Cmd
err
[
DbTreeNode
]
updateTree
::
HasTreeError
err
=>
[
NodeType
]
->
UpdateTree
err
->
RootId
...
...
@@ -113,18 +118,19 @@ updateTree nts fun r = do
pure
$
concat
nodesSharedId
type
UpdateTree
err
=
ParentId
->
[
NodeType
]
->
NodeId
->
Cmd
err
[
DbTreeNode
]
sharedTreeUpdate
::
HasTreeError
err
=>
UpdateTree
err
sharedTreeUpdate
p
nt
n
=
dbTree
n
nt
<&>
map
(
\
n'
->
if
_dt_nodeId
n'
==
n
-- && elem (fromNodeTypeId $ _dt_typeId n') [NodeGraph]
-- && not (elem (fromNodeTypeId $ _dt_typeId n') [NodeFile])
then
set
dt_parentId
(
Just
p
)
n'
else
n'
)
publicTreeUpdate
::
HasTreeError
err
=>
UpdateTree
err
publicTreeUpdate
p
nt
n
=
dbTree
n
nt
<&>
map
(
\
n'
->
if
_dt_nodeId
n'
==
n
-- && (fromNodeTypeId $ _dt_typeId n') /= NodeFolderPublic
-- && (fromNodeTypeId $ _dt_typeId n') /= NodeGraph
-- && not (elem (fromNodeTypeId $ _dt_typeId n') [NodeFile])
then
set
dt_parentId
(
Just
p
)
n'
else
n'
)
...
...
@@ -164,7 +170,7 @@ toTree m =
------------------------------------------------------------------------
toTreeParent
::
[
DbTreeNode
]
->
Map
(
Maybe
ParentId
)
[
DbTreeNode
]
toTreeParent
=
fromListWith
(
<>
)
.
map
(
\
n
->
(
_dt_parentId
n
,
[
n
]))
toTreeParent
=
fromListWith
(
\
a
b
->
nub
$
a
<>
b
)
.
map
(
\
n
->
(
_dt_parentId
n
,
[
n
]))
------------------------------------------------------------------------
-- | Main DB Tree function
dbTree
::
RootId
...
...
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