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
64dbad9e
Commit
64dbad9e
authored
Sep 30, 2021
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'dev-merge' into dev
parents
1667c63e
b9028127
Changes
44
Show whitespace changes
Inline
Side-by-side
Showing
44 changed files
with
401 additions
and
313 deletions
+401
-313
docker-compose.yaml
devops/docker/docker-compose.yaml
+2
-1
schema.sql
devops/postgres/schema.sql
+4
-1
0.0.4.sql
devops/postgres/upgrade/0.0.4.sql
+12
-0
Graph.hs
src/Gargantext/Core/Viz/Graph.hs
+2
-2
Flow.hs
src/Gargantext/Database/Action/Flow.hs
+1
-1
Pairing.hs
src/Gargantext/Database/Action/Flow/Pairing.hs
+1
-1
Search.hs
src/Gargantext/Database/Action/Search.hs
+12
-80
TSQuery.hs
src/Gargantext/Database/Action/TSQuery.hs
+78
-0
Any.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Any.hs
+2
-2
Contact.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs
+4
-4
Corpus.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Corpus.hs
+4
-4
Dashboard.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Dashboard.hs
+2
-2
Document.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Document.hs
+4
-4
File.hs
src/Gargantext/Database/Admin/Types/Hyperdata/File.hs
+2
-2
Frame.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Frame.hs
+2
-2
List.hs
src/Gargantext/Database/Admin/Types/Hyperdata/List.hs
+4
-4
Model.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Model.hs
+2
-2
Phylo.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Phylo.hs
+2
-2
Prelude.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Prelude.hs
+1
-1
Texts.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Texts.hs
+2
-2
User.hs
src/Gargantext/Database/Admin/Types/Hyperdata/User.hs
+6
-6
Node.hs
src/Gargantext/Database/Admin/Types/Node.hs
+48
-27
Prelude.hs
src/Gargantext/Database/Prelude.hs
+5
-5
Facet.hs
src/Gargantext/Database/Query/Facet.hs
+45
-16
Ngrams.hs
src/Gargantext/Database/Query/Table/Ngrams.hs
+1
-1
Node.hs
src/Gargantext/Database/Query/Table/Node.hs
+21
-15
Children.hs
src/Gargantext/Database/Query/Table/Node/Children.hs
+1
-1
Select.hs
src/Gargantext/Database/Query/Table/Node/Select.hs
+2
-2
NodeNode.hs
src/Gargantext/Database/Query/Table/NodeNode.hs
+18
-14
NodeNodeNgrams.hs
src/Gargantext/Database/Query/Table/NodeNodeNgrams.hs
+2
-2
NodeNodeNgrams2.hs
src/Gargantext/Database/Query/Table/NodeNodeNgrams2.hs
+2
-2
Node_NodeNgramsNodeNgrams.hs
...gantext/Database/Query/Table/Node_NodeNgramsNodeNgrams.hs
+3
-3
NodesNgramsRepo.hs
src/Gargantext/Database/Query/Table/NodesNgramsRepo.hs
+2
-2
User.hs
src/Gargantext/Database/Query/Table/User.hs
+14
-14
Root.hs
src/Gargantext/Database/Query/Tree/Root.hs
+6
-6
Ngrams.hs
src/Gargantext/Database/Schema/Ngrams.hs
+6
-6
Node.hs
src/Gargantext/Database/Schema/Node.hs
+29
-27
NodeNode.hs
src/Gargantext/Database/Schema/NodeNode.hs
+14
-14
NodeNodeNgrams.hs
src/Gargantext/Database/Schema/NodeNodeNgrams.hs
+5
-5
NodeNodeNgrams2.hs
src/Gargantext/Database/Schema/NodeNodeNgrams2.hs
+3
-3
Node_NodeNgramsNodeNgrams.hs
src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs
+8
-8
NodesNgramsRepo.hs
src/Gargantext/Database/Schema/NodesNgramsRepo.hs
+4
-4
User.hs
src/Gargantext/Database/Schema/User.hs
+11
-11
stack.yaml
stack.yaml
+2
-2
No files found.
devops/docker/docker-compose.yaml
View file @
64dbad9e
...
@@ -2,7 +2,8 @@ version: '3'
...
@@ -2,7 +2,8 @@ version: '3'
services
:
services
:
postgres
:
postgres
:
image
:
'
postgres:latest'
#image: 'postgres:latest'
image
:
'
postgres:11'
network_mode
:
host
network_mode
:
host
#ports:
#ports:
#- 5432:5432
#- 5432:5432
...
...
devops/postgres/schema.sql
View file @
64dbad9e
...
@@ -38,6 +38,9 @@ CREATE TABLE public.nodes (
...
@@ -38,6 +38,9 @@ CREATE TABLE public.nodes (
FOREIGN
KEY
(
user_id
)
REFERENCES
public
.
auth_user
(
id
)
ON
DELETE
CASCADE
FOREIGN
KEY
(
user_id
)
REFERENCES
public
.
auth_user
(
id
)
ON
DELETE
CASCADE
);
);
ALTER
TABLE
public
.
nodes
OWNER
TO
gargantua
;
ALTER
TABLE
public
.
nodes
OWNER
TO
gargantua
;
ALTER
TABLE
nodes
ADD
COLUMN
search_title
tsvector
;
UPDATE
nodes
SET
search_title
=
to_tsvector
(
'english'
,
coalesce
(
"hyperdata"
->>
'title'
,
''
)
||
' '
||
coalesce
(
"hyperdata"
->>
'abstract'
,
''
));
CREATE
INDEX
search_title_idx
ON
nodes
USING
GIN
(
search_title
);
--------------------------------------------------------------
--------------------------------------------------------------
-- | Ngrams
-- | Ngrams
...
@@ -207,5 +210,5 @@ CREATE OR REPLACE function node_pos(int, int) returns bigint
...
@@ -207,5 +210,5 @@ CREATE OR REPLACE function node_pos(int, int) returns bigint
LANGUAGE
SQL
immutable
;
LANGUAGE
SQL
immutable
;
--drop index node_by_pos;
--drop index node_by_pos;
create
index
node_by_pos
on
nodes
using
btree
(
node_pos
(
id
,
typename
));
--
create index node_by_pos on nodes using btree(node_pos(id,typename));
devops/postgres/upgrade/0.0.4.sql
0 → 100644
View file @
64dbad9e
ALTER
TABLE
nodes
DROP
COLUMN
IF
EXISTS
search_title
,
DROP
COLUMN
IF
EXISTS
tsvector
;
ALTER
TABLE
nodes
ADD
COLUMN
search_title
tsvector
;
UPDATE
nodes
SET
search_title
=
to_tsvector
(
'english'
,
coalesce
(
"hyperdata"
->>
'title'
,
''
)
||
' '
||
coalesce
(
"hyperdata"
->>
'abstract'
,
''
));
CREATE
INDEX
search_title_idx
ON
nodes
USING
GIN
(
search_title
);
src/Gargantext/Core/Viz/Graph.hs
View file @
64dbad9e
...
@@ -188,9 +188,9 @@ instance FromField HyperdataGraph
...
@@ -188,9 +188,9 @@ instance FromField HyperdataGraph
where
where
fromField
=
fromField'
fromField
=
fromField'
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataGraph
instance
DefaultFromField
PGJsonb
HyperdataGraph
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
-----------------------------------------------------------
-----------------------------------------------------------
-- This type is used to return graph via API
-- This type is used to return graph via API
...
...
src/Gargantext/Database/Action/Flow.hs
View file @
64dbad9e
...
@@ -102,7 +102,7 @@ import qualified Gargantext.Core.Text.Corpus.API as API
...
@@ -102,7 +102,7 @@ import qualified Gargantext.Core.Text.Corpus.API as API
import
qualified
Gargantext.Database.Query.Table.Node.Document.Add
as
Doc
(
add
)
import
qualified
Gargantext.Database.Query.Table.Node.Document.Add
as
Doc
(
add
)
------------------------------------------------------------------------
------------------------------------------------------------------------
-- Impots for upgrade function
-- Impo
r
ts for upgrade function
import
Gargantext.Database.Query.Tree.Root
(
getRootId
)
import
Gargantext.Database.Query.Tree.Root
(
getRootId
)
import
Gargantext.Database.Query.Tree
(
findNodesId
)
import
Gargantext.Database.Query.Tree
(
findNodesId
)
import
qualified
Data.List
as
List
import
qualified
Data.List
as
List
...
...
src/Gargantext/Database/Action/Flow/Pairing.hs
View file @
64dbad9e
...
@@ -55,7 +55,7 @@ isPairedWith nId nt = runOpaQuery (selectQuery nt nId)
...
@@ -55,7 +55,7 @@ isPairedWith nId nt = runOpaQuery (selectQuery nt nId)
selectQuery
::
NodeType
->
NodeId
->
Query
(
Column
PGInt4
)
selectQuery
::
NodeType
->
NodeId
->
Query
(
Column
PGInt4
)
selectQuery
nt'
nId'
=
proc
()
->
do
selectQuery
nt'
nId'
=
proc
()
->
do
(
node
,
node_node
)
<-
queryJoin
-<
()
(
node
,
node_node
)
<-
queryJoin
-<
()
restrict
-<
(
node
^.
node_typename
)
.==
(
pg
Int4
$
toDBid
nt'
)
restrict
-<
(
node
^.
node_typename
)
.==
(
sql
Int4
$
toDBid
nt'
)
restrict
-<
(
node_node
^.
nn_node1_id
)
.==
(
toNullable
$
pgNodeId
nId'
)
restrict
-<
(
node_node
^.
nn_node1_id
)
.==
(
toNullable
$
pgNodeId
nId'
)
returnA
-<
node
^.
node_id
returnA
-<
node
^.
node_id
...
...
src/Gargantext/Database/Action/Search.hs
View file @
64dbad9e
...
@@ -14,18 +14,13 @@ module Gargantext.Database.Action.Search where
...
@@ -14,18 +14,13 @@ module Gargantext.Database.Action.Search where
import
Control.Arrow
(
returnA
)
import
Control.Arrow
(
returnA
)
import
Control.Lens
((
^.
))
import
Control.Lens
((
^.
))
import
Data.Aeson
import
Data.List
(
intersperse
)
import
Data.Maybe
import
Data.Maybe
import
Data.String
(
IsString
(
..
))
import
Data.Text
(
Text
,
unpack
,
intercalate
)
import
Data.Text
(
Text
,
words
,
unpack
,
intercalate
)
import
Data.Time
(
UTCTime
)
import
Data.Time
(
UTCTime
)
import
Database.PostgreSQL.Simple
(
Query
)
import
Database.PostgreSQL.Simple.ToField
import
Gargantext.Core
import
Gargantext.Core
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataDocument
(
..
),
HyperdataContact
(
..
))
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataDocument
(
..
),
HyperdataContact
(
..
))
import
Gargantext.Database.Prelude
(
Cmd
,
run
PGSQuery
,
run
OpaQuery
,
runCountOpaQuery
)
import
Gargantext.Database.Prelude
(
Cmd
,
runOpaQuery
,
runCountOpaQuery
)
import
Gargantext.Database.Query.Facet
import
Gargantext.Database.Query.Facet
import
Gargantext.Database.Query.Filter
import
Gargantext.Database.Query.Filter
import
Gargantext.Database.Query.Join
(
leftJoin5
)
import
Gargantext.Database.Query.Join
(
leftJoin5
)
...
@@ -43,14 +38,14 @@ searchDocInDatabase :: HasDBid NodeType
...
@@ -43,14 +38,14 @@ searchDocInDatabase :: HasDBid NodeType
=>
ParentId
=>
ParentId
->
Text
->
Text
->
Cmd
err
[(
NodeId
,
HyperdataDocument
)]
->
Cmd
err
[(
NodeId
,
HyperdataDocument
)]
searchDocInDatabase
p
t
=
runOpaQuery
(
queryDocInDatabase
p
t
)
searchDocInDatabase
_p
t
=
runOpaQuery
(
queryDocInDatabase
t
)
where
where
-- | Global search query where ParentId is Master Node Corpus Id
-- | Global search query where ParentId is Master Node Corpus Id
queryDocInDatabase
::
ParentId
->
Text
->
O
.
Query
(
Column
PGInt4
,
Column
PGJsonb
)
queryDocInDatabase
::
Text
->
O
.
Query
(
Column
PGInt4
,
Column
PGJsonb
)
queryDocInDatabase
_
q
=
proc
()
->
do
queryDocInDatabase
q
=
proc
()
->
do
row
<-
queryNodeSearchTable
-<
()
row
<-
queryNodeSearchTable
-<
()
restrict
-<
(
_ns_search
row
)
@@
(
pgTSQuery
(
unpack
q
))
restrict
-<
(
_ns_search
row
)
@@
(
pgTSQuery
(
unpack
q
))
restrict
-<
(
_ns_typename
row
)
.==
(
pg
Int4
$
toDBid
NodeDocument
)
restrict
-<
(
_ns_typename
row
)
.==
(
sql
Int4
$
toDBid
NodeDocument
)
returnA
-<
(
_ns_id
row
,
_ns_hyperdata
row
)
returnA
-<
(
_ns_id
row
,
_ns_hyperdata
row
)
------------------------------------------------------------------------
------------------------------------------------------------------------
...
@@ -88,10 +83,10 @@ queryInCorpus cId t q = proc () -> do
...
@@ -88,10 +83,10 @@ queryInCorpus cId t q = proc () -> do
(
n
,
nn
)
<-
joinInCorpus
-<
()
(
n
,
nn
)
<-
joinInCorpus
-<
()
restrict
-<
(
nn
^.
nn_node1_id
)
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
(
nn
^.
nn_node1_id
)
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
if
t
restrict
-<
if
t
then
(
nn
^.
nn_category
)
.==
(
toNullable
$
pg
Int4
0
)
then
(
nn
^.
nn_category
)
.==
(
toNullable
$
sql
Int4
0
)
else
(
nn
^.
nn_category
)
.>=
(
toNullable
$
pg
Int4
1
)
else
(
nn
^.
nn_category
)
.>=
(
toNullable
$
sql
Int4
1
)
restrict
-<
(
n
^.
ns_search
)
@@
(
pgTSQuery
(
unpack
q
))
restrict
-<
(
n
^.
ns_search
)
@@
(
pgTSQuery
(
unpack
q
))
restrict
-<
(
n
^.
ns_typename
)
.==
(
pg
Int4
$
toDBid
NodeDocument
)
restrict
-<
(
n
^.
ns_typename
)
.==
(
sql
Int4
$
toDBid
NodeDocument
)
returnA
-<
FacetDoc
(
n
^.
ns_id
)
returnA
-<
FacetDoc
(
n
^.
ns_id
)
(
n
^.
ns_date
)
(
n
^.
ns_date
)
(
n
^.
ns_name
)
(
n
^.
ns_name
)
...
@@ -138,14 +133,14 @@ selectContactViaDoc
...
@@ -138,14 +133,14 @@ selectContactViaDoc
selectContactViaDoc
cId
aId
q
=
proc
()
->
do
selectContactViaDoc
cId
aId
q
=
proc
()
->
do
(
doc
,
(
corpus_doc
,
(
_contact_doc
,
(
annuaire_contact
,
contact
))))
<-
queryContactViaDoc
-<
()
(
doc
,
(
corpus_doc
,
(
_contact_doc
,
(
annuaire_contact
,
contact
))))
<-
queryContactViaDoc
-<
()
restrict
-<
(
doc
^.
ns_search
)
@@
(
pgTSQuery
$
unpack
q
)
restrict
-<
(
doc
^.
ns_search
)
@@
(
pgTSQuery
$
unpack
q
)
restrict
-<
(
doc
^.
ns_typename
)
.==
(
pg
Int4
$
toDBid
NodeDocument
)
restrict
-<
(
doc
^.
ns_typename
)
.==
(
sql
Int4
$
toDBid
NodeDocument
)
restrict
-<
(
corpus_doc
^.
nn_node1_id
)
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
(
corpus_doc
^.
nn_node1_id
)
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
(
annuaire_contact
^.
nn_node1_id
)
.==
(
toNullable
$
pgNodeId
aId
)
restrict
-<
(
annuaire_contact
^.
nn_node1_id
)
.==
(
toNullable
$
pgNodeId
aId
)
restrict
-<
(
contact
^.
node_typename
)
.==
(
toNullable
$
pg
Int4
$
toDBid
NodeContact
)
restrict
-<
(
contact
^.
node_typename
)
.==
(
toNullable
$
sql
Int4
$
toDBid
NodeContact
)
returnA
-<
(
contact
^.
node_id
returnA
-<
(
contact
^.
node_id
,
contact
^.
node_date
,
contact
^.
node_date
,
contact
^.
node_hyperdata
,
contact
^.
node_hyperdata
,
toNullable
$
pg
Int4
1
,
toNullable
$
sql
Int4
1
)
)
selectGroup
::
HasDBid
NodeType
selectGroup
::
HasDBid
NodeType
...
@@ -213,66 +208,3 @@ queryContactViaDoc =
...
@@ -213,66 +208,3 @@ queryContactViaDoc =
------------------------------------------------------------------------
------------------------------------------------------------------------
newtype
TSQuery
=
UnsafeTSQuery
[
Text
]
-- | TODO [""] -> panic "error"
toTSQuery
::
[
Text
]
->
TSQuery
toTSQuery
txt
=
UnsafeTSQuery
$
map
stemIt
txt
instance
IsString
TSQuery
where
fromString
=
UnsafeTSQuery
.
words
.
cs
instance
ToField
TSQuery
where
toField
(
UnsafeTSQuery
xs
)
=
Many
$
intersperse
(
Plain
" && "
)
$
map
(
\
q
->
Many
[
Plain
"plainto_tsquery("
,
Escape
(
cs
q
)
,
Plain
")"
]
)
xs
data
Order
=
Asc
|
Desc
instance
ToField
Order
where
toField
Asc
=
Plain
"ASC"
toField
Desc
=
Plain
"DESC"
-- TODO
-- FIX fav
-- ADD ngrams count
-- TESTS
textSearchQuery
::
Query
textSearchQuery
=
"SELECT n.id, n.hyperdata->'publication_year'
\
\
, n.hyperdata->'title'
\
\
, n.hyperdata->'source'
\
\
, n.hyperdata->'authors'
\
\
, COALESCE(nn.score,null)
\
\
FROM nodes n
\
\
LEFT JOIN nodes_nodes nn ON nn.node2_id = n.id
\
\
WHERE
\
\
n.search @@ (?::tsquery)
\
\
AND (n.parent_id = ? OR nn.node1_id = ?)
\
\
AND n.typename = ?
\
\
ORDER BY n.hyperdata -> 'publication_date' ?
\
\
offset ? limit ?;"
-- | Text Search Function for Master Corpus
-- TODO : text search for user corpus
-- Example:
-- textSearchTest :: ParentId -> TSQuery -> Cmd err [(Int, Value, Value, Value, Value, Maybe Int)]
-- textSearchTest pId q = textSearch q pId 5 0 Asc
textSearch
::
HasDBid
NodeType
=>
TSQuery
->
ParentId
->
Limit
->
Offset
->
Order
->
Cmd
err
[(
Int
,
Value
,
Value
,
Value
,
Value
,
Maybe
Int
)]
textSearch
q
p
l
o
ord
=
runPGSQuery
textSearchQuery
(
q
,
p
,
p
,
typeId
,
ord
,
o
,
l
)
where
typeId
=
toDBid
NodeDocument
src/Gargantext/Database/Action/TSQuery.hs
0 → 100644
View file @
64dbad9e
module
Gargantext.Database.Action.TSQuery
where
import
Data.Aeson
import
Data.List
(
intersperse
)
import
Data.Maybe
import
Data.String
(
IsString
(
..
))
import
Data.Text
(
Text
,
words
)
import
Database.PostgreSQL.Simple
(
Query
)
import
Database.PostgreSQL.Simple.ToField
import
Gargantext.Core
import
Gargantext.Core.Types
import
Gargantext.Database.Prelude
(
Cmd
,
runPGSQuery
)
import
Gargantext.Prelude
import
Gargantext.Core.Text.Terms.Mono.Stem.En
(
stemIt
)
newtype
TSQuery
=
UnsafeTSQuery
[
Text
]
-- | TODO [""] -> panic "error"
toTSQuery
::
[
Text
]
->
TSQuery
toTSQuery
txt
=
UnsafeTSQuery
$
map
stemIt
txt
instance
IsString
TSQuery
where
fromString
=
UnsafeTSQuery
.
words
.
cs
instance
ToField
TSQuery
where
toField
(
UnsafeTSQuery
xs
)
=
Many
$
intersperse
(
Plain
" && "
)
$
map
(
\
q
->
Many
[
Plain
"plainto_tsquery("
,
Escape
(
cs
q
)
,
Plain
")"
]
)
xs
data
Order
=
Asc
|
Desc
instance
ToField
Order
where
toField
Asc
=
Plain
"ASC"
toField
Desc
=
Plain
"DESC"
-- TODO
-- FIX fav
-- ADD ngrams count
-- TESTS
textSearchQuery
::
Query
textSearchQuery
=
"SELECT n.id, n.hyperdata->'publication_year'
\
\
, n.hyperdata->'title'
\
\
, n.hyperdata->'source'
\
\
, n.hyperdata->'authors'
\
\
, COALESCE(nn.score,null)
\
\
FROM nodes n
\
\
LEFT JOIN nodes_nodes nn ON nn.node2_id = n.id
\
\
WHERE
\
\
n.search @@ (?::tsquery)
\
\
AND (n.parent_id = ? OR nn.node1_id = ?)
\
\
AND n.typename = ?
\
\
ORDER BY n.hyperdata -> 'publication_date' ?
\
\
offset ? limit ?;"
-- | Text Search Function for Master Corpus
-- TODO : text search for user corpus
-- Example:
-- textSearchTest :: ParentId -> TSQuery -> Cmd err [(Int, Value, Value, Value, Value, Maybe Int)]
-- textSearchTest pId q = textSearch q pId 5 0 Asc
textSearch
::
HasDBid
NodeType
=>
TSQuery
->
ParentId
->
Limit
->
Offset
->
Order
->
Cmd
err
[(
Int
,
Value
,
Value
,
Value
,
Value
,
Maybe
Int
)]
textSearch
q
p
l
o
ord
=
runPGSQuery
textSearchQuery
(
q
,
p
,
p
,
typeId
,
ord
,
o
,
l
)
where
typeId
=
toDBid
NodeDocument
src/Gargantext/Database/Admin/Types/Hyperdata/Any.hs
View file @
64dbad9e
...
@@ -45,7 +45,7 @@ instance ToSchema HyperdataAny where
...
@@ -45,7 +45,7 @@ instance ToSchema HyperdataAny where
instance
FromField
HyperdataAny
where
instance
FromField
HyperdataAny
where
fromField
=
fromField'
fromField
=
fromField'
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataAny
instance
DefaultFromField
PGJsonb
HyperdataAny
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs
View file @
64dbad9e
...
@@ -166,12 +166,12 @@ instance FromField HyperdataContact where
...
@@ -166,12 +166,12 @@ instance FromField HyperdataContact where
fromField
=
fromField'
fromField
=
fromField'
-- | Database (Opaleye instance)
-- | Database (Opaleye instance)
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataContact
where
instance
DefaultFromField
PGJsonb
HyperdataContact
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
(
Nullable
PGJsonb
)
HyperdataContact
where
instance
DefaultFromField
(
Nullable
PGJsonb
)
HyperdataContact
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Corpus.hs
View file @
64dbad9e
...
@@ -90,10 +90,10 @@ instance FromField HyperdataAnnuaire
...
@@ -90,10 +90,10 @@ instance FromField HyperdataAnnuaire
where
where
fromField
=
fromField'
fromField
=
fromField'
------------------------------------------------------------------------
------------------------------------------------------------------------
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataCorpus
instance
DefaultFromField
PGJsonb
HyperdataCorpus
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataAnnuaire
instance
DefaultFromField
PGJsonb
HyperdataAnnuaire
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
src/Gargantext/Database/Admin/Types/Hyperdata/Dashboard.hs
View file @
64dbad9e
...
@@ -71,7 +71,7 @@ instance ToSchema HyperdataDashboard where
...
@@ -71,7 +71,7 @@ instance ToSchema HyperdataDashboard where
instance
FromField
HyperdataDashboard
where
instance
FromField
HyperdataDashboard
where
fromField
=
fromField'
fromField
=
fromField'
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataDashboard
instance
DefaultFromField
PGJsonb
HyperdataDashboard
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
src/Gargantext/Database/Admin/Types/Hyperdata/Document.hs
View file @
64dbad9e
...
@@ -202,11 +202,11 @@ instance ToField HyperdataDocumentV3 where
...
@@ -202,11 +202,11 @@ instance ToField HyperdataDocumentV3 where
toField
=
toJSONField
toField
=
toJSONField
------------------------------------------------------------------------
------------------------------------------------------------------------
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataDocument
instance
DefaultFromField
PGJsonb
HyperdataDocument
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataDocumentV3
instance
DefaultFromField
PGJsonb
HyperdataDocumentV3
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
------------------------------------------------------------------------
------------------------------------------------------------------------
src/Gargantext/Database/Admin/Types/Hyperdata/File.hs
View file @
64dbad9e
...
@@ -54,9 +54,9 @@ instance FromField HyperdataFile
...
@@ -54,9 +54,9 @@ instance FromField HyperdataFile
where
where
fromField
=
fromField'
fromField
=
fromField'
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataFile
instance
DefaultFromField
PGJsonb
HyperdataFile
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
ToSchema
HyperdataFile
where
instance
ToSchema
HyperdataFile
where
declareNamedSchema
proxy
=
declareNamedSchema
proxy
=
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Frame.hs
View file @
64dbad9e
...
@@ -53,9 +53,9 @@ instance FromField HyperdataFrame
...
@@ -53,9 +53,9 @@ instance FromField HyperdataFrame
where
where
fromField
=
fromField'
fromField
=
fromField'
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataFrame
instance
DefaultFromField
PGJsonb
HyperdataFrame
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
ToSchema
HyperdataFrame
where
instance
ToSchema
HyperdataFrame
where
declareNamedSchema
proxy
=
declareNamedSchema
proxy
=
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/List.hs
View file @
64dbad9e
...
@@ -98,12 +98,12 @@ instance FromField HyperdataListCooc
...
@@ -98,12 +98,12 @@ instance FromField HyperdataListCooc
where
where
fromField
=
fromField'
fromField
=
fromField'
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataList
instance
DefaultFromField
PGJsonb
HyperdataList
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataListCooc
instance
DefaultFromField
PGJsonb
HyperdataListCooc
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
ToSchema
HyperdataList
where
instance
ToSchema
HyperdataList
where
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Model.hs
View file @
64dbad9e
...
@@ -48,9 +48,9 @@ instance FromField HyperdataModel
...
@@ -48,9 +48,9 @@ instance FromField HyperdataModel
where
where
fromField
=
fromField'
fromField
=
fromField'
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataModel
instance
DefaultFromField
PGJsonb
HyperdataModel
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
ToSchema
HyperdataModel
where
instance
ToSchema
HyperdataModel
where
declareNamedSchema
proxy
=
declareNamedSchema
proxy
=
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Phylo.hs
View file @
64dbad9e
...
@@ -56,6 +56,6 @@ instance ToSchema HyperdataPhylo where
...
@@ -56,6 +56,6 @@ instance ToSchema HyperdataPhylo where
instance
FromField
HyperdataPhylo
where
instance
FromField
HyperdataPhylo
where
fromField
=
fromField'
fromField
=
fromField'
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataPhylo
instance
DefaultFromField
PGJsonb
HyperdataPhylo
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
src/Gargantext/Database/Admin/Types/Hyperdata/Prelude.hs
View file @
64dbad9e
...
@@ -48,7 +48,7 @@ import GHC.Generics (Generic)
...
@@ -48,7 +48,7 @@ import GHC.Generics (Generic)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
,
wellNamedSchema
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
,
wellNamedSchema
)
import
Gargantext.Database.Prelude
(
fromField'
)
import
Gargantext.Database.Prelude
(
fromField'
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Opaleye
(
QueryRunnerColumnDefault
,
queryRunnerColumnDefault
,
PGJsonb
,
fieldQueryRunnerColumn
,
Nullable
)
import
Opaleye
(
DefaultFromField
(
..
),
PGJsonb
,
defaultFromField
,
fieldQueryRunnerColumn
,
Nullable
)
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck.Arbitrary
hiding
(
vector
)
import
Test.QuickCheck.Arbitrary
hiding
(
vector
)
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Texts.hs
View file @
64dbad9e
...
@@ -54,7 +54,7 @@ instance ToSchema HyperdataTexts where
...
@@ -54,7 +54,7 @@ instance ToSchema HyperdataTexts where
instance
FromField
HyperdataTexts
where
instance
FromField
HyperdataTexts
where
fromField
=
fromField'
fromField
=
fromField'
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataTexts
instance
DefaultFromField
PGJsonb
HyperdataTexts
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
src/Gargantext/Database/Admin/Types/Hyperdata/User.hs
View file @
64dbad9e
...
@@ -120,12 +120,12 @@ instance FromField HyperdataPublic where
...
@@ -120,12 +120,12 @@ instance FromField HyperdataPublic where
fromField
=
fromField'
fromField
=
fromField'
-- | Database (Opaleye instance)
-- | Database (Opaleye instance)
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataUser
where
instance
DefaultFromField
PGJsonb
HyperdataUser
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataPrivate
where
instance
DefaultFromField
PGJsonb
HyperdataPrivate
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataPublic
where
instance
DefaultFromField
PGJsonb
HyperdataPublic
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
src/Gargantext/Database/Admin/Types/Node.hs
View file @
64dbad9e
...
@@ -33,7 +33,7 @@ import Database.PostgreSQL.Simple.ToField (ToField, toField)
...
@@ -33,7 +33,7 @@ import Database.PostgreSQL.Simple.ToField (ToField, toField)
import
GHC.Generics
(
Generic
)
import
GHC.Generics
(
Generic
)
import
Servant
import
Servant
import
qualified
Opaleye
as
O
import
qualified
Opaleye
as
O
import
Opaleye
(
QueryRunnerColumnDefault
,
queryRunnerColumnDefault
,
PGInt4
,
PGText
,
PGTSVector
,
Nullable
,
fieldQueryRunnerColumn
)
import
Opaleye
(
DefaultFromField
,
defaultFromField
,
PGInt4
,
PGText
,
PGTSVector
,
Nullable
,
fieldQueryRunnerColumn
)
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck
(
elements
)
import
Gargantext.Prelude.Crypto.Hash
(
Hash
)
import
Gargantext.Prelude.Crypto.Hash
(
Hash
)
import
Test.QuickCheck.Arbitrary
import
Test.QuickCheck.Arbitrary
...
@@ -82,18 +82,26 @@ instance (Typeable hyperdata, ToSchema hyperdata) =>
...
@@ -82,18 +82,26 @@ instance (Typeable hyperdata, ToSchema hyperdata) =>
declareNamedSchema
=
wellNamedSchema
"_node_"
declareNamedSchema
=
wellNamedSchema
"_node_"
instance
(
Typeable
hyperdata
,
ToSchema
hyperdata
)
=>
instance
(
Typeable
hyperdata
,
ToSchema
hyperdata
)
=>
ToSchema
(
NodePolySearch
NodeId
NodeTypeId
ToSchema
(
NodePolySearch
NodeId
NodeTypeId
(
Maybe
UserId
)
(
Maybe
UserId
)
ParentId
NodeName
ParentId
UTCTime
hyperdata
(
Maybe
TSVector
)
NodeName
UTCTime
hyperdata
(
Maybe
TSVector
)
)
where
)
where
declareNamedSchema
=
wellNamedSchema
"_ns_"
declareNamedSchema
=
wellNamedSchema
"_ns_"
instance
(
Typeable
hyperdata
,
ToSchema
hyperdata
)
=>
instance
(
Typeable
hyperdata
,
ToSchema
hyperdata
)
=>
ToSchema
(
NodePolySearch
NodeId
NodeTypeId
ToSchema
(
NodePolySearch
NodeId
NodeTypeId
UserId
UserId
(
Maybe
ParentId
)
NodeName
(
Maybe
ParentId
)
UTCTime
hyperdata
(
Maybe
TSVector
)
NodeName
UTCTime
hyperdata
(
Maybe
TSVector
)
)
where
)
where
declareNamedSchema
=
wellNamedSchema
"_ns_"
declareNamedSchema
=
wellNamedSchema
"_ns_"
...
@@ -115,16 +123,29 @@ instance (Arbitrary hyperdata
...
@@ -115,16 +123,29 @@ instance (Arbitrary hyperdata
,
Arbitrary
toDBid
,
Arbitrary
toDBid
,
Arbitrary
userId
,
Arbitrary
userId
,
Arbitrary
nodeParentId
,
Arbitrary
nodeParentId
)
=>
Arbitrary
(
NodePolySearch
nodeId
toDBid
userId
nodeParentId
)
=>
Arbitrary
(
NodePolySearch
nodeId
NodeName
UTCTime
hyperdata
(
Maybe
TSVector
))
where
toDBid
userId
nodeParentId
NodeName
UTCTime
hyperdata
(
Maybe
TSVector
)
)
where
--arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
--arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
arbitrary
=
NodeSearch
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
arbitrary
=
NodeSearch
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
------------------------------------------------------------------------
------------------------------------------------------------------------
pgNodeId
::
NodeId
->
O
.
Column
O
.
PGInt4
pgNodeId
::
NodeId
->
O
.
Column
O
.
PGInt4
pgNodeId
=
O
.
pg
Int4
.
id2int
pgNodeId
=
O
.
sql
Int4
.
id2int
where
where
id2int
::
NodeId
->
Int
id2int
::
NodeId
->
Int
id2int
(
NodeId
n
)
=
n
id2int
(
NodeId
n
)
=
n
...
@@ -333,28 +354,28 @@ instance FromField (NodeId, Text)
...
@@ -333,28 +354,28 @@ instance FromField (NodeId, Text)
fromField = fromField'
fromField = fromField'
-}
-}
------------------------------------------------------------------------
------------------------------------------------------------------------
instance
QueryRunnerColumnDefault
PGTSVector
(
Maybe
TSVector
)
instance
DefaultFromField
PGTSVector
(
Maybe
TSVector
)
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGInt4
(
Maybe
NodeId
)
instance
DefaultFromField
PGInt4
(
Maybe
NodeId
)
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGInt4
NodeId
instance
DefaultFromField
PGInt4
NodeId
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
(
Nullable
PGInt4
)
NodeId
instance
DefaultFromField
(
Nullable
PGInt4
)
NodeId
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
(
QueryRunnerColumnDefault
(
Nullable
O
.
PGTimestamptz
)
UTCTime
)
instance
(
DefaultFromField
(
Nullable
O
.
PGTimestamptz
)
UTCTime
)
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGText
(
Maybe
Hash
)
instance
DefaultFromField
PGText
(
Maybe
Hash
)
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
src/Gargantext/Database/Prelude.hs
View file @
64dbad9e
...
@@ -31,7 +31,7 @@ import Database.PostgreSQL.Simple (Connection, connect)
...
@@ -31,7 +31,7 @@ import Database.PostgreSQL.Simple (Connection, connect)
import
Database.PostgreSQL.Simple.FromField
(
Conversion
,
ResultError
(
ConversionFailed
),
fromField
,
returnError
)
import
Database.PostgreSQL.Simple.FromField
(
Conversion
,
ResultError
(
ConversionFailed
),
fromField
,
returnError
)
import
Database.PostgreSQL.Simple.Internal
(
Field
)
import
Database.PostgreSQL.Simple.Internal
(
Field
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Opaleye
(
Query
,
Unpackspec
,
showSql
ForPostgres
,
FromFields
,
Select
,
runQuery
,
PGJsonb
,
QueryRunnerColumnDefault
)
import
Opaleye
(
Query
,
Unpackspec
,
showSql
,
FromFields
,
Select
,
runSelect
,
PGJsonb
,
DefaultFromField
)
import
Opaleye.Aggregate
(
countRows
)
import
Opaleye.Aggregate
(
countRows
)
import
System.IO
(
FilePath
)
import
System.IO
(
FilePath
)
import
System.IO
(
stderr
)
import
System.IO
(
stderr
)
...
@@ -56,7 +56,7 @@ instance HasConfig GargConfig where
...
@@ -56,7 +56,7 @@ instance HasConfig GargConfig where
hasConfig
=
identity
hasConfig
=
identity
-------------------------------------------------------
-------------------------------------------------------
type
JSONB
=
QueryRunnerColumnDefault
PGJsonb
type
JSONB
=
DefaultFromField
PGJsonb
-------------------------------------------------------
-------------------------------------------------------
type
CmdM''
env
err
m
=
type
CmdM''
env
err
m
=
...
@@ -111,11 +111,11 @@ runCmd env m = runExceptT $ runReaderT m env
...
@@ -111,11 +111,11 @@ runCmd env m = runExceptT $ runReaderT m env
runOpaQuery
::
Default
FromFields
fields
haskells
runOpaQuery
::
Default
FromFields
fields
haskells
=>
Select
fields
=>
Select
fields
->
Cmd
err
[
haskells
]
->
Cmd
err
[
haskells
]
runOpaQuery
q
=
mkCmd
$
\
c
->
run
Query
c
q
runOpaQuery
q
=
mkCmd
$
\
c
->
run
Select
c
q
runCountOpaQuery
::
Select
a
->
Cmd
err
Int
runCountOpaQuery
::
Select
a
->
Cmd
err
Int
runCountOpaQuery
q
=
do
runCountOpaQuery
q
=
do
counts
<-
mkCmd
$
\
c
->
run
Query
c
$
countRows
q
counts
<-
mkCmd
$
\
c
->
run
Select
c
$
countRows
q
-- countRows is guaranteed to return a list with exactly one row so DL.head is safe here
-- countRows is guaranteed to return a list with exactly one row so DL.head is safe here
pure
$
fromInt64ToInt
$
DL
.
head
counts
pure
$
fromInt64ToInt
$
DL
.
head
counts
...
@@ -189,5 +189,5 @@ fromField' field mb = do
...
@@ -189,5 +189,5 @@ fromField' field mb = do
]
]
printSqlOpa
::
Default
Unpackspec
a
a
=>
Query
a
->
IO
()
printSqlOpa
::
Default
Unpackspec
a
a
=>
Query
a
->
IO
()
printSqlOpa
=
putStrLn
.
maybe
"Empty query"
identity
.
showSql
ForPostgres
printSqlOpa
=
putStrLn
.
maybe
"Empty query"
identity
.
showSql
src/Gargantext/Database/Query/Facet.hs
View file @
64dbad9e
...
@@ -44,6 +44,8 @@ import Control.Arrow (returnA)
...
@@ -44,6 +44,8 @@ import Control.Arrow (returnA)
import
Control.Lens
((
^.
))
import
Control.Lens
((
^.
))
import
Data.Aeson
(
FromJSON
,
ToJSON
)
import
Data.Aeson
(
FromJSON
,
ToJSON
)
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Aeson.TH
(
deriveJSON
)
--import qualified Database.PostgreSQL.Simple as DPS
--import Database.PostgreSQL.Simple.SqlQQ (sql)
import
Data.Profunctor.Product.TH
(
makeAdaptorAndInstance
)
import
Data.Profunctor.Product.TH
(
makeAdaptorAndInstance
)
import
Data.Swagger
import
Data.Swagger
import
qualified
Data.Text
as
T
import
qualified
Data.Text
as
T
...
@@ -59,14 +61,17 @@ import qualified Opaleye.Internal.Unpackspec()
...
@@ -59,14 +61,17 @@ import qualified Opaleye.Internal.Unpackspec()
import
Gargantext.Core
import
Gargantext.Core
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
,
wellNamedSchema
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
,
wellNamedSchema
)
-- import Gargantext.Database.Action.TSQuery (toTSQuery)
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Query.Filter
import
Gargantext.Database.Query.Filter
import
Gargantext.Database.Query.Join
(
leftJoin5
)
import
Gargantext.Database.Query.Join
(
leftJoin5
)
import
Gargantext.Database.Query.Table.Ngrams
import
Gargantext.Database.Query.Table.Ngrams
import
Gargantext.Database.Query.Table.Node
(
queryNodeSearchTable
)
import
Gargantext.Database.Query.Table.NodeNode
import
Gargantext.Database.Query.Table.NodeNode
import
Gargantext.Database.Query.Table.NodeNodeNgrams
import
Gargantext.Database.Query.Table.NodeNodeNgrams
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Node
import
Gargantext.Prelude
(
printDebug
)
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | DocFacet
-- | DocFacet
...
@@ -263,13 +268,13 @@ viewAuthorsDoc cId _ nt = proc () -> do
...
@@ -263,13 +268,13 @@ viewAuthorsDoc cId _ nt = proc () -> do
-}
-}
restrict
-<
_node_id
contact'
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
_node_id
contact'
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
_node_typename
doc
.==
(
pg
Int4
$
toDBid
nt
)
restrict
-<
_node_typename
doc
.==
(
sql
Int4
$
toDBid
nt
)
returnA
-<
FacetDoc
(
_node_id
doc
)
returnA
-<
FacetDoc
(
_node_id
doc
)
(
_node_date
doc
)
(
_node_date
doc
)
(
_node_name
doc
)
(
_node_name
doc
)
(
_node_hyperdata
doc
)
(
_node_hyperdata
doc
)
(
toNullable
$
pg
Int4
1
)
(
toNullable
$
sql
Int4
1
)
(
toNullable
$
pgDouble
1
)
(
toNullable
$
pgDouble
1
)
(
toNullable
$
pgDouble
1
)
(
toNullable
$
pgDouble
1
)
...
@@ -303,10 +308,29 @@ runViewDocuments :: HasDBid NodeType
...
@@ -303,10 +308,29 @@ runViewDocuments :: HasDBid NodeType
->
Maybe
Text
->
Maybe
Text
->
Cmd
err
[
FacetDoc
]
->
Cmd
err
[
FacetDoc
]
runViewDocuments
cId
t
o
l
order
query
=
do
runViewDocuments
cId
t
o
l
order
query
=
do
-- docs <- runPGSQuery viewDocuments'
-- ( cId
-- , ntId
-- , (if t then 0 else 1) :: Int
-- , fromMaybe "" query
-- , fromMaybe "" query)
-- pure $ (\(id, date, name', hyperdata, category, score) -> FacetDoc id date name' hyperdata category score score) <$> docs
printDebug
"[runViewDocuments] sqlQuery"
$
showSql
sqlQuery
runOpaQuery
$
filterWith
o
l
order
sqlQuery
runOpaQuery
$
filterWith
o
l
order
sqlQuery
where
where
ntId
=
toDBid
NodeDocument
ntId
=
toDBid
NodeDocument
sqlQuery
=
viewDocuments
cId
t
ntId
query
sqlQuery
=
viewDocuments
cId
t
ntId
query
-- viewDocuments' :: DPS.Query
-- viewDocuments' = [sql|
-- SELECT n.id, n.date, n.name, n.hyperdata, nn.category, nn.score
-- FROM nodes AS n
-- JOIN nodes_nodes AS nn
-- ON n.id = nn.node2_id
-- WHERE nn.node1_id = ? -- corpusId
-- AND n.typename = ? -- NodeTypeId
-- AND nn.category = ? -- isTrash or not
-- AND (n.search_title @@ to_tsquery(?) OR ? = '') -- query with an OR hack for empty to_tsquery('') results
-- |]
runCountDocuments
::
HasDBid
NodeType
=>
CorpusId
->
IsTrash
->
Maybe
Text
->
Cmd
err
Int
runCountDocuments
::
HasDBid
NodeType
=>
CorpusId
->
IsTrash
->
Maybe
Text
->
Cmd
err
Int
runCountDocuments
cId
t
mQuery
=
do
runCountDocuments
cId
t
mQuery
=
do
...
@@ -321,28 +345,33 @@ viewDocuments :: CorpusId
...
@@ -321,28 +345,33 @@ viewDocuments :: CorpusId
->
Maybe
Text
->
Maybe
Text
->
Query
FacetDocRead
->
Query
FacetDocRead
viewDocuments
cId
t
ntId
mQuery
=
proc
()
->
do
viewDocuments
cId
t
ntId
mQuery
=
proc
()
->
do
n
<-
queryNodeTable
-<
()
--n <- queryNodeTable -< ()
n
<-
queryNodeSearchTable
-<
()
nn
<-
queryNodeNodeTable
-<
()
nn
<-
queryNodeNodeTable
-<
()
restrict
-<
n
^.
n
ode
_id
.==
nn
^.
nn_node2_id
restrict
-<
n
^.
n
s
_id
.==
nn
^.
nn_node2_id
restrict
-<
nn
^.
nn_node1_id
.==
(
pgNodeId
cId
)
restrict
-<
nn
^.
nn_node1_id
.==
(
pgNodeId
cId
)
restrict
-<
n
^.
n
ode_typename
.==
(
pg
Int4
ntId
)
restrict
-<
n
^.
n
s_typename
.==
(
sql
Int4
ntId
)
restrict
-<
if
t
then
nn
^.
nn_category
.==
(
pg
Int4
0
)
restrict
-<
if
t
then
nn
^.
nn_category
.==
(
sql
Int4
0
)
else
nn
^.
nn_category
.>=
(
pg
Int4
1
)
else
nn
^.
nn_category
.>=
(
sql
Int4
1
)
let
query
=
(
fromMaybe
""
mQuery
)
let
query
=
(
fromMaybe
""
mQuery
)
iLikeQuery
=
T
.
intercalate
""
[
"%"
,
query
,
"%"
]
-- iLikeQuery = T.intercalate "" ["%", query, "%"]
restrict
-<
(
n
^.
node_name
)
`
ilike
`
(
pgStrictText
iLikeQuery
)
-- restrict -< (n^.node_name) `ilike` (sqlStrictText iLikeQuery)
restrict
-<
if
query
==
""
returnA
-<
FacetDoc
(
_node_id
n
)
then
pgBool
True
(
_node_date
n
)
--else (n^.ns_search_title) @@ (pgTSQuery (T.unpack query))
(
_node_name
n
)
else
(
n
^.
ns_search_title
)
@@
(
toTSQuery
$
T
.
unpack
query
)
(
_node_hyperdata
n
)
returnA
-<
FacetDoc
(
_ns_id
n
)
(
_ns_date
n
)
(
_ns_name
n
)
(
_ns_hyperdata
n
)
(
toNullable
$
nn
^.
nn_category
)
(
toNullable
$
nn
^.
nn_category
)
(
toNullable
$
nn
^.
nn_score
)
(
toNullable
$
nn
^.
nn_score
)
(
toNullable
$
nn
^.
nn_score
)
(
toNullable
$
nn
^.
nn_score
)
------------------------------------------------------------------------
------------------------------------------------------------------------
filterWith
::
(
PGOrd
date
,
PGOrd
title
,
PGOrd
category
,
PG
Ord
score
,
hyperdata
~
Column
SqlJsonb
)
=>
filterWith
::
(
SqlOrd
date
,
SqlOrd
title
,
SqlOrd
category
,
Sql
Ord
score
,
hyperdata
~
Column
SqlJsonb
)
=>
Maybe
Gargantext
.
Core
.
Types
.
Offset
Maybe
Gargantext
.
Core
.
Types
.
Offset
->
Maybe
Gargantext
.
Core
.
Types
.
Limit
->
Maybe
Gargantext
.
Core
.
Types
.
Limit
->
Maybe
OrderBy
->
Maybe
OrderBy
...
@@ -351,7 +380,7 @@ filterWith :: (PGOrd date, PGOrd title, PGOrd category, PGOrd score, hyperdata ~
...
@@ -351,7 +380,7 @@ filterWith :: (PGOrd date, PGOrd title, PGOrd category, PGOrd score, hyperdata ~
filterWith
o
l
order
q
=
limit'
l
$
offset'
o
$
orderBy
(
orderWith
order
)
q
filterWith
o
l
order
q
=
limit'
l
$
offset'
o
$
orderBy
(
orderWith
order
)
q
orderWith
::
(
PGOrd
b1
,
PGOrd
b2
,
PGOrd
b3
,
PG
Ord
b4
)
orderWith
::
(
SqlOrd
b1
,
SqlOrd
b2
,
SqlOrd
b3
,
Sql
Ord
b4
)
=>
Maybe
OrderBy
=>
Maybe
OrderBy
->
Order
(
Facet
id
(
Column
b1
)
(
Column
b2
)
(
Column
SqlJsonb
)
(
Column
b3
)
ngramCount
(
Column
b4
))
->
Order
(
Facet
id
(
Column
b1
)
(
Column
b2
)
(
Column
SqlJsonb
)
(
Column
b3
)
ngramCount
(
Column
b4
))
orderWith
(
Just
DateAsc
)
=
asc
facetDoc_created
orderWith
(
Just
DateAsc
)
=
asc
facetDoc_created
...
@@ -368,7 +397,7 @@ orderWith (Just SourceDesc) = desc facetDoc_source
...
@@ -368,7 +397,7 @@ orderWith (Just SourceDesc) = desc facetDoc_source
orderWith
_
=
asc
facetDoc_created
orderWith
_
=
asc
facetDoc_created
facetDoc_source
::
PG
IsJson
a
facetDoc_source
::
Sql
IsJson
a
=>
Facet
id
created
title
(
Column
a
)
favorite
ngramCount
score
=>
Facet
id
created
title
(
Column
a
)
favorite
ngramCount
score
->
Column
(
Nullable
PGText
)
->
Column
(
Nullable
PGText
)
facetDoc_source
x
=
toNullable
(
facetDoc_hyperdata
x
)
.->>
pgString
"source"
facetDoc_source
x
=
toNullable
(
facetDoc_hyperdata
x
)
.->>
pgString
"source"
src/Gargantext/Database/Query/Table/Ngrams.hs
View file @
64dbad9e
...
@@ -39,7 +39,7 @@ import Gargantext.Database.Types
...
@@ -39,7 +39,7 @@ import Gargantext.Database.Types
import
Gargantext.Prelude
import
Gargantext.Prelude
queryNgramsTable
::
Query
NgramsRead
queryNgramsTable
::
Query
NgramsRead
queryNgramsTable
=
query
Table
ngramsTable
queryNgramsTable
=
select
Table
ngramsTable
selectNgramsByDoc
::
[
ListId
]
->
DocId
->
NgramsType
->
Cmd
err
[
Text
]
selectNgramsByDoc
::
[
ListId
]
->
DocId
->
NgramsType
->
Cmd
err
[
Text
]
selectNgramsByDoc
lIds
dId
nt
=
runOpaQuery
(
query
lIds
dId
nt
)
selectNgramsByDoc
lIds
dId
nt
=
runOpaQuery
(
query
lIds
dId
nt
)
...
...
src/Gargantext/Database/Query/Table/Node.hs
View file @
64dbad9e
...
@@ -44,7 +44,7 @@ import Gargantext.Prelude hiding (sum, head)
...
@@ -44,7 +44,7 @@ import Gargantext.Prelude hiding (sum, head)
queryNodeSearchTable
::
Query
NodeSearchRead
queryNodeSearchTable
::
Query
NodeSearchRead
queryNodeSearchTable
=
query
Table
nodeTableSearch
queryNodeSearchTable
=
select
Table
nodeTableSearch
selectNode
::
Column
PGInt4
->
Query
NodeRead
selectNode
::
Column
PGInt4
->
Query
NodeRead
selectNode
id'
=
proc
()
->
do
selectNode
id'
=
proc
()
->
do
...
@@ -78,20 +78,26 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
...
@@ -78,20 +78,26 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
let
typeId'
=
maybe
0
toDBid
maybeNodeType
let
typeId'
=
maybe
0
toDBid
maybeNodeType
restrict
-<
if
typeId'
>
0
restrict
-<
if
typeId'
>
0
then
typeId
.==
(
pg
Int4
(
typeId'
::
Int
))
then
typeId
.==
(
sql
Int4
(
typeId'
::
Int
))
else
(
pgBool
True
)
else
(
pgBool
True
)
returnA
-<
row
)
-<
()
returnA
-<
row
)
-<
()
returnA
-<
node'
returnA
-<
node'
deleteNode
::
NodeId
->
Cmd
err
Int
deleteNode
::
NodeId
->
Cmd
err
Int
deleteNode
n
=
mkCmd
$
\
conn
->
deleteNode
n
=
mkCmd
$
\
conn
->
fromIntegral
<$>
runDelete
conn
nodeTable
fromIntegral
<$>
runDelete_
conn
(
Delete
nodeTable
(
\
(
Node
n_id
_
_
_
_
_
_
_
)
->
n_id
.==
pgNodeId
n
)
(
\
(
Node
n_id
_
_
_
_
_
_
_
)
->
n_id
.==
pgNodeId
n
)
rCount
)
deleteNodes
::
[
NodeId
]
->
Cmd
err
Int
deleteNodes
::
[
NodeId
]
->
Cmd
err
Int
deleteNodes
ns
=
mkCmd
$
\
conn
->
deleteNodes
ns
=
mkCmd
$
\
conn
->
fromIntegral
<$>
runDelete
conn
nodeTable
fromIntegral
<$>
runDelete_
conn
(
Delete
nodeTable
(
\
(
Node
n_id
_
_
_
_
_
_
_
)
->
in_
((
map
pgNodeId
ns
))
n_id
)
(
\
(
Node
n_id
_
_
_
_
_
_
_
)
->
in_
((
map
pgNodeId
ns
))
n_id
)
rCount
)
-- TODO: NodeType should match with `a'
-- TODO: NodeType should match with `a'
getNodesWith
::
(
JSONB
a
,
HasDBid
NodeType
)
=>
NodeId
->
proxy
a
->
Maybe
NodeType
getNodesWith
::
(
JSONB
a
,
HasDBid
NodeType
)
=>
NodeId
->
proxy
a
->
Maybe
NodeType
...
@@ -168,7 +174,7 @@ getNodesWithType nt _ = runOpaQuery $ selectNodesWithType nt
...
@@ -168,7 +174,7 @@ getNodesWithType nt _ = runOpaQuery $ selectNodesWithType nt
=>
NodeType
->
Query
NodeRead
=>
NodeType
->
Query
NodeRead
selectNodesWithType
nt'
=
proc
()
->
do
selectNodesWithType
nt'
=
proc
()
->
do
row
@
(
Node
_
_
tn
_
_
_
_
_
)
<-
queryNodeTable
-<
()
row
@
(
Node
_
_
tn
_
_
_
_
_
)
<-
queryNodeTable
-<
()
restrict
-<
tn
.==
(
pg
Int4
$
toDBid
nt'
)
restrict
-<
tn
.==
(
sql
Int4
$
toDBid
nt'
)
returnA
-<
row
returnA
-<
row
getNodesIdWithType
::
(
HasNodeError
err
,
HasDBid
NodeType
)
=>
NodeType
->
Cmd
err
[
NodeId
]
getNodesIdWithType
::
(
HasNodeError
err
,
HasDBid
NodeType
)
=>
NodeType
->
Cmd
err
[
NodeId
]
...
@@ -180,7 +186,7 @@ selectNodesIdWithType :: HasDBid NodeType
...
@@ -180,7 +186,7 @@ selectNodesIdWithType :: HasDBid NodeType
=>
NodeType
->
Query
(
Column
PGInt4
)
=>
NodeType
->
Query
(
Column
PGInt4
)
selectNodesIdWithType
nt
=
proc
()
->
do
selectNodesIdWithType
nt
=
proc
()
->
do
row
@
(
Node
_
_
tn
_
_
_
_
_
)
<-
queryNodeTable
-<
()
row
@
(
Node
_
_
tn
_
_
_
_
_
)
<-
queryNodeTable
-<
()
restrict
-<
tn
.==
(
pg
Int4
$
toDBid
nt
)
restrict
-<
tn
.==
(
sql
Int4
$
toDBid
nt
)
returnA
-<
_node_id
row
returnA
-<
_node_id
row
------------------------------------------------------------------------
------------------------------------------------------------------------
...
@@ -229,10 +235,10 @@ node :: (ToJSON a, Hyperdata a, HasDBid NodeType)
...
@@ -229,10 +235,10 @@ node :: (ToJSON a, Hyperdata a, HasDBid NodeType)
->
NodeWrite
->
NodeWrite
node
nodeType
name
hyperData
parentId
userId
=
node
nodeType
name
hyperData
parentId
userId
=
Node
Nothing
Nothing
Node
Nothing
Nothing
(
pg
Int4
typeId
)
(
sql
Int4
typeId
)
(
pg
Int4
userId
)
(
sql
Int4
userId
)
(
pgNodeId
<$>
parentId
)
(
pgNodeId
<$>
parentId
)
(
pg
StrictText
name
)
(
sql
StrictText
name
)
Nothing
Nothing
(
pgJSONB
$
cs
$
encode
hyperData
)
(
pgJSONB
$
cs
$
encode
hyperData
)
where
where
...
@@ -250,10 +256,10 @@ insertNodes' ns = mkCmd $ \conn -> runInsert_ conn
...
@@ -250,10 +256,10 @@ insertNodes' ns = mkCmd $ \conn -> runInsert_ conn
ns' :: [NodeWrite]
ns' :: [NodeWrite]
ns' = map (\(Node i t u p n d h)
ns' = map (\(Node i t u p n d h)
-> Node (pgNodeId <$> i)
-> Node (pgNodeId <$> i)
(
pg
Int4 $ toDBid t)
(
sql
Int4 $ toDBid t)
(
pg
Int4 u)
(
sql
Int4 u)
(pgNodeId <$> p)
(pgNodeId <$> p)
(
pg
StrictText n)
(
sql
StrictText n)
(pgUTCTime <$> d)
(pgUTCTime <$> d)
(pgJSONB $ cs $ encode h)
(pgJSONB $ cs $ encode h)
) ns
) ns
...
@@ -275,7 +281,7 @@ insertNodesWithParentR pid ns = insertNodesR (set node_parent_id (pgNodeId <$> p
...
@@ -275,7 +281,7 @@ insertNodesWithParentR pid ns = insertNodesR (set node_parent_id (pgNodeId <$> p
node2table
::
HasDBid
NodeType
node2table
::
HasDBid
NodeType
=>
UserId
->
Maybe
ParentId
->
Node'
->
NodeWrite
=>
UserId
->
Maybe
ParentId
->
Node'
->
NodeWrite
node2table
uid
pid
(
Node'
nt
txt
v
[]
)
=
Node
Nothing
Nothing
(
pgInt4
$
toDBid
nt
)
(
pgInt4
uid
)
(
fmap
pgNodeId
pid
)
(
pg
StrictText
txt
)
Nothing
(
pgStrictJSONB
$
cs
$
encode
v
)
node2table
uid
pid
(
Node'
nt
txt
v
[]
)
=
Node
Nothing
Nothing
(
sqlInt4
$
toDBid
nt
)
(
sqlInt4
uid
)
(
fmap
pgNodeId
pid
)
(
sql
StrictText
txt
)
Nothing
(
pgStrictJSONB
$
cs
$
encode
v
)
node2table
_
_
(
Node'
_
_
_
_
)
=
panic
"node2table: should not happen, Tree insert not implemented yet"
node2table
_
_
(
Node'
_
_
_
_
)
=
panic
"node2table: should not happen, Tree insert not implemented yet"
...
...
src/Gargantext/Database/Query/Table/Node/Children.hs
View file @
64dbad9e
...
@@ -75,7 +75,7 @@ selectChildren parentId maybeNodeType = proc () -> do
...
@@ -75,7 +75,7 @@ selectChildren parentId maybeNodeType = proc () -> do
(
NodeNode
n1id
n2id
_
_
)
<-
queryNodeNodeTable
-<
()
(
NodeNode
n1id
n2id
_
_
)
<-
queryNodeNodeTable
-<
()
let
nodeType
=
maybe
0
toDBid
maybeNodeType
let
nodeType
=
maybe
0
toDBid
maybeNodeType
restrict
-<
typeName
.==
pg
Int4
nodeType
restrict
-<
typeName
.==
sql
Int4
nodeType
restrict
-<
(
.||
)
(
parent_id
.==
(
pgNodeId
parentId
))
restrict
-<
(
.||
)
(
parent_id
.==
(
pgNodeId
parentId
))
(
(
.&&
)
(
n1id
.==
pgNodeId
parentId
)
(
(
.&&
)
(
n1id
.==
pgNodeId
parentId
)
...
...
src/Gargantext/Database/Query/Table/Node/Select.hs
View file @
64dbad9e
...
@@ -31,8 +31,8 @@ selectNodesWithUsername nt u = runOpaQuery (q u)
...
@@ -31,8 +31,8 @@ selectNodesWithUsername nt u = runOpaQuery (q u)
where
where
q
u'
=
proc
()
->
do
q
u'
=
proc
()
->
do
(
n
,
usrs
)
<-
join'
-<
()
(
n
,
usrs
)
<-
join'
-<
()
restrict
-<
user_username
usrs
.==
(
toNullable
$
pg
StrictText
u'
)
restrict
-<
user_username
usrs
.==
(
toNullable
$
sql
StrictText
u'
)
restrict
-<
_node_typename
n
.==
(
pg
Int4
$
toDBid
nt
)
restrict
-<
_node_typename
n
.==
(
sql
Int4
$
toDBid
nt
)
returnA
-<
_node_id
n
returnA
-<
_node_id
n
join'
::
Query
(
NodeRead
,
UserReadNull
)
join'
::
Query
(
NodeRead
,
UserReadNull
)
...
...
src/Gargantext/Database/Query/Table/NodeNode.hs
View file @
64dbad9e
...
@@ -54,7 +54,7 @@ import Gargantext.Prelude
...
@@ -54,7 +54,7 @@ import Gargantext.Prelude
queryNodeNodeTable
::
Query
NodeNodeRead
queryNodeNodeTable
::
Query
NodeNodeRead
queryNodeNodeTable
=
query
Table
nodeNodeTable
queryNodeNodeTable
=
select
Table
nodeNodeTable
-- | not optimized (get all ngrams without filters)
-- | not optimized (get all ngrams without filters)
_nodesNodes
::
Cmd
err
[
NodeNode
]
_nodesNodes
::
Cmd
err
[
NodeNode
]
...
@@ -87,7 +87,7 @@ getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
...
@@ -87,7 +87,7 @@ getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
(NodeNode _ n1id n2id _ _) <- queryNodeNodeTable -< ()
(NodeNode _ n1id n2id _ _) <- queryNodeNodeTable -< ()
let nodeType = maybe 0 toDBid maybeNodeType
let nodeType = maybe 0 toDBid maybeNodeType
restrict -< typeName .==
pg
Int4 nodeType
restrict -< typeName .==
sql
Int4 nodeType
restrict -< (.||) (parent_id .== (pgNodeId parentId))
restrict -< (.||) (parent_id .== (pgNodeId parentId))
( (.&&) (n1id .== pgNodeId parentId)
( (.&&) (n1id .== pgNodeId parentId)
...
@@ -105,7 +105,7 @@ insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
...
@@ -105,7 +105,7 @@ insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
->
NodeNode
(
pgNodeId
n1
)
->
NodeNode
(
pgNodeId
n1
)
(
pgNodeId
n2
)
(
pgNodeId
n2
)
(
pgDouble
<$>
x
)
(
pgDouble
<$>
x
)
(
pg
Int4
<$>
y
)
(
sql
Int4
<$>
y
)
)
ns
)
ns
...
@@ -116,9 +116,13 @@ type Node2_Id = NodeId
...
@@ -116,9 +116,13 @@ type Node2_Id = NodeId
deleteNodeNode
::
Node1_Id
->
Node2_Id
->
Cmd
err
Int
deleteNodeNode
::
Node1_Id
->
Node2_Id
->
Cmd
err
Int
deleteNodeNode
n1
n2
=
mkCmd
$
\
conn
->
deleteNodeNode
n1
n2
=
mkCmd
$
\
conn
->
fromIntegral
<$>
runDelete
conn
nodeNodeTable
fromIntegral
<$>
runDelete_
conn
(
Delete
nodeNodeTable
(
\
(
NodeNode
n1_id
n2_id
_
_
)
->
n1_id
.==
pgNodeId
n1
(
\
(
NodeNode
n1_id
n2_id
_
_
)
->
n1_id
.==
pgNodeId
n1
.&&
n2_id
.==
pgNodeId
n2
)
.&&
n2_id
.==
pgNodeId
n2
)
rCount
)
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | Favorite management
-- | Favorite management
...
@@ -177,8 +181,8 @@ selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
...
@@ -177,8 +181,8 @@ selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
queryCountDocs
cId'
=
proc
()
->
do
queryCountDocs
cId'
=
proc
()
->
do
(
n
,
nn
)
<-
joinInCorpus
-<
()
(
n
,
nn
)
<-
joinInCorpus
-<
()
restrict
-<
nn
^.
nn_node1_id
.==
(
toNullable
$
pgNodeId
cId'
)
restrict
-<
nn
^.
nn_node1_id
.==
(
toNullable
$
pgNodeId
cId'
)
restrict
-<
nn
^.
nn_category
.>=
(
toNullable
$
pg
Int4
1
)
restrict
-<
nn
^.
nn_category
.>=
(
toNullable
$
sql
Int4
1
)
restrict
-<
n
^.
node_typename
.==
(
pg
Int4
$
toDBid
NodeDocument
)
restrict
-<
n
^.
node_typename
.==
(
sql
Int4
$
toDBid
NodeDocument
)
returnA
-<
n
returnA
-<
n
...
@@ -198,8 +202,8 @@ queryDocs :: HasDBid NodeType => CorpusId -> O.Query (Column PGJsonb)
...
@@ -198,8 +202,8 @@ queryDocs :: HasDBid NodeType => CorpusId -> O.Query (Column PGJsonb)
queryDocs
cId
=
proc
()
->
do
queryDocs
cId
=
proc
()
->
do
(
n
,
nn
)
<-
joinInCorpus
-<
()
(
n
,
nn
)
<-
joinInCorpus
-<
()
restrict
-<
nn
^.
nn_node1_id
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
nn
^.
nn_node1_id
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
nn
^.
nn_category
.>=
(
toNullable
$
pg
Int4
1
)
restrict
-<
nn
^.
nn_category
.>=
(
toNullable
$
sql
Int4
1
)
restrict
-<
n
^.
node_typename
.==
(
pg
Int4
$
toDBid
NodeDocument
)
restrict
-<
n
^.
node_typename
.==
(
sql
Int4
$
toDBid
NodeDocument
)
returnA
-<
view
(
node_hyperdata
)
n
returnA
-<
view
(
node_hyperdata
)
n
selectDocNodes
::
HasDBid
NodeType
=>
CorpusId
->
Cmd
err
[
Node
HyperdataDocument
]
selectDocNodes
::
HasDBid
NodeType
=>
CorpusId
->
Cmd
err
[
Node
HyperdataDocument
]
...
@@ -209,8 +213,8 @@ queryDocNodes :: HasDBid NodeType =>CorpusId -> O.Query NodeRead
...
@@ -209,8 +213,8 @@ queryDocNodes :: HasDBid NodeType =>CorpusId -> O.Query NodeRead
queryDocNodes
cId
=
proc
()
->
do
queryDocNodes
cId
=
proc
()
->
do
(
n
,
nn
)
<-
joinInCorpus
-<
()
(
n
,
nn
)
<-
joinInCorpus
-<
()
restrict
-<
nn
^.
nn_node1_id
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
nn
^.
nn_node1_id
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
nn
^.
nn_category
.>=
(
toNullable
$
pg
Int4
1
)
restrict
-<
nn
^.
nn_category
.>=
(
toNullable
$
sql
Int4
1
)
restrict
-<
n
^.
node_typename
.==
(
pg
Int4
$
toDBid
NodeDocument
)
restrict
-<
n
^.
node_typename
.==
(
sql
Int4
$
toDBid
NodeDocument
)
returnA
-<
n
returnA
-<
n
joinInCorpus
::
O
.
Query
(
NodeRead
,
NodeNodeReadNull
)
joinInCorpus
::
O
.
Query
(
NodeRead
,
NodeNodeReadNull
)
...
@@ -227,13 +231,13 @@ joinOn1 = leftJoin queryNodeTable queryNodeNodeTable cond
...
@@ -227,13 +231,13 @@ joinOn1 = leftJoin queryNodeTable queryNodeNodeTable cond
------------------------------------------------------------------------
------------------------------------------------------------------------
selectPublicNodes
::
HasDBid
NodeType
=>
(
Hyperdata
a
,
QueryRunnerColumnDefault
PGJsonb
a
)
selectPublicNodes
::
HasDBid
NodeType
=>
(
Hyperdata
a
,
DefaultFromField
PGJsonb
a
)
=>
Cmd
err
[(
Node
a
,
Maybe
Int
)]
=>
Cmd
err
[(
Node
a
,
Maybe
Int
)]
selectPublicNodes
=
runOpaQuery
(
queryWithType
NodeFolderPublic
)
selectPublicNodes
=
runOpaQuery
(
queryWithType
NodeFolderPublic
)
queryWithType
::
HasDBid
NodeType
=>
NodeType
->
O
.
Query
(
NodeRead
,
Column
(
Nullable
PGInt4
))
queryWithType
::
HasDBid
NodeType
=>
NodeType
->
O
.
Query
(
NodeRead
,
Column
(
Nullable
PGInt4
))
queryWithType
nt
=
proc
()
->
do
queryWithType
nt
=
proc
()
->
do
(
n
,
nn
)
<-
joinOn1
-<
()
(
n
,
nn
)
<-
joinOn1
-<
()
restrict
-<
n
^.
node_typename
.==
(
pg
Int4
$
toDBid
nt
)
restrict
-<
n
^.
node_typename
.==
(
sql
Int4
$
toDBid
nt
)
returnA
-<
(
n
,
nn
^.
nn_node2_id
)
returnA
-<
(
n
,
nn
^.
nn_node2_id
)
src/Gargantext/Database/Query/Table/NodeNodeNgrams.hs
View file @
64dbad9e
...
@@ -31,7 +31,7 @@ import Prelude
...
@@ -31,7 +31,7 @@ import Prelude
queryNodeNodeNgramsTable
::
Query
NodeNodeNgramsRead
queryNodeNodeNgramsTable
::
Query
NodeNodeNgramsRead
queryNodeNodeNgramsTable
=
query
Table
nodeNodeNgramsTable
queryNodeNodeNgramsTable
=
select
Table
nodeNodeNgramsTable
-- | Insert utils
-- | Insert utils
insertNodeNodeNgrams
::
[
NodeNodeNgrams
]
->
Cmd
err
Int
insertNodeNodeNgrams
::
[
NodeNodeNgrams
]
->
Cmd
err
Int
...
@@ -39,7 +39,7 @@ insertNodeNodeNgrams = insertNodeNodeNgramsW
...
@@ -39,7 +39,7 @@ insertNodeNodeNgrams = insertNodeNodeNgramsW
.
map
(
\
(
NodeNodeNgrams
n1
n2
ng
nt
w
)
->
.
map
(
\
(
NodeNodeNgrams
n1
n2
ng
nt
w
)
->
NodeNodeNgrams
(
pgNodeId
n1
)
NodeNodeNgrams
(
pgNodeId
n1
)
(
pgNodeId
n2
)
(
pgNodeId
n2
)
(
pg
Int4
ng
)
(
sql
Int4
ng
)
(
pgNgramsTypeId
nt
)
(
pgNgramsTypeId
nt
)
(
pgDouble
w
)
(
pgDouble
w
)
)
)
...
...
src/Gargantext/Database/Query/Table/NodeNodeNgrams2.hs
View file @
64dbad9e
...
@@ -29,14 +29,14 @@ import Prelude
...
@@ -29,14 +29,14 @@ import Prelude
_queryNodeNodeNgrams2Table
::
Query
NodeNodeNgrams2Read
_queryNodeNodeNgrams2Table
::
Query
NodeNodeNgrams2Read
_queryNodeNodeNgrams2Table
=
query
Table
nodeNodeNgrams2Table
_queryNodeNodeNgrams2Table
=
select
Table
nodeNodeNgrams2Table
-- | Insert utils
-- | Insert utils
insertNodeNodeNgrams2
::
[
NodeNodeNgrams2
]
->
Cmd
err
Int
insertNodeNodeNgrams2
::
[
NodeNodeNgrams2
]
->
Cmd
err
Int
insertNodeNodeNgrams2
=
insertNodeNodeNgrams2W
insertNodeNodeNgrams2
=
insertNodeNodeNgrams2W
.
map
(
\
(
NodeNodeNgrams2
n1
n2
w
)
->
.
map
(
\
(
NodeNodeNgrams2
n1
n2
w
)
->
NodeNodeNgrams2
(
pgNodeId
n1
)
NodeNodeNgrams2
(
pgNodeId
n1
)
(
pg
Int4
n2
)
(
sql
Int4
n2
)
(
pgDouble
w
)
(
pgDouble
w
)
)
)
...
...
src/Gargantext/Database/Query/Table/Node_NodeNgramsNodeNgrams.hs
View file @
64dbad9e
...
@@ -43,7 +43,7 @@ import Gargantext.Prelude
...
@@ -43,7 +43,7 @@ import Gargantext.Prelude
queryNode_NodeNgrams_NodeNgrams_Table
::
Query
Node_NodeNgrams_NodeNgrams_Read
queryNode_NodeNgrams_NodeNgrams_Table
::
Query
Node_NodeNgrams_NodeNgrams_Read
queryNode_NodeNgrams_NodeNgrams_Table
=
query
Table
node_NodeNgrams_NodeNgrams_Table
queryNode_NodeNgrams_NodeNgrams_Table
=
select
Table
node_NodeNgrams_NodeNgrams_Table
-- | Select NodeNgramsNgrams
-- | Select NodeNgramsNgrams
-- TODO not optimized (get all ngrams without filters)
-- TODO not optimized (get all ngrams without filters)
...
@@ -56,8 +56,8 @@ insert_Node_NodeNgrams_NodeNgrams :: [Node_NodeNgrams_NodeNgrams] -> Cmd err Int
...
@@ -56,8 +56,8 @@ insert_Node_NodeNgrams_NodeNgrams :: [Node_NodeNgrams_NodeNgrams] -> Cmd err Int
insert_Node_NodeNgrams_NodeNgrams
=
insert_Node_NodeNgrams_NodeNgrams_W
insert_Node_NodeNgrams_NodeNgrams
=
insert_Node_NodeNgrams_NodeNgrams_W
.
map
(
\
(
Node_NodeNgrams_NodeNgrams
n
ng1
ng2
maybeWeight
)
->
.
map
(
\
(
Node_NodeNgrams_NodeNgrams
n
ng1
ng2
maybeWeight
)
->
Node_NodeNgrams_NodeNgrams
(
pgNodeId
n
)
Node_NodeNgrams_NodeNgrams
(
pgNodeId
n
)
(
pg
Int4
<$>
ng1
)
(
sql
Int4
<$>
ng1
)
(
pg
Int4
ng2
)
(
sql
Int4
ng2
)
(
pgDouble
<$>
maybeWeight
)
(
pgDouble
<$>
maybeWeight
)
)
)
...
...
src/Gargantext/Database/Query/Table/NodesNgramsRepo.hs
View file @
64dbad9e
...
@@ -30,7 +30,7 @@ import Gargantext.Prelude
...
@@ -30,7 +30,7 @@ import Gargantext.Prelude
selectPatches
::
Query
RepoDbRead
selectPatches
::
Query
RepoDbRead
selectPatches
=
proc
()
->
do
selectPatches
=
proc
()
->
do
repos
<-
query
Table
repoTable
-<
()
repos
<-
select
Table
repoTable
-<
()
returnA
-<
repos
returnA
-<
repos
_selectRepo
::
Cmd
err
[
RepoDbNgrams
]
_selectRepo
::
Cmd
err
[
RepoDbNgrams
]
...
@@ -41,5 +41,5 @@ _insertRepos ns = mkCmd $ \conn -> runInsert_ conn $ Insert repoTable (toWrite n
...
@@ -41,5 +41,5 @@ _insertRepos ns = mkCmd $ \conn -> runInsert_ conn $ Insert repoTable (toWrite n
where
where
toWrite
::
[
NgramsStatePatch
]
->
[
RepoDbWrite
]
toWrite
::
[
NgramsStatePatch
]
->
[
RepoDbWrite
]
toWrite
=
undefined
toWrite
=
undefined
--ns' = map (\(RepoDbNgrams v ps) -> RepoDbWrite (
pg
Int4 v) (pgJSONB ps)) ns
--ns' = map (\(RepoDbNgrams v ps) -> RepoDbWrite (
sql
Int4 v) (pgJSONB ps)) ns
src/Gargantext/Database/Query/Table/User.hs
View file @
64dbad9e
...
@@ -54,8 +54,10 @@ insertUsers us = mkCmd $ \c -> runInsert_ c insert
...
@@ -54,8 +54,10 @@ insertUsers us = mkCmd $ \c -> runInsert_ c insert
insert
=
Insert
userTable
us
rCount
Nothing
insert
=
Insert
userTable
us
rCount
Nothing
deleteUsers
::
[
Username
]
->
Cmd
err
Int64
deleteUsers
::
[
Username
]
->
Cmd
err
Int64
deleteUsers
us
=
mkCmd
$
\
c
->
runDelete
c
userTable
deleteUsers
us
=
mkCmd
$
\
c
->
runDelete_
c
(
\
user
->
in_
(
map
pgStrictText
us
)
(
user_username
user
))
$
Delete
userTable
(
\
user
->
in_
(
map
sqlStrictText
us
)
(
user_username
user
))
rCount
-- Updates email or password only (for now)
-- Updates email or password only (for now)
updateUserDB
::
UserWrite
->
Cmd
err
Int64
updateUserDB
::
UserWrite
->
Cmd
err
Int64
...
@@ -76,11 +78,11 @@ updateUserDB us = mkCmd $ \c -> runUpdate_ c (updateUserQuery us)
...
@@ -76,11 +78,11 @@ updateUserDB us = mkCmd $ \c -> runUpdate_ c (updateUserQuery us)
-----------------------------------------------------------------------
-----------------------------------------------------------------------
toUserWrite
::
NewUser
HashPassword
->
UserWrite
toUserWrite
::
NewUser
HashPassword
->
UserWrite
toUserWrite
(
NewUser
u
m
(
Auth
.
PasswordHash
p
))
=
toUserWrite
(
NewUser
u
m
(
Auth
.
PasswordHash
p
))
=
UserDB
(
Nothing
)
(
pg
StrictText
p
)
UserDB
(
Nothing
)
(
sql
StrictText
p
)
(
Nothing
)
(
pgBool
True
)
(
pg
StrictText
u
)
(
Nothing
)
(
pgBool
True
)
(
sql
StrictText
u
)
(
pg
StrictText
"first_name"
)
(
sql
StrictText
"first_name"
)
(
pg
StrictText
"last_name"
)
(
sql
StrictText
"last_name"
)
(
pg
StrictText
m
)
(
sql
StrictText
m
)
(
pgBool
True
)
(
pgBool
True
)
(
pgBool
True
)
Nothing
(
pgBool
True
)
Nothing
...
@@ -91,25 +93,23 @@ getUsersWith u = map toUserLight <$> runOpaQuery (selectUsersLightWith u)
...
@@ -91,25 +93,23 @@ getUsersWith u = map toUserLight <$> runOpaQuery (selectUsersLightWith u)
selectUsersLightWith
::
Username
->
Query
UserRead
selectUsersLightWith
::
Username
->
Query
UserRead
selectUsersLightWith
u
=
proc
()
->
do
selectUsersLightWith
u
=
proc
()
->
do
row
<-
queryUserTable
-<
()
row
<-
queryUserTable
-<
()
restrict
-<
user_username
row
.==
pg
StrictText
u
restrict
-<
user_username
row
.==
sql
StrictText
u
returnA
-<
row
returnA
-<
row
----------------------------------------------------------
----------------------------------------------------------
getUsersWithId
::
Int
->
Cmd
err
[
UserLight
]
getUsersWithId
::
Int
->
Cmd
err
[
UserLight
]
getUsersWithId
i
=
map
toUserLight
<$>
runOpaQuery
(
selectUsersLightWithId
i
)
getUsersWithId
i
=
map
toUserLight
<$>
runOpaQuery
(
selectUsersLightWithId
i
)
where
where
selectUsersLightWithId
::
Int
->
Query
UserRead
selectUsersLightWithId
::
Int
->
Query
UserRead
selectUsersLightWithId
i'
=
proc
()
->
do
selectUsersLightWithId
i'
=
proc
()
->
do
row
<-
queryUserTable
-<
()
row
<-
queryUserTable
-<
()
restrict
-<
user_id
row
.==
pg
Int4
i'
restrict
-<
user_id
row
.==
sql
Int4
i'
returnA
-<
row
returnA
-<
row
queryUserTable
::
Query
UserRead
queryUserTable
::
Query
UserRead
queryUserTable
=
query
Table
userTable
queryUserTable
=
select
Table
userTable
------------------------------------------------------------------
------------------------------------------------------------------
-- | Select User with some parameters
-- | Select User with some parameters
...
@@ -147,5 +147,5 @@ insertNewUsers newUsers = do
...
@@ -147,5 +147,5 @@ insertNewUsers newUsers = do
insertUsers
$
map
toUserWrite
users'
insertUsers
$
map
toUserWrite
users'
----------------------------------------------------------------------
----------------------------------------------------------------------
instance
QueryRunnerColumnDefault
PGTimestamptz
(
Maybe
UTCTime
)
where
instance
DefaultFromField
PGTimestamptz
(
Maybe
UTCTime
)
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
src/Gargantext/Database/Query/Tree/Root.hs
View file @
64dbad9e
...
@@ -31,7 +31,7 @@ import Gargantext.Database.Schema.Node (NodePoly(..), NodeRead)
...
@@ -31,7 +31,7 @@ import Gargantext.Database.Schema.Node (NodePoly(..), NodeRead)
import
Gargantext.Database.Schema.Node
(
queryNodeTable
)
import
Gargantext.Database.Schema.Node
(
queryNodeTable
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Opaleye
(
restrict
,
(
.==
),
Query
)
import
Opaleye
(
restrict
,
(
.==
),
Query
)
import
Opaleye.
PGTypes
(
pgStrictText
,
pg
Int4
)
import
Opaleye.
SqlTypes
(
sqlStrictText
,
sql
Int4
)
getRootId
::
(
HasNodeError
err
)
=>
User
->
Cmd
err
NodeId
getRootId
::
(
HasNodeError
err
)
=>
User
->
Cmd
err
NodeId
...
@@ -119,21 +119,21 @@ selectRoot :: User -> Query NodeRead
...
@@ -119,21 +119,21 @@ selectRoot :: User -> Query NodeRead
selectRoot
(
UserName
username
)
=
proc
()
->
do
selectRoot
(
UserName
username
)
=
proc
()
->
do
row
<-
queryNodeTable
-<
()
row
<-
queryNodeTable
-<
()
users
<-
queryUserTable
-<
()
users
<-
queryUserTable
-<
()
restrict
-<
_node_typename
row
.==
(
pg
Int4
$
toDBid
NodeUser
)
restrict
-<
_node_typename
row
.==
(
sql
Int4
$
toDBid
NodeUser
)
restrict
-<
user_username
users
.==
(
pg
StrictText
username
)
restrict
-<
user_username
users
.==
(
sql
StrictText
username
)
restrict
-<
_node_user_id
row
.==
(
user_id
users
)
restrict
-<
_node_user_id
row
.==
(
user_id
users
)
returnA
-<
row
returnA
-<
row
selectRoot
(
UserDBId
uid
)
=
proc
()
->
do
selectRoot
(
UserDBId
uid
)
=
proc
()
->
do
row
<-
queryNodeTable
-<
()
row
<-
queryNodeTable
-<
()
restrict
-<
_node_typename
row
.==
(
pg
Int4
$
toDBid
NodeUser
)
restrict
-<
_node_typename
row
.==
(
sql
Int4
$
toDBid
NodeUser
)
restrict
-<
_node_user_id
row
.==
(
pg
Int4
uid
)
restrict
-<
_node_user_id
row
.==
(
sql
Int4
uid
)
returnA
-<
row
returnA
-<
row
selectRoot
(
RootId
nid
)
=
selectRoot
(
RootId
nid
)
=
proc
()
->
do
proc
()
->
do
row
<-
queryNodeTable
-<
()
row
<-
queryNodeTable
-<
()
restrict
-<
_node_typename
row
.==
(
pg
Int4
$
toDBid
NodeUser
)
restrict
-<
_node_typename
row
.==
(
sql
Int4
$
toDBid
NodeUser
)
restrict
-<
_node_id
row
.==
(
pgNodeId
nid
)
restrict
-<
_node_id
row
.==
(
pgNodeId
nid
)
returnA
-<
row
returnA
-<
row
selectRoot
UserPublic
=
panic
{-nodeError $ NodeError-}
"[G.D.Q.T.Root.selectRoot] No root for Public"
selectRoot
UserPublic
=
panic
{-nodeError $ NodeError-}
"[G.D.Q.T.Root.selectRoot] No root for Public"
src/Gargantext/Database/Schema/Ngrams.hs
View file @
64dbad9e
...
@@ -65,9 +65,9 @@ makeLenses ''NgramsPoly
...
@@ -65,9 +65,9 @@ makeLenses ''NgramsPoly
ngramsTable
::
Table
NgramsWrite
NgramsRead
ngramsTable
::
Table
NgramsWrite
NgramsRead
ngramsTable
=
Table
"ngrams"
(
pNgramsDb
NgramsDB
{
_ngrams_id
=
optional
"id"
ngramsTable
=
Table
"ngrams"
(
pNgramsDb
NgramsDB
{
_ngrams_id
=
optional
TableField
"id"
,
_ngrams_terms
=
required
"terms"
,
_ngrams_terms
=
required
TableField
"terms"
,
_ngrams_n
=
required
"n"
,
_ngrams_n
=
required
TableField
"n"
}
}
)
)
...
@@ -117,15 +117,15 @@ instance ToParamSchema NgramsType where
...
@@ -117,15 +117,15 @@ instance ToParamSchema NgramsType where
toParamSchema
_
=
toParamSchema
(
Proxy
::
Proxy
TODO
)
toParamSchema
_
=
toParamSchema
(
Proxy
::
Proxy
TODO
)
instance
QueryRunnerColumnDefault
(
Nullable
PGInt4
)
NgramsTypeId
instance
DefaultFromField
(
Nullable
PGInt4
)
NgramsTypeId
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
pgNgramsType
::
NgramsType
->
Column
PGInt4
pgNgramsType
::
NgramsType
->
Column
PGInt4
pgNgramsType
=
pgNgramsTypeId
.
ngramsTypeId
pgNgramsType
=
pgNgramsTypeId
.
ngramsTypeId
pgNgramsTypeId
::
NgramsTypeId
->
Column
PGInt4
pgNgramsTypeId
::
NgramsTypeId
->
Column
PGInt4
pgNgramsTypeId
(
NgramsTypeId
n
)
=
pg
Int4
n
pgNgramsTypeId
(
NgramsTypeId
n
)
=
sql
Int4
n
ngramsTypeId
::
NgramsType
->
NgramsTypeId
ngramsTypeId
::
NgramsType
->
NgramsTypeId
ngramsTypeId
Authors
=
1
ngramsTypeId
Authors
=
1
...
...
src/Gargantext/Database/Schema/Node.hs
View file @
64dbad9e
...
@@ -55,22 +55,22 @@ $(makeAdaptorAndInstance "pNode" ''NodePoly)
...
@@ -55,22 +55,22 @@ $(makeAdaptorAndInstance "pNode" ''NodePoly)
$
(
makeLensesWith
abbreviatedFields
''
N
odePoly
)
$
(
makeLensesWith
abbreviatedFields
''
N
odePoly
)
nodeTable
::
Table
NodeWrite
NodeRead
nodeTable
::
Table
NodeWrite
NodeRead
nodeTable
=
Table
"nodes"
(
pNode
Node
{
_node_id
=
optional
"id"
nodeTable
=
Table
"nodes"
(
pNode
Node
{
_node_id
=
optional
TableField
"id"
,
_node_hash_id
=
optional
"hash_id"
,
_node_hash_id
=
optional
TableField
"hash_id"
,
_node_typename
=
required
"typename"
,
_node_typename
=
required
TableField
"typename"
,
_node_user_id
=
required
"user_id"
,
_node_user_id
=
required
TableField
"user_id"
,
_node_parent_id
=
optional
"parent_id"
,
_node_parent_id
=
optional
TableField
"parent_id"
,
_node_name
=
required
"name"
,
_node_name
=
required
TableField
"name"
,
_node_date
=
optional
"date"
,
_node_date
=
optional
TableField
"date"
,
_node_hyperdata
=
required
"hyperdata"
,
_node_hyperdata
=
required
TableField
"hyperdata"
-- ignoring ts_vector field here
-- ignoring ts_vector field here
}
}
)
)
queryNodeTable
::
Query
NodeRead
queryNodeTable
::
Query
NodeRead
queryNodeTable
=
query
Table
nodeTable
queryNodeTable
=
select
Table
nodeTable
------------------------------------------------------------------------
------------------------------------------------------------------------
type
NodeWrite
=
NodePoly
(
Maybe
(
Column
PGInt4
)
)
type
NodeWrite
=
NodePoly
(
Maybe
(
Column
PGInt4
)
)
(
Maybe
(
Column
PGText
)
)
(
Maybe
(
Column
PGText
)
)
...
@@ -154,6 +154,7 @@ data NodePolySearch id
...
@@ -154,6 +154,7 @@ data NodePolySearch id
,
_ns_hyperdata
::
hyperdata
,
_ns_hyperdata
::
hyperdata
,
_ns_search
::
search
,
_ns_search
::
search
,
_ns_search_title
::
search
}
deriving
(
Show
,
Generic
)
}
deriving
(
Show
,
Generic
)
$
(
makeAdaptorAndInstance
"pNodeSearch"
''
N
odePolySearch
)
$
(
makeAdaptorAndInstance
"pNodeSearch"
''
N
odePolySearch
)
...
@@ -163,16 +164,17 @@ $(makeLenses ''NodePolySearch)
...
@@ -163,16 +164,17 @@ $(makeLenses ''NodePolySearch)
nodeTableSearch
::
Table
NodeSearchWrite
NodeSearchRead
nodeTableSearch
::
Table
NodeSearchWrite
NodeSearchRead
nodeTableSearch
=
Table
"nodes"
(
pNodeSearch
nodeTableSearch
=
Table
"nodes"
(
pNodeSearch
NodeSearch
{
_ns_id
=
optional
"id"
NodeSearch
{
_ns_id
=
optionalTableField
"id"
,
_ns_typename
=
require
d
"typename"
,
_ns_typename
=
requiredTableFiel
d
"typename"
,
_ns_user_id
=
require
d
"user_id"
,
_ns_user_id
=
requiredTableFiel
d
"user_id"
,
_ns_parent_id
=
require
d
"parent_id"
,
_ns_parent_id
=
requiredTableFiel
d
"parent_id"
,
_ns_name
=
require
d
"name"
,
_ns_name
=
requiredTableFiel
d
"name"
,
_ns_date
=
optional
"date"
,
_ns_date
=
optionalTableField
"date"
,
_ns_hyperdata
=
required
"hyperdata"
,
_ns_hyperdata
=
requiredTableField
"hyperdata"
,
_ns_search
=
optional
"search"
,
_ns_search
=
optionalTableField
"search"
,
_ns_search_title
=
optionalTableField
"search_title"
}
}
)
)
------------------------------------------------------------------------
------------------------------------------------------------------------
src/Gargantext/Database/Schema/NodeNode.hs
View file @
64dbad9e
...
@@ -56,25 +56,25 @@ nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
...
@@ -56,25 +56,25 @@ nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
nodeNodeTable
=
nodeNodeTable
=
Table
"nodes_nodes"
Table
"nodes_nodes"
(
pNodeNode
(
pNodeNode
NodeNode
{
_nn_node1_id
=
required
"node1_id"
NodeNode
{
_nn_node1_id
=
required
TableField
"node1_id"
,
_nn_node2_id
=
required
"node2_id"
,
_nn_node2_id
=
required
TableField
"node2_id"
,
_nn_score
=
optional
"score"
,
_nn_score
=
optional
TableField
"score"
,
_nn_category
=
optional
"category"
,
_nn_category
=
optional
TableField
"category"
}
}
)
)
instance
QueryRunnerColumnDefault
(
Nullable
PGInt4
)
Int
where
instance
DefaultFromField
(
Nullable
PGInt4
)
Int
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
(
Nullable
PGFloat8
)
Int
where
instance
DefaultFromField
(
Nullable
PGFloat8
)
Int
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
(
Nullable
PGFloat8
)
Double
where
instance
DefaultFromField
(
Nullable
PGFloat8
)
Double
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGFloat8
(
Maybe
Double
)
where
instance
DefaultFromField
PGFloat8
(
Maybe
Double
)
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGInt4
(
Maybe
Int
)
where
instance
DefaultFromField
PGInt4
(
Maybe
Int
)
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
src/Gargantext/Database/Schema/NodeNodeNgrams.hs
View file @
64dbad9e
...
@@ -62,11 +62,11 @@ makeLenses ''NodeNodeNgramsPoly
...
@@ -62,11 +62,11 @@ makeLenses ''NodeNodeNgramsPoly
nodeNodeNgramsTable
::
Table
NodeNodeNgramsWrite
NodeNodeNgramsRead
nodeNodeNgramsTable
::
Table
NodeNodeNgramsWrite
NodeNodeNgramsRead
nodeNodeNgramsTable
=
Table
"node_node_ngrams"
nodeNodeNgramsTable
=
Table
"node_node_ngrams"
(
pNodeNodeNgrams
NodeNodeNgrams
(
pNodeNodeNgrams
NodeNodeNgrams
{
_nnng_node1_id
=
required
"node1_id"
{
_nnng_node1_id
=
required
TableField
"node1_id"
,
_nnng_node2_id
=
required
"node2_id"
,
_nnng_node2_id
=
required
TableField
"node2_id"
,
_nnng_ngrams_id
=
required
"ngrams_id"
,
_nnng_ngrams_id
=
required
TableField
"ngrams_id"
,
_nnng_ngramsType
=
required
"ngrams_type"
,
_nnng_ngramsType
=
required
TableField
"ngrams_type"
,
_nnng_weight
=
required
"weight"
,
_nnng_weight
=
required
TableField
"weight"
}
}
)
)
src/Gargantext/Database/Schema/NodeNodeNgrams2.hs
View file @
64dbad9e
...
@@ -53,9 +53,9 @@ makeLenses ''NodeNodeNgrams2Poly
...
@@ -53,9 +53,9 @@ makeLenses ''NodeNodeNgrams2Poly
nodeNodeNgrams2Table
::
Table
NodeNodeNgrams2Write
NodeNodeNgrams2Read
nodeNodeNgrams2Table
::
Table
NodeNodeNgrams2Write
NodeNodeNgrams2Read
nodeNodeNgrams2Table
=
Table
"node_node_ngrams2"
nodeNodeNgrams2Table
=
Table
"node_node_ngrams2"
(
pNodeNodeNgrams2
NodeNodeNgrams2
(
pNodeNodeNgrams2
NodeNodeNgrams2
{
_nnng2_node_id
=
required
"node_id"
{
_nnng2_node_id
=
required
TableField
"node_id"
,
_nnng2_nodengrams_id
=
required
"nodengrams_id"
,
_nnng2_nodengrams_id
=
required
TableField
"nodengrams_id"
,
_nnng2_weight
=
required
"weight"
,
_nnng2_weight
=
required
TableField
"weight"
}
}
)
)
src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs
View file @
64dbad9e
...
@@ -72,16 +72,16 @@ node_NodeNgrams_NodeNgrams_Table :: Table Node_NodeNgrams_NodeNgrams_Write Node_
...
@@ -72,16 +72,16 @@ node_NodeNgrams_NodeNgrams_Table :: Table Node_NodeNgrams_NodeNgrams_Write Node_
node_NodeNgrams_NodeNgrams_Table
=
node_NodeNgrams_NodeNgrams_Table
=
Table
"node_nodengrams_nodengrams"
Table
"node_nodengrams_nodengrams"
(
pNode_NodeNgrams_NodeNgrams
Node_NodeNgrams_NodeNgrams
(
pNode_NodeNgrams_NodeNgrams
Node_NodeNgrams_NodeNgrams
{
_nnn_node_id
=
required
"node_id"
{
_nnn_node_id
=
required
TableField
"node_id"
,
_nnn_nng1_id
=
optional
"node_ngrams1_id"
,
_nnn_nng1_id
=
optional
TableField
"node_ngrams1_id"
,
_nnn_nng2_id
=
required
"node_ngrams2_id"
,
_nnn_nng2_id
=
required
TableField
"node_ngrams2_id"
,
_nnn_weight
=
optional
"weight"
,
_nnn_weight
=
optional
TableField
"weight"
}
}
)
)
instance
QueryRunnerColumnDefault
PGInt4
(
Maybe
Int
)
where
instance
DefaultFromField
PGInt4
(
Maybe
Int
)
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGFloat8
(
Maybe
Double
)
where
instance
DefaultFromField
PGFloat8
(
Maybe
Double
)
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
src/Gargantext/Database/Schema/NodesNgramsRepo.hs
View file @
64dbad9e
...
@@ -46,17 +46,17 @@ type RepoDbNgrams = RepoDbPoly Int NgramsStatePatch
...
@@ -46,17 +46,17 @@ type RepoDbNgrams = RepoDbPoly Int NgramsStatePatch
$
(
makeAdaptorAndInstance
"pRepoDbNgrams"
''
R
epoDbPoly
)
$
(
makeAdaptorAndInstance
"pRepoDbNgrams"
''
R
epoDbPoly
)
makeLenses
''
R
epoDbPoly
makeLenses
''
R
epoDbPoly
instance
QueryRunnerColumnDefault
PGJsonb
instance
DefaultFromField
PGJsonb
(
PatchMap
NgramsType
(
PatchMap
NgramsType
(
PatchMap
NodeId
NgramsTablePatch
))
(
PatchMap
NodeId
NgramsTablePatch
))
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
repoTable
::
Table
RepoDbWrite
RepoDbRead
repoTable
::
Table
RepoDbWrite
RepoDbRead
repoTable
=
Table
"nodes_ngrams_repo"
repoTable
=
Table
"nodes_ngrams_repo"
(
pRepoDbNgrams
RepoDbNgrams
(
pRepoDbNgrams
RepoDbNgrams
{
_rdp_version
=
required
"version"
{
_rdp_version
=
required
TableField
"version"
,
_rdp_patches
=
required
"patches"
,
_rdp_patches
=
required
TableField
"patches"
}
}
)
)
src/Gargantext/Database/Schema/User.hs
View file @
64dbad9e
...
@@ -94,17 +94,17 @@ $(makeLensesWith abbreviatedFields ''UserPoly)
...
@@ -94,17 +94,17 @@ $(makeLensesWith abbreviatedFields ''UserPoly)
userTable
::
Table
UserWrite
UserRead
userTable
::
Table
UserWrite
UserRead
userTable
=
Table
"auth_user"
userTable
=
Table
"auth_user"
(
pUserDB
UserDB
{
user_id
=
optional
"id"
(
pUserDB
UserDB
{
user_id
=
optional
TableField
"id"
,
user_password
=
required
"password"
,
user_password
=
required
TableField
"password"
,
user_lastLogin
=
optional
"last_login"
,
user_lastLogin
=
optional
TableField
"last_login"
,
user_isSuperUser
=
required
"is_superuser"
,
user_isSuperUser
=
required
TableField
"is_superuser"
,
user_username
=
required
"username"
,
user_username
=
required
TableField
"username"
,
user_firstName
=
required
"first_name"
,
user_firstName
=
required
TableField
"first_name"
,
user_lastName
=
required
"last_name"
,
user_lastName
=
required
TableField
"last_name"
,
user_email
=
required
"email"
,
user_email
=
required
TableField
"email"
,
user_isStaff
=
required
"is_staff"
,
user_isStaff
=
required
TableField
"is_staff"
,
user_isActive
=
required
"is_active"
,
user_isActive
=
required
TableField
"is_active"
,
user_dateJoined
=
optional
"date_joined"
,
user_dateJoined
=
optional
TableField
"date_joined"
}
}
)
)
...
...
stack.yaml
View file @
64dbad9e
...
@@ -43,8 +43,8 @@ extra-deps:
...
@@ -43,8 +43,8 @@ extra-deps:
commit
:
8cb8aaf2962ad44d319fcea48442e4397b3c49e8
commit
:
8cb8aaf2962ad44d319fcea48442e4397b3c49e8
# Databases libs
# Databases libs
-
git
:
https://github.com/delanoe/haskell-opaleye.git
#- opaleye-0.6.7002.0
-
git
:
https://github.com/delanoe/haskell-opaleye.git
commit
:
63ee65d974e9d20eaaf17a2e83652175988cbb79
commit
:
9089fa71006d99d01916375818620d78a565b743
-
git
:
https://github.com/delanoe/hsparql.git
-
git
:
https://github.com/delanoe/hsparql.git
commit
:
308c74b71a1abb0a91546fa57d353131248e3a7f
commit
:
308c74b71a1abb0a91546fa57d353131248e3a7f
-
git
:
https://github.com/robstewart57/rdf4h.git
-
git
:
https://github.com/robstewart57/rdf4h.git
...
...
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