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
5b3282a4
Commit
5b3282a4
authored
Aug 24, 2022
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
[FEAT] Score Column
parents
e93ff2e8
d669e7da
Pipeline
#3110
canceled with stage
Changes
1
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
123 additions
and
10 deletions
+123
-10
NodeNode.hs
src/Gargantext/Database/Query/Table/NodeNode.hs
+123
-10
No files found.
src/Gargantext/Database/Query/Table/NodeNode.hs
View file @
5b3282a4
...
@@ -19,27 +19,35 @@ commentary with @some markup@.
...
@@ -19,27 +19,35 @@ commentary with @some markup@.
module
Gargantext.Database.Query.Table.NodeNode
module
Gargantext.Database.Query.Table.NodeNode
(
module
Gargantext
.
Database
.
Schema
.
NodeNode
(
module
Gargantext
.
Database
.
Schema
.
NodeNode
,
queryNodeNodeTabl
e
,
deleteNodeNod
e
,
getNodeNode
,
getNodeNode
,
insertNodeNode
,
insertNodeNode
,
deleteNodeNode
,
nodeNodesCategory
,
nodeNodesScore
,
queryNodeNodeTable
,
selectDocNodes
,
selectDocs
,
selectDocsDates
,
selectPublicNodes
,
selectPublicNodes
)
)
where
where
import
Control.Arrow
(
returnA
)
import
Control.Arrow
(
returnA
)
import
Control.Lens
((
^.
))
import
Control.Lens
((
^.
),
view
)
import
qualified
Opaleye
as
O
import
Data.Text
(
Text
,
splitOn
)
import
Opaleye
import
Data.Maybe
(
catMaybes
)
import
Database.PostgreSQL.Simple.SqlQQ
(
sql
)
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
Gargantext.Core
import
Gargantext.Core
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Gargantext.Database.Schema.NodeNode
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.NodeNode
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Opaleye
import
qualified
Database.PostgreSQL.Simple
as
PGS
import
qualified
Opaleye
as
O
queryNodeNodeTable
::
Select
NodeNodeRead
queryNodeNodeTable
::
Select
NodeNodeRead
queryNodeNodeTable
=
selectTable
nodeNodeTable
queryNodeNodeTable
=
selectTable
nodeNodeTable
...
@@ -113,8 +121,113 @@ deleteNodeNode n1 n2 = mkCmd $ \conn ->
...
@@ -113,8 +121,113 @@ deleteNodeNode n1 n2 = mkCmd $ \conn ->
)
)
------------------------------------------------------------------------
------------------------------------------------------------------------
selectPublicNodes
::
HasDBid
NodeType
-- | Favorite management
=>
(
Hyperdata
a
,
DefaultFromField
SqlJsonb
a
)
_nodeNodeCategory
::
CorpusId
->
DocId
->
Int
->
Cmd
err
[
Int
]
_nodeNodeCategory
cId
dId
c
=
map
(
\
(
PGS
.
Only
a
)
->
a
)
<$>
runPGSQuery
favQuery
(
c
,
cId
,
dId
)
where
favQuery
::
PGS
.
Query
favQuery
=
[
sql
|
UPDATE nodes_nodes SET category = ?
WHERE node1_id = ? AND node2_id = ?
RETURNING node2_id;
|]
nodeNodesCategory
::
[(
CorpusId
,
DocId
,
Int
)]
->
Cmd
err
[
Int
]
nodeNodesCategory
inputData
=
map
(
\
(
PGS
.
Only
a
)
->
a
)
<$>
runPGSQuery
catQuery
(
PGS
.
Only
$
Values
fields
inputData
)
where
fields
=
map
(
\
t
->
QualifiedIdentifier
Nothing
t
)
[
"int4"
,
"int4"
,
"int4"
]
catQuery
::
PGS
.
Query
catQuery
=
[
sql
|
UPDATE nodes_nodes as nn0
SET category = nn1.category
FROM (?) as nn1(node1_id,node2_id,category)
WHERE nn0.node1_id = nn1.node1_id
AND nn0.node2_id = nn1.node2_id
RETURNING nn1.node2_id
|]
------------------------------------------------------------------------
-- | Score management
_nodeNodeScore
::
CorpusId
->
DocId
->
Int
->
Cmd
err
[
Int
]
_nodeNodeScore
cId
dId
c
=
map
(
\
(
PGS
.
Only
a
)
->
a
)
<$>
runPGSQuery
scoreQuery
(
c
,
cId
,
dId
)
where
scoreQuery
::
PGS
.
Query
scoreQuery
=
[
sql
|
UPDATE nodes_nodes SET score = ?
WHERE node1_id = ? AND node2_id = ?
RETURNING node2_id;
|]
nodeNodesScore
::
[(
CorpusId
,
DocId
,
Int
)]
->
Cmd
err
[
Int
]
nodeNodesScore
inputData
=
map
(
\
(
PGS
.
Only
a
)
->
a
)
<$>
runPGSQuery
catScore
(
PGS
.
Only
$
Values
fields
inputData
)
where
fields
=
map
(
\
t
->
QualifiedIdentifier
Nothing
t
)
[
"int4"
,
"int4"
,
"int4"
]
catScore
::
PGS
.
Query
catScore
=
[
sql
|
UPDATE nodes_nodes as nn0
SET score = nn1.score
FROM (?) as nn1(node1_id, node2_id, score)
WHERE nn0.node1_id = nn1.node1_id
AND nn0.node2_id = nn1.node2_id
RETURNING nn1.node2_id
|]
------------------------------------------------------------------------
_selectCountDocs
::
HasDBid
NodeType
=>
CorpusId
->
Cmd
err
Int
_selectCountDocs
cId
=
runCountOpaQuery
(
queryCountDocs
cId
)
where
queryCountDocs
cId'
=
proc
()
->
do
(
n
,
nn
)
<-
joinInCorpus
-<
()
restrict
-<
nn
^.
nn_node1_id
.==
(
toNullable
$
pgNodeId
cId'
)
restrict
-<
nn
^.
nn_category
.>=
(
toNullable
$
sqlInt4
1
)
restrict
-<
n
^.
node_typename
.==
(
sqlInt4
$
toDBid
NodeDocument
)
returnA
-<
n
-- | TODO use UTCTime fast
selectDocsDates
::
HasDBid
NodeType
=>
CorpusId
->
Cmd
err
[
Text
]
selectDocsDates
cId
=
map
(
head'
"selectDocsDates"
.
splitOn
"-"
)
<$>
catMaybes
<$>
map
(
view
hd_publication_date
)
<$>
selectDocs
cId
selectDocs
::
HasDBid
NodeType
=>
CorpusId
->
Cmd
err
[
HyperdataDocument
]
selectDocs
cId
=
runOpaQuery
(
queryDocs
cId
)
queryDocs
::
HasDBid
NodeType
=>
CorpusId
->
O
.
Select
(
Column
SqlJsonb
)
queryDocs
cId
=
proc
()
->
do
(
n
,
nn
)
<-
joinInCorpus
-<
()
restrict
-<
nn
^.
nn_node1_id
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
nn
^.
nn_category
.>=
(
toNullable
$
sqlInt4
1
)
restrict
-<
n
^.
node_typename
.==
(
sqlInt4
$
toDBid
NodeDocument
)
returnA
-<
view
(
node_hyperdata
)
n
selectDocNodes
::
HasDBid
NodeType
=>
CorpusId
->
Cmd
err
[
Node
HyperdataDocument
]
selectDocNodes
cId
=
runOpaQuery
(
queryDocNodes
cId
)
queryDocNodes
::
HasDBid
NodeType
=>
CorpusId
->
O
.
Select
NodeRead
queryDocNodes
cId
=
proc
()
->
do
(
n
,
nn
)
<-
joinInCorpus
-<
()
restrict
-<
nn
^.
nn_node1_id
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
nn
^.
nn_category
.>=
(
toNullable
$
sqlInt4
1
)
restrict
-<
n
^.
node_typename
.==
(
sqlInt4
$
toDBid
NodeDocument
)
returnA
-<
n
joinInCorpus
::
O
.
Select
(
NodeRead
,
NodeNodeReadNull
)
joinInCorpus
=
leftJoin
queryNodeTable
queryNodeNodeTable
cond
where
cond
::
(
NodeRead
,
NodeNodeRead
)
->
Column
SqlBool
cond
(
n
,
nn
)
=
nn
^.
nn_node2_id
.==
(
view
node_id
n
)
_joinOn1
::
O
.
Select
(
NodeRead
,
NodeNodeReadNull
)
_joinOn1
=
leftJoin
queryNodeTable
queryNodeNodeTable
cond
where
cond
::
(
NodeRead
,
NodeNodeRead
)
->
Column
SqlBool
cond
(
n
,
nn
)
=
nn
^.
nn_node1_id
.==
n
^.
node_id
------------------------------------------------------------------------
selectPublicNodes
::
HasDBid
NodeType
=>
(
Hyperdata
a
,
DefaultFromField
SqlJsonb
a
)
=>
Cmd
err
[(
Node
a
,
Maybe
Int
)]
=>
Cmd
err
[(
Node
a
,
Maybe
Int
)]
selectPublicNodes
=
runOpaQuery
(
queryWithType
NodeFolderPublic
)
selectPublicNodes
=
runOpaQuery
(
queryWithType
NodeFolderPublic
)
...
...
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