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
c1c5d301
Commit
c1c5d301
authored
Feb 21, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FIX] Tree filtering.
parent
f417bede
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
15 additions
and
9 deletions
+15
-9
Node.hs
src/Gargantext/API/Node.hs
+1
-1
Tree.hs
src/Gargantext/Database/Tree.hs
+14
-8
No files found.
src/Gargantext/API/Node.hs
View file @
c1c5d301
...
@@ -344,7 +344,7 @@ instance HasTreeError ServantErr where
...
@@ -344,7 +344,7 @@ instance HasTreeError ServantErr where
mk TooManyRoots = err500 { errBody = e <> "Too many root nodes" }
mk TooManyRoots = err500 { errBody = e <> "Too many root nodes" }
-}
-}
type
TreeAPI
=
Get
'[
J
SON
]
(
Tree
NodeTree
)
type
TreeAPI
=
QueryParams
"type"
NodeType
:>
Get
'[
J
SON
]
(
Tree
NodeTree
)
treeAPI
::
NodeId
->
GargServer
TreeAPI
treeAPI
::
NodeId
->
GargServer
TreeAPI
treeAPI
=
treeDB
treeAPI
=
treeDB
...
...
src/Gargantext/Database/Tree.hs
View file @
c1c5d301
...
@@ -36,8 +36,8 @@ import Database.PostgreSQL.Simple.SqlQQ
...
@@ -36,8 +36,8 @@ import Database.PostgreSQL.Simple.SqlQQ
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Core.Types.Main
(
NodeTree
(
..
),
Tree
(
..
))
import
Gargantext.Core.Types.Main
(
NodeTree
(
..
),
Tree
(
..
))
import
Gargantext.Database.
Types.Node
(
NodeId
,
Doc
Id
)
import
Gargantext.Database.
Config
(
fromNodeTypeId
,
nodeType
Id
)
import
Gargantext.Database.
Config
(
fromNodeTypeId
)
import
Gargantext.Database.
Types.Node
(
NodeId
,
NodeType
,
DocId
,
allNodeTypes
)
import
Gargantext.Database.Utils
(
Cmd
,
runPGSQuery
)
import
Gargantext.Database.Utils
(
Cmd
,
runPGSQuery
)
------------------------------------------------------------------------
------------------------------------------------------------------------
-- import Gargantext.Database.Utils (runCmdDev)
-- import Gargantext.Database.Utils (runCmdDev)
...
@@ -55,8 +55,8 @@ treeError :: (MonadError e m, HasTreeError e) => TreeError -> m a
...
@@ -55,8 +55,8 @@ treeError :: (MonadError e m, HasTreeError e) => TreeError -> m a
treeError
te
=
throwError
$
_TreeError
#
te
treeError
te
=
throwError
$
_TreeError
#
te
-- | Returns the Tree of Nodes in Database
-- | Returns the Tree of Nodes in Database
treeDB
::
HasTreeError
err
=>
RootId
->
Cmd
err
(
Tree
NodeTree
)
treeDB
::
HasTreeError
err
=>
RootId
->
[
NodeType
]
->
Cmd
err
(
Tree
NodeTree
)
treeDB
r
=
toTree
=<<
(
toTreeParent
<$>
dbTree
r
)
treeDB
r
nodeTypes
=
toTree
=<<
(
toTreeParent
<$>
dbTree
r
nodeTypes
)
type
RootId
=
NodeId
type
RootId
=
NodeId
type
ParentId
=
NodeId
type
ParentId
=
NodeId
...
@@ -92,8 +92,8 @@ data DbTreeNode = DbTreeNode { dt_nodeId :: NodeId
...
@@ -92,8 +92,8 @@ data DbTreeNode = DbTreeNode { dt_nodeId :: NodeId
-- | Main DB Tree function
-- | Main DB Tree function
-- TODO add typenames as parameters
-- TODO add typenames as parameters
dbTree
::
RootId
->
Cmd
err
[
DbTreeNode
]
dbTree
::
RootId
->
[
NodeType
]
->
Cmd
err
[
DbTreeNode
]
dbTree
rootId
=
map
(
\
(
nId
,
tId
,
pId
,
n
)
->
DbTreeNode
nId
tId
pId
n
)
dbTree
rootId
nodeTypes
=
map
(
\
(
nId
,
tId
,
pId
,
n
)
->
DbTreeNode
nId
tId
pId
n
)
<$>
runPGSQuery
[
sql
|
<$>
runPGSQuery
[
sql
|
WITH RECURSIVE
WITH RECURSIVE
tree (id, typename, parent_id, name) AS
tree (id, typename, parent_id, name) AS
...
@@ -108,10 +108,16 @@ dbTree rootId = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n)
...
@@ -108,10 +108,16 @@ dbTree rootId = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n)
FROM nodes AS c
FROM nodes AS c
INNER JOIN tree AS s ON c.parent_id = s.id
INNER JOIN tree AS s ON c.parent_id = s.id
-- WHERE c.typename IN (2,20,21,22,3,5,30,31,40,7,9,90,71)
WHERE c.typename IN ?
)
)
SELECT * from tree;
SELECT * from tree;
|]
(
Only
rootId
)
|]
(
rootId
,
In
typename
)
where
typename
=
map
nodeTypeId
ns
ns
=
case
nodeTypes
of
[]
->
allNodeTypes
-- [2, 20, 21, 22, 3, 5, 30, 31, 40, 7, 9, 90, 71]
_
->
nodeTypes
isDescendantOf
::
NodeId
->
RootId
->
Cmd
err
Bool
isDescendantOf
::
NodeId
->
RootId
->
Cmd
err
Bool
isDescendantOf
childId
rootId
=
(
==
[
Only
True
])
isDescendantOf
childId
rootId
=
(
==
[
Only
True
])
...
...
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