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
152
Issues
152
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
6507a2d2
Commit
6507a2d2
authored
Apr 30, 2021
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FEAT] reindexing enabled in frontend
parent
d97e2510
Changes
13
Hide whitespace changes
Inline
Side-by-side
Showing
13 changed files
with
69 additions
and
47 deletions
+69
-47
Ngrams.hs
src/Gargantext/API/Ngrams.hs
+3
-3
New.hs
src/Gargantext/API/Node/New.hs
+2
-2
Update.hs
src/Gargantext/API/Node/Update.hs
+37
-7
API.hs
src/Gargantext/Core/Viz/Graph/API.hs
+4
-4
LegacyMain.hs
src/Gargantext/Core/Viz/Phylo/Legacy/LegacyMain.hs
+0
-8
Delete.hs
src/Gargantext/Database/Action/Delete.hs
+2
-2
Share.hs
src/Gargantext/Database/Action/Share.hs
+1
-1
User.hs
src/Gargantext/Database/Action/User.hs
+2
-2
Node.hs
src/Gargantext/Database/Query/Table/Node.hs
+2
-2
Select.hs
src/Gargantext/Database/Query/Table/Node/Select.hs
+1
-1
Tree.hs
src/Gargantext/Database/Query/Tree.hs
+1
-1
Root.hs
src/Gargantext/Database/Query/Tree/Root.hs
+2
-2
Node.hs
src/Gargantext/Database/Schema/Node.hs
+12
-12
No files found.
src/Gargantext/API/Ngrams.hs
View file @
6507a2d2
...
...
@@ -115,7 +115,7 @@ import Gargantext.Database.Query.Table.Ngrams hiding (NgramsType(..), ngramsType
import
Gargantext.Database.Query.Table.Node
(
getNode
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.Node.Select
import
Gargantext.Database.Schema.Node
(
node_id
,
node_parent
Id
,
node_userI
d
)
import
Gargantext.Database.Schema.Node
(
node_id
,
node_parent
_id
,
node_user_i
d
)
import
Gargantext.Prelude
hiding
(
log
)
import
Gargantext.Prelude.Job
import
Gargantext.Prelude.Clock
(
hasTime
,
getTime
)
...
...
@@ -368,8 +368,8 @@ tableNgramsPostChartsAsync utn logStatus = do
node
<-
getNode
listId
let
nId
=
node
^.
node_id
_uId
=
node
^.
node_user
I
d
mCId
=
node
^.
node_parent
I
d
_uId
=
node
^.
node_user
_i
d
mCId
=
node
^.
node_parent
_i
d
printDebug
"[tableNgramsPut] tabType"
tabType
printDebug
"[tableNgramsPut] listId"
listId
...
...
src/Gargantext/API/Node/New.hs
View file @
6507a2d2
...
...
@@ -61,7 +61,7 @@ postNode :: HasNodeError err
->
Cmd
err
[
NodeId
]
postNode
uId
pId
(
PostNode
nodeName
nt
)
=
do
nodeUser
<-
getNodeUser
(
NodeId
uId
)
let
uId'
=
nodeUser
^.
node_user
I
d
let
uId'
=
nodeUser
^.
node_user
_i
d
mkNodeWithParent
nt
(
Just
pId
)
uId'
nodeName
------------------------------------------------------------------------
...
...
@@ -100,7 +100,7 @@ postNodeAsync uId nId (PostNode nodeName tn) logStatus = do
,
_scst_events
=
Just
[]
}
let
uId'
=
nodeUser
^.
node_user
I
d
let
uId'
=
nodeUser
^.
node_user
_i
d
_
<-
mkNodeWithParent
tn
(
Just
nId
)
uId'
nodeName
pure
JobLog
{
_scst_succeeded
=
Just
3
...
...
src/Gargantext/API/Node/Update.hs
View file @
6507a2d2
...
...
@@ -16,25 +16,31 @@ Portability : POSIX
module
Gargantext.API.Node.Update
where
import
Control.Lens
(
view
)
import
Data.Aeson
import
Data.Maybe
(
Maybe
(
..
))
import
Data.Swagger
import
GHC.Generics
(
Generic
)
import
Prelude
(
Enum
,
Bounded
,
minBound
,
maxBound
)
import
Servant
import
Servant.Job.Async
(
JobFunction
(
..
),
serveJobsAPI
)
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck.Arbitrary
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
(
..
),
AsyncJobs
)
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.API.Ngrams.List
(
reIndexWith
)
import
Gargantext.API.Prelude
(
GargServer
,
simuLogs
)
import
Gargantext.Core.Viz.Graph.API
(
recomputeGraph
)
import
Gargantext.Core.Methods.Distances
(
GraphMetric
(
..
))
import
Gargantext.Core.Viz.Graph.API
(
recomputeGraph
)
import
Gargantext.Database.Query.Table.Node
(
getNode
)
import
Gargantext.Database.Schema.Node
(
node_parent_id
)
import
Gargantext.Core.Types.Main
(
ListType
(
..
))
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
NgramsTerms
))
import
Gargantext.Database.Action.Flow.Pairing
(
pairing
)
import
Gargantext.Database.Action.Flow.Types
(
FlowCmdM
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Prelude
(
Ord
,
Eq
,
(
<$>
),
(
$
),
liftBase
,
(
.
),
printDebug
,
pure
,
show
,
cs
,
(
<>
),
panic
)
import
Prelude
(
Enum
,
Bounded
,
minBound
,
maxBound
)
import
Servant
import
Servant.Job.Async
(
JobFunction
(
..
),
serveJobsAPI
)
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck.Arbitrary
import
qualified
Data.Set
as
Set
------------------------------------------------------------------------
type
API
=
Summary
" Update node according to NodeType params"
...
...
@@ -112,6 +118,30 @@ updateNode _uId nid1 (LinkNodeReq nt nid2) logStatus = do
,
_scst_events
=
Just
[]
}
updateNode
_uId
nId
(
UpdateNodeParamsList
_mode
)
logStatus
=
do
logStatus
JobLog
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
2
,
_scst_events
=
Just
[]
}
corpusId
<-
view
node_parent_id
<$>
getNode
nId
logStatus
JobLog
{
_scst_succeeded
=
Just
2
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
1
,
_scst_events
=
Just
[]
}
_
<-
case
corpusId
of
Just
cId
->
reIndexWith
cId
nId
NgramsTerms
(
Set
.
singleton
MapTerm
)
Nothing
->
pure
()
pure
JobLog
{
_scst_succeeded
=
Just
3
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_events
=
Just
[]
}
updateNode
_uId
_nId
_p
logStatus
=
do
simuLogs
logStatus
10
...
...
src/Gargantext/Core/Viz/Graph/API.hs
View file @
6507a2d2
...
...
@@ -43,7 +43,7 @@ import Gargantext.Database.Query.Table.Node.Select
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateHyperdata
)
import
Gargantext.Database.Query.Table.Node.User
(
getNodeUser
)
import
Gargantext.Database.Schema.Ngrams
import
Gargantext.Database.Schema.Node
(
node_parent
Id
,
node_hyperdata
,
node_name
,
node_userI
d
)
import
Gargantext.Database.Schema.Node
(
node_parent
_id
,
node_hyperdata
,
node_name
,
node_user_i
d
)
import
Gargantext.Prelude
import
Servant
import
Servant.Job.Async
...
...
@@ -87,7 +87,7 @@ getGraph _uId nId = do
camera
=
nodeGraph
^.
node_hyperdata
.
hyperdataCamera
cId
=
maybe
(
panic
"[G.V.G.API] Node has no parent"
)
identity
$
nodeGraph
^.
node_parent
I
d
$
nodeGraph
^.
node_parent
_i
d
-- TODO Distance in Graph params
case
graph
of
...
...
@@ -123,7 +123,7 @@ recomputeGraph _uId nId maybeDistance = do
v
=
repo
^.
r_version
cId
=
maybe
(
panic
"[G.V.G.API.recomputeGraph] Node has no parent"
)
identity
$
nodeGraph
^.
node_parent
I
d
$
nodeGraph
^.
node_parent
_i
d
similarity
=
case
graphMetric
of
Nothing
->
withMetric
Order2
Just
m
->
withMetric
m
...
...
@@ -269,7 +269,7 @@ graphClone uId pId (HyperdataGraphAPI { _hyperdataAPIGraph = graph
let
nodeType
=
NodeGraph
nodeUser
<-
getNodeUser
(
NodeId
uId
)
nodeParent
<-
getNodeWith
pId
(
Proxy
::
Proxy
HyperdataGraph
)
let
uId'
=
nodeUser
^.
node_user
I
d
let
uId'
=
nodeUser
^.
node_user
_i
d
nIds
<-
mkNodeWithParent
nodeType
(
Just
pId
)
uId'
$
nodeParent
^.
node_name
case
nIds
of
[]
->
pure
pId
...
...
src/Gargantext/Core/Viz/Phylo/Legacy/LegacyMain.hs
View file @
6507a2d2
...
...
@@ -65,14 +65,6 @@ flowPhylo cId = do
-- | To filter the Ngrams of a document based on the termList
filterTerms
::
Patterns
->
(
Date
,
Text
)
->
(
Date
,
[
Text
])
filterTerms
patterns'
(
y
,
d
)
=
(
y
,
termsInText
patterns'
d
)
where
--------------------------------------
termsInText
::
Patterns
->
Text
->
[
Text
]
termsInText
pats
txt
=
List
.
nub
$
List
.
concat
$
map
(
map
Text
.
unwords
)
$
extractTermsWithList
pats
txt
--------------------------------------
docs
=
map
((
\
(
y
,
t
)
->
Document
y
t
)
.
filterTerms
patterns
)
docs'
...
...
src/Gargantext/Database/Action/Delete.hs
View file @
6507a2d2
...
...
@@ -47,7 +47,7 @@ deleteNode u nodeId = do
nt
|
nt
==
toDBid
NodeUser
->
panic
"Not allowed to delete NodeUser (yet)"
nt
|
nt
==
toDBid
NodeTeam
->
do
uId
<-
getUserId
u
if
_node_user
I
d
node'
==
uId
if
_node_user
_i
d
node'
==
uId
then
N
.
deleteNode
nodeId
else
delFolderTeam
u
nodeId
nt
|
nt
==
toDBid
NodeFile
->
do
...
...
@@ -62,7 +62,7 @@ deleteNode u nodeId = do
-- else if hasNodeType node' NodeTeam
-- then do
-- uId <- getUserId u
-- if _node_user
I
d node' == uId
-- if _node_user
_i
d node' == uId
-- then N.deleteNode nodeId
-- else delFolderTeam u nodeId
-- else N.deleteNode nodeId
src/Gargantext/Database/Action/Share.hs
View file @
6507a2d2
...
...
@@ -49,7 +49,7 @@ shareNodeWith (ShareNodeWith_User NodeFolderShared u) n = do
if
not
(
hasNodeType
nodeToCheck
NodeTeam
)
then
errorWith
"[G.D.A.S.shareNodeWith] Can share node Team only"
else
if
(
view
node_user
I
d
nodeToCheck
==
userIdCheck
)
if
(
view
node_user
_i
d
nodeToCheck
==
userIdCheck
)
then
errorWith
"[G.D.A.S.shareNodeWith] Can share to others only"
else
do
folderSharedId
<-
getFolderId
u
NodeFolderShared
...
...
src/Gargantext/Database/Action/User.hs
View file @
6507a2d2
...
...
@@ -53,7 +53,7 @@ getUserId' :: HasNodeError err
getUserId'
(
UserDBId
uid
)
=
pure
(
Just
uid
)
getUserId'
(
RootId
rid
)
=
do
n
<-
getNode
rid
pure
$
Just
$
_node_user
I
d
n
pure
$
Just
$
_node_user
_i
d
n
getUserId'
(
UserName
u
)
=
do
muser
<-
getUser
u
case
muser
of
...
...
@@ -77,7 +77,7 @@ getUsername (UserDBId i) = do
Nothing
->
nodeError
$
NodeError
"G.D.A.U.getUserName: User not found with that id"
getUsername
(
RootId
rid
)
=
do
n
<-
getNode
rid
getUsername
(
UserDBId
$
_node_user
I
d
n
)
getUsername
(
UserDBId
$
_node_user
_i
d
n
)
getUsername
UserPublic
=
pure
"UserPublic"
--------------------------------------------------------------------------
...
...
src/Gargantext/Database/Query/Table/Node.hs
View file @
6507a2d2
...
...
@@ -264,10 +264,10 @@ insertNodesR ns = mkCmd $ \conn ->
runInsert_
conn
(
Insert
nodeTable
ns
(
rReturning
(
\
(
Node
i
_
_
_
_
_
_
_
)
->
i
))
Nothing
)
insertNodesWithParent
::
Maybe
ParentId
->
[
NodeWrite
]
->
Cmd
err
Int64
insertNodesWithParent
pid
ns
=
insertNodes
(
set
node_parent
I
d
(
pgNodeId
<$>
pid
)
<$>
ns
)
insertNodesWithParent
pid
ns
=
insertNodes
(
set
node_parent
_i
d
(
pgNodeId
<$>
pid
)
<$>
ns
)
insertNodesWithParentR
::
Maybe
ParentId
->
[
NodeWrite
]
->
Cmd
err
[
NodeId
]
insertNodesWithParentR
pid
ns
=
insertNodesR
(
set
node_parent
I
d
(
pgNodeId
<$>
pid
)
<$>
ns
)
insertNodesWithParentR
pid
ns
=
insertNodesR
(
set
node_parent
_i
d
(
pgNodeId
<$>
pid
)
<$>
ns
)
------------------------------------------------------------------------
-- TODO
-- currently this function removes the child relation
...
...
src/Gargantext/Database/Query/Table/Node/Select.hs
View file @
6507a2d2
...
...
@@ -38,5 +38,5 @@ selectNodesWithUsername nt u = runOpaQuery (q u)
join'
::
Query
(
NodeRead
,
UserReadNull
)
join'
=
leftJoin
queryNodeTable
queryUserTable
on1
where
on1
(
n
,
us
)
=
_node_user
I
d
n
.==
user_id
us
on1
(
n
,
us
)
=
_node_user
_i
d
n
.==
user_id
us
src/Gargantext/Database/Query/Tree.hs
View file @
6507a2d2
...
...
@@ -182,7 +182,7 @@ findSharedDirect r nt nts fun = do
-- , " "
-- , s ]
parent
<-
getNodeWith
r
(
Proxy
::
Proxy
HyperdataAny
)
let
mParent
=
_node_parent
I
d
parent
let
mParent
=
_node_parent
_i
d
parent
case
mParent
of
Nothing
->
pure
[]
Just
parentId
->
do
...
...
src/Gargantext/Database/Query/Tree/Root.hs
View file @
6507a2d2
...
...
@@ -121,13 +121,13 @@ selectRoot (UserName username) = proc () -> do
users
<-
queryUserTable
-<
()
restrict
-<
_node_typename
row
.==
(
pgInt4
$
toDBid
NodeUser
)
restrict
-<
user_username
users
.==
(
pgStrictText
username
)
restrict
-<
_node_user
I
d
row
.==
(
user_id
users
)
restrict
-<
_node_user
_i
d
row
.==
(
user_id
users
)
returnA
-<
row
selectRoot
(
UserDBId
uid
)
=
proc
()
->
do
row
<-
queryNodeTable
-<
()
restrict
-<
_node_typename
row
.==
(
pgInt4
$
toDBid
NodeUser
)
restrict
-<
_node_user
I
d
row
.==
(
pgInt4
uid
)
restrict
-<
_node_user
_i
d
row
.==
(
pgInt4
uid
)
returnA
-<
row
selectRoot
(
RootId
nid
)
=
...
...
src/Gargantext/Database/Schema/Node.hs
View file @
6507a2d2
...
...
@@ -28,8 +28,8 @@ import Prelude hiding (null, id, map, sum)
data
NodePoly
id
hash_id
typename
user
I
d
parent
I
d
user
_i
d
parent
_i
d
name
date
hyperdata
=
...
...
@@ -37,8 +37,8 @@ data NodePoly id
,
_node_hash_id
::
!
hash_id
,
_node_typename
::
!
typename
,
_node_user
Id
::
!
userI
d
,
_node_parent
Id
::
!
parentI
d
,
_node_user
_id
::
!
user_i
d
,
_node_parent
_id
::
!
parent_i
d
,
_node_name
::
!
name
,
_node_date
::
!
date
...
...
@@ -58,9 +58,9 @@ nodeTable :: Table NodeWrite NodeRead
nodeTable
=
Table
"nodes"
(
pNode
Node
{
_node_id
=
optional
"id"
,
_node_hash_id
=
optional
"hash_id"
,
_node_typename
=
required
"typename"
,
_node_user
Id
=
required
"user_id"
,
_node_user
_id
=
required
"user_id"
,
_node_parent
Id
=
optional
"parent_id"
,
_node_parent
_id
=
optional
"parent_id"
,
_node_name
=
required
"name"
,
_node_date
=
optional
"date"
...
...
@@ -146,11 +146,11 @@ data NodePolySearch id
search
=
NodeSearch
{
_ns_id
::
id
,
_ns_typename
::
typename
,
_ns_user
Id
::
userI
d
,
_ns_user
_id
::
user_i
d
-- , nodeUniqId :: shaId
,
_ns_parent
Id
::
parentI
d
,
_ns_name
::
name
,
_ns_date
::
date
,
_ns_parent
_id
::
parent_i
d
,
_ns_name
::
name
,
_ns_date
::
date
,
_ns_hyperdata
::
hyperdata
,
_ns_search
::
search
...
...
@@ -165,9 +165,9 @@ nodeTableSearch :: Table NodeSearchWrite NodeSearchRead
nodeTableSearch
=
Table
"nodes"
(
pNodeSearch
NodeSearch
{
_ns_id
=
optional
"id"
,
_ns_typename
=
required
"typename"
,
_ns_user
Id
=
required
"user_id"
,
_ns_user
_id
=
required
"user_id"
,
_ns_parent
Id
=
required
"parent_id"
,
_ns_parent
_id
=
required
"parent_id"
,
_ns_name
=
required
"name"
,
_ns_date
=
optional
"date"
...
...
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