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
199
Issues
199
List
Board
Labels
Milestones
Merge Requests
12
Merge Requests
12
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
966bc15d
Commit
966bc15d
authored
Sep 29, 2021
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[DEP] haskell-opaleye dep upgrade
parent
8d1d7c9c
Changes
39
Hide whitespace changes
Inline
Side-by-side
Showing
39 changed files
with
218 additions
and
210 deletions
+218
-210
Graph.hs
src/Gargantext/Core/Viz/Graph.hs
+2
-2
Pairing.hs
src/Gargantext/Database/Action/Flow/Pairing.hs
+1
-1
Search.hs
src/Gargantext/Database/Action/Search.hs
+7
-7
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
+14
-14
Prelude.hs
src/Gargantext/Database/Prelude.hs
+5
-5
Facet.hs
src/Gargantext/Database/Query/Facet.hs
+9
-9
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
+18
-18
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
-4
No files found.
src/Gargantext/Core/Viz/Graph.hs
View file @
966bc15d
...
@@ -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/Pairing.hs
View file @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -45,7 +45,7 @@ searchDocInDatabase _p t = runOpaQuery (queryDocInDatabase t)
...
@@ -45,7 +45,7 @@ searchDocInDatabase _p t = runOpaQuery (queryDocInDatabase t)
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
)
------------------------------------------------------------------------
------------------------------------------------------------------------
...
@@ -83,10 +83,10 @@ queryInCorpus cId t q = proc () -> do
...
@@ -83,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
)
...
@@ -133,14 +133,14 @@ selectContactViaDoc
...
@@ -133,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
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Any.hs
View file @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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
...
@@ -145,7 +145,7 @@ instance (Arbitrary hyperdata
...
@@ -145,7 +145,7 @@ instance (Arbitrary hyperdata
------------------------------------------------------------------------
------------------------------------------------------------------------
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
...
@@ -354,28 +354,28 @@ instance FromField (NodeId, Text)
...
@@ -354,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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -268,13 +268,13 @@ viewAuthorsDoc cId _ nt = proc () -> do
...
@@ -268,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
)
...
@@ -350,13 +350,13 @@ viewDocuments cId t ntId mQuery = proc () -> do
...
@@ -350,13 +350,13 @@ viewDocuments cId t ntId mQuery = proc () -> do
nn
<-
queryNodeNodeTable
-<
()
nn
<-
queryNodeNodeTable
-<
()
restrict
-<
n
^.
ns_id
.==
nn
^.
nn_node2_id
restrict
-<
n
^.
ns_id
.==
nn
^.
nn_node2_id
restrict
-<
nn
^.
nn_node1_id
.==
(
pgNodeId
cId
)
restrict
-<
nn
^.
nn_node1_id
.==
(
pgNodeId
cId
)
restrict
-<
n
^.
ns_typename
.==
(
pg
Int4
ntId
)
restrict
-<
n
^.
ns_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` (
pg
StrictText iLikeQuery)
-- restrict -< (n^.node_name) `ilike` (
sql
StrictText iLikeQuery)
restrict
-<
if
query
==
""
restrict
-<
if
query
==
""
then
pgBool
True
then
pgBool
True
--else (n^.ns_search_title) @@ (pgTSQuery (T.unpack query))
--else (n^.ns_search_title) @@ (pgTSQuery (T.unpack query))
...
@@ -371,7 +371,7 @@ viewDocuments cId t ntId mQuery = proc () -> do
...
@@ -371,7 +371,7 @@ viewDocuments cId t ntId mQuery = proc () -> do
(
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
...
@@ -380,7 +380,7 @@ filterWith :: (PGOrd date, PGOrd title, PGOrd category, PGOrd score, hyperdata ~
...
@@ -380,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
...
@@ -397,7 +397,7 @@ orderWith (Just SourceDesc) = desc facetDoc_source
...
@@ -397,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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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
(
\
(
Node
n_id
_
_
_
_
_
_
_
)
->
n_id
.==
pgNodeId
n
)
(
Delete
nodeTable
(
\
(
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
(
\
(
Node
n_id
_
_
_
_
_
_
_
)
->
in_
((
map
pgNodeId
ns
))
n_id
)
(
Delete
nodeTable
(
\
(
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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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
(
\
(
NodeNode
n1_id
n2_id
_
_
)
->
n1_id
.==
pgNodeId
n1
(
Delete
nodeNodeTable
.&&
n2_id
.==
pgNodeId
n2
)
(
\
(
NodeNode
n1_id
n2_id
_
_
)
->
n1_id
.==
pgNodeId
n1
.&&
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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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
)
)
...
@@ -164,17 +164,17 @@ $(makeLenses ''NodePolySearch)
...
@@ -164,17 +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
=
optional
TableField
"id"
,
_ns_typename
=
required
"typename"
,
_ns_typename
=
required
TableField
"typename"
,
_ns_user_id
=
required
"user_id"
,
_ns_user_id
=
required
TableField
"user_id"
,
_ns_parent_id
=
required
"parent_id"
,
_ns_parent_id
=
required
TableField
"parent_id"
,
_ns_name
=
required
"name"
,
_ns_name
=
required
TableField
"name"
,
_ns_date
=
optional
"date"
,
_ns_date
=
optional
TableField
"date"
,
_ns_hyperdata
=
required
"hyperdata"
,
_ns_hyperdata
=
required
TableField
"hyperdata"
,
_ns_search
=
optional
"search"
,
_ns_search
=
optional
TableField
"search"
,
_ns_search_title
=
optional
"search_title"
,
_ns_search_title
=
optional
TableField
"search_title"
}
}
)
)
------------------------------------------------------------------------
------------------------------------------------------------------------
src/Gargantext/Database/Schema/NodeNode.hs
View file @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -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 @
966bc15d
...
@@ -43,10 +43,8 @@ extra-deps:
...
@@ -43,10 +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/cgenie/haskell-opaleye.git
commit
:
41e3212e7da83d295cd6d0fa4f0a2b55b86bbbca
-
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