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
153
Issues
153
List
Board
Labels
Milestones
Merge Requests
9
Merge Requests
9
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
e59e42ae
Commit
e59e42ae
authored
Jun 01, 2023
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
Merge remote-tracking branch 'origin/506-dev-search-in-tree' into dev
parents
fcb2c87f
1fdd677f
Changes
3
Show whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
36 additions
and
5 deletions
+36
-5
Node.hs
src/Gargantext/API/Node.hs
+8
-1
Routes.hs
src/Gargantext/API/Routes.hs
+7
-0
Tree.hs
src/Gargantext/Database/Query/Tree.hs
+21
-4
No files found.
src/Gargantext/API/Node.hs
View file @
e59e42ae
...
@@ -62,7 +62,7 @@ import Gargantext.Database.Query.Table.Node.Update (Update(..), update)
...
@@ -62,7 +62,7 @@ import Gargantext.Database.Query.Table.Node.Update (Update(..), update)
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateHyperdata
)
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateHyperdata
)
import
Gargantext.Database.Query.Table.NodeContext
(
nodeContextsCategory
,
nodeContextsScore
)
import
Gargantext.Database.Query.Table.NodeContext
(
nodeContextsCategory
,
nodeContextsScore
)
import
Gargantext.Database.Query.Table.NodeNode
import
Gargantext.Database.Query.Table.NodeNode
import
Gargantext.Database.Query.Tree
(
tree
,
TreeMode
(
..
))
import
Gargantext.Database.Query.Tree
(
tree
,
tree_flat
,
TreeMode
(
..
))
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Servant
import
Servant
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck
(
elements
)
...
@@ -336,6 +336,13 @@ treeAPI :: NodeId -> GargServer TreeAPI
...
@@ -336,6 +336,13 @@ treeAPI :: NodeId -> GargServer TreeAPI
treeAPI
id
=
tree
TreeAdvanced
id
treeAPI
id
=
tree
TreeAdvanced
id
:<|>
tree
TreeFirstLevel
id
:<|>
tree
TreeFirstLevel
id
type
TreeFlatAPI
=
QueryParams
"type"
NodeType
:>
QueryParam
"query"
Text
:>
Get
'[
J
SON
]
[
NodeTree
]
treeFlatAPI
::
NodeId
->
GargServer
TreeFlatAPI
treeFlatAPI
=
tree_flat
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | TODO Check if the name is less than 255 char
-- | TODO Check if the name is less than 255 char
rename
::
NodeId
->
RenameNode
->
Cmd
err
[
Int
]
rename
::
NodeId
->
RenameNode
->
Cmd
err
[
Int
]
...
...
src/Gargantext/API/Routes.hs
View file @
e59e42ae
...
@@ -162,6 +162,10 @@ type GargPrivateAPI' =
...
@@ -162,6 +162,10 @@ type GargPrivateAPI' =
:<|>
"tree"
:>
Summary
"Tree endpoint"
:<|>
"tree"
:>
Summary
"Tree endpoint"
:>
Capture
"tree_id"
NodeId
:>
Capture
"tree_id"
NodeId
:>
TreeAPI
:>
TreeAPI
-- Flat tree endpoint
:<|>
"treeflat"
:>
Summary
"Flat tree endpoint"
:>
Capture
"tree_id"
NodeId
:>
TreeFlatAPI
:<|>
"members"
:>
Summary
"Team node members"
:<|>
"members"
:>
Summary
"Team node members"
:>
MembersAPI
:>
MembersAPI
...
@@ -252,6 +256,9 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
...
@@ -252,6 +256,9 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
:<|>
withAccess
(
Proxy
::
Proxy
TreeAPI
)
Proxy
uid
:<|>
withAccess
(
Proxy
::
Proxy
TreeAPI
)
Proxy
uid
<$>
PathNode
<*>
treeAPI
<$>
PathNode
<*>
treeAPI
:<|>
withAccess
(
Proxy
::
Proxy
TreeFlatAPI
)
Proxy
uid
<$>
PathNode
<*>
treeFlatAPI
:<|>
members
uid
:<|>
members
uid
-- TODO access
-- TODO access
:<|>
addCorpusWithForm
(
RootId
(
NodeId
uid
))
:<|>
addCorpusWithForm
(
RootId
(
NodeId
uid
))
...
...
src/Gargantext/Database/Query/Tree.hs
View file @
e59e42ae
...
@@ -22,6 +22,7 @@ module Gargantext.Database.Query.Tree
...
@@ -22,6 +22,7 @@ module Gargantext.Database.Query.Tree
,
isDescendantOf
,
isDescendantOf
,
isIn
,
isIn
,
tree
,
tree
,
tree_flat
,
TreeMode
(
..
)
,
TreeMode
(
..
)
,
findNodesId
,
findNodesId
,
DbTreeNode
(
..
)
,
DbTreeNode
(
..
)
...
@@ -43,6 +44,7 @@ import Control.Lens (view, toListOf, at, each, _Just, to, set, makeLenses)
...
@@ -43,6 +44,7 @@ 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
qualified
Data.List
as
List
import
qualified
Data.List
as
List
import
qualified
Data.Text
as
Text
import
Data.Map.Strict
(
Map
,
fromListWith
,
lookup
)
import
Data.Map.Strict
(
Map
,
fromListWith
,
lookup
)
-- import Data.Monoid (mconcat)
-- import Data.Monoid (mconcat)
import
Data.Proxy
import
Data.Proxy
...
@@ -95,7 +97,6 @@ tree TreeFirstLevel = tree_first_level
...
@@ -95,7 +97,6 @@ tree TreeFirstLevel = tree_first_level
-- (without shared folders)
-- (without shared folders)
-- keeping this for teaching purpose only
-- keeping this for teaching purpose only
tree_basic
::
(
HasTreeError
err
,
HasNodeError
err
)
tree_basic
::
(
HasTreeError
err
,
HasNodeError
err
)
=>
RootId
=>
RootId
->
[
NodeType
]
->
[
NodeType
]
->
Cmd
err
(
Tree
NodeTree
)
->
Cmd
err
(
Tree
NodeTree
)
...
@@ -144,6 +145,22 @@ tree_first_level r nodeTypes = do
...
@@ -144,6 +145,22 @@ tree_first_level r nodeTypes = do
-- printDebug (rPrefix "tree") ret
-- printDebug (rPrefix "tree") ret
pure
ret
pure
ret
-- | Fetch tree in a flattened form
tree_flat
::
(
HasTreeError
err
,
HasNodeError
err
)
=>
RootId
->
[
NodeType
]
->
Maybe
Text
->
Cmd
err
[
NodeTree
]
tree_flat
r
nodeTypes
q
=
do
mainRoot
<-
findNodes
r
Private
nodeTypes
publicRoots
<-
findNodes
r
PublicDirect
nodeTypes
sharedRoots
<-
findNodes
r
SharedDirect
nodeTypes
let
ret
=
map
toNodeTree
(
mainRoot
<>
sharedRoots
<>
publicRoots
)
case
q
of
Just
v
->
pure
$
filter
(
\
(
NodeTree
{
_nt_name
})
->
Text
.
isInfixOf
(
Text
.
toLower
v
)
(
Text
.
toLower
_nt_name
))
ret
Nothing
->
pure
$
ret
------------------------------------------------------------------------
------------------------------------------------------------------------
data
NodeMode
=
Private
|
Shared
|
Public
|
SharedDirect
|
PublicDirect
data
NodeMode
=
Private
|
Shared
|
Public
|
SharedDirect
|
PublicDirect
...
@@ -263,9 +280,9 @@ toTree m =
...
@@ -263,9 +280,9 @@ toTree m =
-- m' ^.. at (Just $ _dt_nodeId root) . _Just . each . to (toTree' m')
-- m' ^.. at (Just $ _dt_nodeId root) . _Just . each . to (toTree' m')
toListOf
(
at
(
Just
$
_dt_nodeId
root
)
.
_Just
.
each
.
to
(
toTree'
m'
))
m'
toListOf
(
at
(
Just
$
_dt_nodeId
root
)
.
_Just
.
each
.
to
(
toTree'
m'
))
m'
toNodeTree
::
DbTreeNode
toNodeTree
::
DbTreeNode
->
NodeTree
->
NodeTree
toNodeTree
(
DbTreeNode
nId
tId
_
n
)
=
NodeTree
n
(
fromNodeTypeId
tId
)
nId
toNodeTree
(
DbTreeNode
nId
tId
_
n
)
=
NodeTree
n
(
fromNodeTypeId
tId
)
nId
------------------------------------------------------------------------
------------------------------------------------------------------------
toTreeParent
::
[
DbTreeNode
]
toTreeParent
::
[
DbTreeNode
]
...
...
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