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
8f4ae06a
Commit
8f4ae06a
authored
Sep 28, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
[FIX] Missing commit
parents
c86157fb
3b646c22
Changes
2
Show whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
26 additions
and
20 deletions
+26
-20
gargantext.ini_toModify
gargantext.ini_toModify
+1
-1
Tree.hs
src/Gargantext/Database/Query/Tree.hs
+25
-19
No files found.
gargantext.ini_toModify
View file @
8f4ae06a
...
...
@@ -16,7 +16,7 @@ DATA_FILEPATH = FILEPATH_TO_CHANGE
# Data path to local files
DATA_FILEPATH = FILEPATH_TO_CHANGE
# Data path to local files
# Data path to local files
(do not use quotes)
REPO_FILEPATH = FILEPATH_TO_CHANGE
...
...
src/Gargantext/Database/Query/Tree.hs
View file @
8f4ae06a
...
...
@@ -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
...
...
@@ -56,6 +56,10 @@ data DbTreeNode = DbTreeNode { _dt_nodeId :: NodeId
}
deriving
(
Show
)
makeLenses
''
D
bTreeNode
instance
Eq
DbTreeNode
where
(
==
)
d1
d2
=
(
==
)
(
_dt_nodeId
d1
)
(
_dt_nodeId
d2
)
------------------------------------------------------------------------
data
TreeMode
=
Basic
|
Advanced
...
...
@@ -102,6 +106,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
=>
[
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