Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
153
Issues
153
List
Board
Labels
Milestones
Merge Requests
10
Merge Requests
10
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
where
fromField
=
fromField'
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataGraph
instance
DefaultFromField
PGJsonb
HyperdataGraph
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
-----------------------------------------------------------
-- 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)
selectQuery
::
NodeType
->
NodeId
->
Query
(
Column
PGInt4
)
selectQuery
nt'
nId'
=
proc
()
->
do
(
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'
)
returnA
-<
node
^.
node_id
...
...
src/Gargantext/Database/Action/Search.hs
View file @
966bc15d
...
...
@@ -45,7 +45,7 @@ searchDocInDatabase _p t = runOpaQuery (queryDocInDatabase t)
queryDocInDatabase
q
=
proc
()
->
do
row
<-
queryNodeSearchTable
-<
()
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
)
------------------------------------------------------------------------
...
...
@@ -83,10 +83,10 @@ queryInCorpus cId t q = proc () -> do
(
n
,
nn
)
<-
joinInCorpus
-<
()
restrict
-<
(
nn
^.
nn_node1_id
)
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
if
t
then
(
nn
^.
nn_category
)
.==
(
toNullable
$
pg
Int4
0
)
else
(
nn
^.
nn_category
)
.>=
(
toNullable
$
pg
Int4
1
)
then
(
nn
^.
nn_category
)
.==
(
toNullable
$
sql
Int4
0
)
else
(
nn
^.
nn_category
)
.>=
(
toNullable
$
sql
Int4
1
)
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
)
(
n
^.
ns_date
)
(
n
^.
ns_name
)
...
...
@@ -133,14 +133,14 @@ selectContactViaDoc
selectContactViaDoc
cId
aId
q
=
proc
()
->
do
(
doc
,
(
corpus_doc
,
(
_contact_doc
,
(
annuaire_contact
,
contact
))))
<-
queryContactViaDoc
-<
()
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
-<
(
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
,
contact
^.
node_date
,
contact
^.
node_hyperdata
,
toNullable
$
pg
Int4
1
,
toNullable
$
sql
Int4
1
)
selectGroup
::
HasDBid
NodeType
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Any.hs
View file @
966bc15d
...
...
@@ -45,7 +45,7 @@ instance ToSchema HyperdataAny where
instance
FromField
HyperdataAny
where
fromField
=
fromField'
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataAny
instance
DefaultFromField
PGJsonb
HyperdataAny
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs
View file @
966bc15d
...
...
@@ -166,12 +166,12 @@ instance FromField HyperdataContact where
fromField
=
fromField'
-- | Database (Opaleye instance)
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataContact
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
DefaultFromField
PGJsonb
HyperdataContact
where
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
(
Nullable
PGJsonb
)
HyperdataContact
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
DefaultFromField
(
Nullable
PGJsonb
)
HyperdataContact
where
defaultFromField
=
fieldQueryRunnerColumn
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Corpus.hs
View file @
966bc15d
...
...
@@ -90,10 +90,10 @@ instance FromField HyperdataAnnuaire
where
fromField
=
fromField'
------------------------------------------------------------------------
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataCorpus
instance
DefaultFromField
PGJsonb
HyperdataCorpus
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataAnnuaire
instance
DefaultFromField
PGJsonb
HyperdataAnnuaire
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
src/Gargantext/Database/Admin/Types/Hyperdata/Dashboard.hs
View file @
966bc15d
...
...
@@ -71,7 +71,7 @@ instance ToSchema HyperdataDashboard where
instance
FromField
HyperdataDashboard
where
fromField
=
fromField'
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataDashboard
instance
DefaultFromField
PGJsonb
HyperdataDashboard
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
src/Gargantext/Database/Admin/Types/Hyperdata/Document.hs
View file @
966bc15d
...
...
@@ -202,11 +202,11 @@ instance ToField HyperdataDocumentV3 where
toField
=
toJSONField
------------------------------------------------------------------------
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataDocument
instance
DefaultFromField
PGJsonb
HyperdataDocument
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataDocumentV3
instance
DefaultFromField
PGJsonb
HyperdataDocumentV3
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
------------------------------------------------------------------------
src/Gargantext/Database/Admin/Types/Hyperdata/File.hs
View file @
966bc15d
...
...
@@ -54,9 +54,9 @@ instance FromField HyperdataFile
where
fromField
=
fromField'
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataFile
instance
DefaultFromField
PGJsonb
HyperdataFile
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
ToSchema
HyperdataFile
where
declareNamedSchema
proxy
=
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Frame.hs
View file @
966bc15d
...
...
@@ -53,9 +53,9 @@ instance FromField HyperdataFrame
where
fromField
=
fromField'
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataFrame
instance
DefaultFromField
PGJsonb
HyperdataFrame
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
ToSchema
HyperdataFrame
where
declareNamedSchema
proxy
=
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/List.hs
View file @
966bc15d
...
...
@@ -98,12 +98,12 @@ instance FromField HyperdataListCooc
where
fromField
=
fromField'
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataList
instance
DefaultFromField
PGJsonb
HyperdataList
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataListCooc
defaultFromField
=
fieldQueryRunnerColumn
instance
DefaultFromField
PGJsonb
HyperdataListCooc
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
ToSchema
HyperdataList
where
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Model.hs
View file @
966bc15d
...
...
@@ -48,9 +48,9 @@ instance FromField HyperdataModel
where
fromField
=
fromField'
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataModel
instance
DefaultFromField
PGJsonb
HyperdataModel
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
ToSchema
HyperdataModel
where
declareNamedSchema
proxy
=
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Phylo.hs
View file @
966bc15d
...
...
@@ -56,6 +56,6 @@ instance ToSchema HyperdataPhylo where
instance
FromField
HyperdataPhylo
where
fromField
=
fromField'
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataPhylo
instance
DefaultFromField
PGJsonb
HyperdataPhylo
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
src/Gargantext/Database/Admin/Types/Hyperdata/Prelude.hs
View file @
966bc15d
...
...
@@ -48,7 +48,7 @@ import GHC.Generics (Generic)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
,
wellNamedSchema
)
import
Gargantext.Database.Prelude
(
fromField'
)
import
Gargantext.Prelude
import
Opaleye
(
QueryRunnerColumnDefault
,
queryRunnerColumnDefault
,
PGJsonb
,
fieldQueryRunnerColumn
,
Nullable
)
import
Opaleye
(
DefaultFromField
(
..
),
PGJsonb
,
defaultFromField
,
fieldQueryRunnerColumn
,
Nullable
)
import
Test.QuickCheck
(
elements
)
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
instance
FromField
HyperdataTexts
where
fromField
=
fromField'
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataTexts
instance
DefaultFromField
PGJsonb
HyperdataTexts
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
src/Gargantext/Database/Admin/Types/Hyperdata/User.hs
View file @
966bc15d
...
...
@@ -120,12 +120,12 @@ instance FromField HyperdataPublic where
fromField
=
fromField'
-- | Database (Opaleye instance)
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataUser
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
DefaultFromField
PGJsonb
HyperdataUser
where
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataPrivate
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
DefaultFromField
PGJsonb
HyperdataPrivate
where
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataPublic
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
DefaultFromField
PGJsonb
HyperdataPublic
where
defaultFromField
=
fieldQueryRunnerColumn
src/Gargantext/Database/Admin/Types/Node.hs
View file @
966bc15d
...
...
@@ -33,7 +33,7 @@ import Database.PostgreSQL.Simple.ToField (ToField, toField)
import
GHC.Generics
(
Generic
)
import
Servant
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
Gargantext.Prelude.Crypto.Hash
(
Hash
)
import
Test.QuickCheck.Arbitrary
...
...
@@ -145,7 +145,7 @@ instance (Arbitrary hyperdata
------------------------------------------------------------------------
pgNodeId
::
NodeId
->
O
.
Column
O
.
PGInt4
pgNodeId
=
O
.
pg
Int4
.
id2int
pgNodeId
=
O
.
sql
Int4
.
id2int
where
id2int
::
NodeId
->
Int
id2int
(
NodeId
n
)
=
n
...
...
@@ -354,28 +354,28 @@ instance FromField (NodeId, Text)
fromField = fromField'
-}
------------------------------------------------------------------------
instance
QueryRunnerColumnDefault
PGTSVector
(
Maybe
TSVector
)
instance
DefaultFromField
PGTSVector
(
Maybe
TSVector
)
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGInt4
(
Maybe
NodeId
)
instance
DefaultFromField
PGInt4
(
Maybe
NodeId
)
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGInt4
NodeId
instance
DefaultFromField
PGInt4
NodeId
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
(
Nullable
PGInt4
)
NodeId
instance
DefaultFromField
(
Nullable
PGInt4
)
NodeId
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
(
QueryRunnerColumnDefault
(
Nullable
O
.
PGTimestamptz
)
UTCTime
)
instance
(
DefaultFromField
(
Nullable
O
.
PGTimestamptz
)
UTCTime
)
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGText
(
Maybe
Hash
)
instance
DefaultFromField
PGText
(
Maybe
Hash
)
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
src/Gargantext/Database/Prelude.hs
View file @
966bc15d
...
...
@@ -31,7 +31,7 @@ import Database.PostgreSQL.Simple (Connection, connect)
import
Database.PostgreSQL.Simple.FromField
(
Conversion
,
ResultError
(
ConversionFailed
),
fromField
,
returnError
)
import
Database.PostgreSQL.Simple.Internal
(
Field
)
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
System.IO
(
FilePath
)
import
System.IO
(
stderr
)
...
...
@@ -56,7 +56,7 @@ instance HasConfig GargConfig where
hasConfig
=
identity
-------------------------------------------------------
type
JSONB
=
QueryRunnerColumnDefault
PGJsonb
type
JSONB
=
DefaultFromField
PGJsonb
-------------------------------------------------------
type
CmdM''
env
err
m
=
...
...
@@ -111,11 +111,11 @@ runCmd env m = runExceptT $ runReaderT m env
runOpaQuery
::
Default
FromFields
fields
haskells
=>
Select
fields
->
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
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
pure
$
fromInt64ToInt
$
DL
.
head
counts
...
...
@@ -189,5 +189,5 @@ fromField' field mb = do
]
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
-}
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
)
(
_node_date
doc
)
(
_node_name
doc
)
(
_node_hyperdata
doc
)
(
toNullable
$
pg
Int4
1
)
(
toNullable
$
sql
Int4
1
)
(
toNullable
$
pgDouble
1
)
(
toNullable
$
pgDouble
1
)
...
...
@@ -350,13 +350,13 @@ viewDocuments cId t ntId mQuery = proc () -> do
nn
<-
queryNodeNodeTable
-<
()
restrict
-<
n
^.
ns_id
.==
nn
^.
nn_node2_id
restrict
-<
nn
^.
nn_node1_id
.==
(
pgNodeId
cId
)
restrict
-<
n
^.
ns_typename
.==
(
pg
Int4
ntId
)
restrict
-<
if
t
then
nn
^.
nn_category
.==
(
pg
Int4
0
)
else
nn
^.
nn_category
.>=
(
pg
Int4
1
)
restrict
-<
n
^.
ns_typename
.==
(
sql
Int4
ntId
)
restrict
-<
if
t
then
nn
^.
nn_category
.==
(
sql
Int4
0
)
else
nn
^.
nn_category
.>=
(
sql
Int4
1
)
let
query
=
(
fromMaybe
""
mQuery
)
-- iLikeQuery = T.intercalate "" ["%", query, "%"]
-- restrict -< (n^.node_name) `ilike` (
pg
StrictText iLikeQuery)
-- restrict -< (n^.node_name) `ilike` (
sql
StrictText iLikeQuery)
restrict
-<
if
query
==
""
then
pgBool
True
--else (n^.ns_search_title) @@ (pgTSQuery (T.unpack query))
...
...
@@ -371,7 +371,7 @@ viewDocuments cId t ntId mQuery = proc () -> do
(
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
.
Limit
->
Maybe
OrderBy
...
...
@@ -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
orderWith
::
(
PGOrd
b1
,
PGOrd
b2
,
PGOrd
b3
,
PG
Ord
b4
)
orderWith
::
(
SqlOrd
b1
,
SqlOrd
b2
,
SqlOrd
b3
,
Sql
Ord
b4
)
=>
Maybe
OrderBy
->
Order
(
Facet
id
(
Column
b1
)
(
Column
b2
)
(
Column
SqlJsonb
)
(
Column
b3
)
ngramCount
(
Column
b4
))
orderWith
(
Just
DateAsc
)
=
asc
facetDoc_created
...
...
@@ -397,7 +397,7 @@ orderWith (Just SourceDesc) = desc facetDoc_source
orderWith
_
=
asc
facetDoc_created
facetDoc_source
::
PG
IsJson
a
facetDoc_source
::
Sql
IsJson
a
=>
Facet
id
created
title
(
Column
a
)
favorite
ngramCount
score
->
Column
(
Nullable
PGText
)
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
import
Gargantext.Prelude
queryNgramsTable
::
Query
NgramsRead
queryNgramsTable
=
query
Table
ngramsTable
queryNgramsTable
=
select
Table
ngramsTable
selectNgramsByDoc
::
[
ListId
]
->
DocId
->
NgramsType
->
Cmd
err
[
Text
]
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)
queryNodeSearchTable
::
Query
NodeSearchRead
queryNodeSearchTable
=
query
Table
nodeTableSearch
queryNodeSearchTable
=
select
Table
nodeTableSearch
selectNode
::
Column
PGInt4
->
Query
NodeRead
selectNode
id'
=
proc
()
->
do
...
...
@@ -78,20 +78,26 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
let
typeId'
=
maybe
0
toDBid
maybeNodeType
restrict
-<
if
typeId'
>
0
then
typeId
.==
(
pg
Int4
(
typeId'
::
Int
))
then
typeId
.==
(
sql
Int4
(
typeId'
::
Int
))
else
(
pgBool
True
)
returnA
-<
row
)
-<
()
returnA
-<
node'
deleteNode
::
NodeId
->
Cmd
err
Int
deleteNode
n
=
mkCmd
$
\
conn
->
fromIntegral
<$>
runDelete
conn
nodeTable
(
\
(
Node
n_id
_
_
_
_
_
_
_
)
->
n_id
.==
pgNodeId
n
)
fromIntegral
<$>
runDelete_
conn
(
Delete
nodeTable
(
\
(
Node
n_id
_
_
_
_
_
_
_
)
->
n_id
.==
pgNodeId
n
)
rCount
)
deleteNodes
::
[
NodeId
]
->
Cmd
err
Int
deleteNodes
ns
=
mkCmd
$
\
conn
->
fromIntegral
<$>
runDelete
conn
nodeTable
(
\
(
Node
n_id
_
_
_
_
_
_
_
)
->
in_
((
map
pgNodeId
ns
))
n_id
)
fromIntegral
<$>
runDelete_
conn
(
Delete
nodeTable
(
\
(
Node
n_id
_
_
_
_
_
_
_
)
->
in_
((
map
pgNodeId
ns
))
n_id
)
rCount
)
-- TODO: NodeType should match with `a'
getNodesWith
::
(
JSONB
a
,
HasDBid
NodeType
)
=>
NodeId
->
proxy
a
->
Maybe
NodeType
...
...
@@ -168,7 +174,7 @@ getNodesWithType nt _ = runOpaQuery $ selectNodesWithType nt
=>
NodeType
->
Query
NodeRead
selectNodesWithType
nt'
=
proc
()
->
do
row
@
(
Node
_
_
tn
_
_
_
_
_
)
<-
queryNodeTable
-<
()
restrict
-<
tn
.==
(
pg
Int4
$
toDBid
nt'
)
restrict
-<
tn
.==
(
sql
Int4
$
toDBid
nt'
)
returnA
-<
row
getNodesIdWithType
::
(
HasNodeError
err
,
HasDBid
NodeType
)
=>
NodeType
->
Cmd
err
[
NodeId
]
...
...
@@ -180,7 +186,7 @@ selectNodesIdWithType :: HasDBid NodeType
=>
NodeType
->
Query
(
Column
PGInt4
)
selectNodesIdWithType
nt
=
proc
()
->
do
row
@
(
Node
_
_
tn
_
_
_
_
_
)
<-
queryNodeTable
-<
()
restrict
-<
tn
.==
(
pg
Int4
$
toDBid
nt
)
restrict
-<
tn
.==
(
sql
Int4
$
toDBid
nt
)
returnA
-<
_node_id
row
------------------------------------------------------------------------
...
...
@@ -229,10 +235,10 @@ node :: (ToJSON a, Hyperdata a, HasDBid NodeType)
->
NodeWrite
node
nodeType
name
hyperData
parentId
userId
=
Node
Nothing
Nothing
(
pg
Int4
typeId
)
(
pg
Int4
userId
)
(
sql
Int4
typeId
)
(
sql
Int4
userId
)
(
pgNodeId
<$>
parentId
)
(
pg
StrictText
name
)
(
sql
StrictText
name
)
Nothing
(
pgJSONB
$
cs
$
encode
hyperData
)
where
...
...
@@ -250,10 +256,10 @@ insertNodes' ns = mkCmd $ \conn -> runInsert_ conn
ns' :: [NodeWrite]
ns' = map (\(Node i t u p n d h)
-> Node (pgNodeId <$> i)
(
pg
Int4 $ toDBid t)
(
pg
Int4 u)
(
sql
Int4 $ toDBid t)
(
sql
Int4 u)
(pgNodeId <$> p)
(
pg
StrictText n)
(
sql
StrictText n)
(pgUTCTime <$> d)
(pgJSONB $ cs $ encode h)
) ns
...
...
@@ -275,7 +281,7 @@ insertNodesWithParentR pid ns = insertNodesR (set node_parent_id (pgNodeId <$> p
node2table
::
HasDBid
NodeType
=>
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"
...
...
src/Gargantext/Database/Query/Table/Node/Children.hs
View file @
966bc15d
...
...
@@ -75,7 +75,7 @@ selectChildren parentId maybeNodeType = proc () -> do
(
NodeNode
n1id
n2id
_
_
)
<-
queryNodeNodeTable
-<
()
let
nodeType
=
maybe
0
toDBid
maybeNodeType
restrict
-<
typeName
.==
pg
Int4
nodeType
restrict
-<
typeName
.==
sql
Int4
nodeType
restrict
-<
(
.||
)
(
parent_id
.==
(
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)
where
q
u'
=
proc
()
->
do
(
n
,
usrs
)
<-
join'
-<
()
restrict
-<
user_username
usrs
.==
(
toNullable
$
pg
StrictText
u'
)
restrict
-<
_node_typename
n
.==
(
pg
Int4
$
toDBid
nt
)
restrict
-<
user_username
usrs
.==
(
toNullable
$
sql
StrictText
u'
)
restrict
-<
_node_typename
n
.==
(
sql
Int4
$
toDBid
nt
)
returnA
-<
_node_id
n
join'
::
Query
(
NodeRead
,
UserReadNull
)
...
...
src/Gargantext/Database/Query/Table/NodeNode.hs
View file @
966bc15d
...
...
@@ -54,7 +54,7 @@ import Gargantext.Prelude
queryNodeNodeTable
::
Query
NodeNodeRead
queryNodeNodeTable
=
query
Table
nodeNodeTable
queryNodeNodeTable
=
select
Table
nodeNodeTable
-- | not optimized (get all ngrams without filters)
_nodesNodes
::
Cmd
err
[
NodeNode
]
...
...
@@ -87,7 +87,7 @@ getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
(NodeNode _ n1id n2id _ _) <- queryNodeNodeTable -< ()
let nodeType = maybe 0 toDBid maybeNodeType
restrict -< typeName .==
pg
Int4 nodeType
restrict -< typeName .==
sql
Int4 nodeType
restrict -< (.||) (parent_id .== (pgNodeId parentId))
( (.&&) (n1id .== pgNodeId parentId)
...
...
@@ -105,7 +105,7 @@ insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
->
NodeNode
(
pgNodeId
n1
)
(
pgNodeId
n2
)
(
pgDouble
<$>
x
)
(
pg
Int4
<$>
y
)
(
sql
Int4
<$>
y
)
)
ns
...
...
@@ -116,9 +116,13 @@ type Node2_Id = NodeId
deleteNodeNode
::
Node1_Id
->
Node2_Id
->
Cmd
err
Int
deleteNodeNode
n1
n2
=
mkCmd
$
\
conn
->
fromIntegral
<$>
runDelete
conn
nodeNodeTable
(
\
(
NodeNode
n1_id
n2_id
_
_
)
->
n1_id
.==
pgNodeId
n1
.&&
n2_id
.==
pgNodeId
n2
)
fromIntegral
<$>
runDelete_
conn
(
Delete
nodeNodeTable
(
\
(
NodeNode
n1_id
n2_id
_
_
)
->
n1_id
.==
pgNodeId
n1
.&&
n2_id
.==
pgNodeId
n2
)
rCount
)
------------------------------------------------------------------------
-- | Favorite management
...
...
@@ -177,8 +181,8 @@ selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
queryCountDocs
cId'
=
proc
()
->
do
(
n
,
nn
)
<-
joinInCorpus
-<
()
restrict
-<
nn
^.
nn_node1_id
.==
(
toNullable
$
pgNodeId
cId'
)
restrict
-<
nn
^.
nn_category
.>=
(
toNullable
$
pg
Int4
1
)
restrict
-<
n
^.
node_typename
.==
(
pg
Int4
$
toDBid
NodeDocument
)
restrict
-<
nn
^.
nn_category
.>=
(
toNullable
$
sql
Int4
1
)
restrict
-<
n
^.
node_typename
.==
(
sql
Int4
$
toDBid
NodeDocument
)
returnA
-<
n
...
...
@@ -198,8 +202,8 @@ queryDocs :: HasDBid NodeType => CorpusId -> O.Query (Column PGJsonb)
queryDocs
cId
=
proc
()
->
do
(
n
,
nn
)
<-
joinInCorpus
-<
()
restrict
-<
nn
^.
nn_node1_id
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
nn
^.
nn_category
.>=
(
toNullable
$
pg
Int4
1
)
restrict
-<
n
^.
node_typename
.==
(
pg
Int4
$
toDBid
NodeDocument
)
restrict
-<
nn
^.
nn_category
.>=
(
toNullable
$
sql
Int4
1
)
restrict
-<
n
^.
node_typename
.==
(
sql
Int4
$
toDBid
NodeDocument
)
returnA
-<
view
(
node_hyperdata
)
n
selectDocNodes
::
HasDBid
NodeType
=>
CorpusId
->
Cmd
err
[
Node
HyperdataDocument
]
...
...
@@ -209,8 +213,8 @@ queryDocNodes :: HasDBid NodeType =>CorpusId -> O.Query NodeRead
queryDocNodes
cId
=
proc
()
->
do
(
n
,
nn
)
<-
joinInCorpus
-<
()
restrict
-<
nn
^.
nn_node1_id
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
nn
^.
nn_category
.>=
(
toNullable
$
pg
Int4
1
)
restrict
-<
n
^.
node_typename
.==
(
pg
Int4
$
toDBid
NodeDocument
)
restrict
-<
nn
^.
nn_category
.>=
(
toNullable
$
sql
Int4
1
)
restrict
-<
n
^.
node_typename
.==
(
sql
Int4
$
toDBid
NodeDocument
)
returnA
-<
n
joinInCorpus
::
O
.
Query
(
NodeRead
,
NodeNodeReadNull
)
...
...
@@ -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
)]
selectPublicNodes
=
runOpaQuery
(
queryWithType
NodeFolderPublic
)
queryWithType
::
HasDBid
NodeType
=>
NodeType
->
O
.
Query
(
NodeRead
,
Column
(
Nullable
PGInt4
))
queryWithType
nt
=
proc
()
->
do
(
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
)
src/Gargantext/Database/Query/Table/NodeNodeNgrams.hs
View file @
966bc15d
...
...
@@ -31,7 +31,7 @@ import Prelude
queryNodeNodeNgramsTable
::
Query
NodeNodeNgramsRead
queryNodeNodeNgramsTable
=
query
Table
nodeNodeNgramsTable
queryNodeNodeNgramsTable
=
select
Table
nodeNodeNgramsTable
-- | Insert utils
insertNodeNodeNgrams
::
[
NodeNodeNgrams
]
->
Cmd
err
Int
...
...
@@ -39,7 +39,7 @@ insertNodeNodeNgrams = insertNodeNodeNgramsW
.
map
(
\
(
NodeNodeNgrams
n1
n2
ng
nt
w
)
->
NodeNodeNgrams
(
pgNodeId
n1
)
(
pgNodeId
n2
)
(
pg
Int4
ng
)
(
sql
Int4
ng
)
(
pgNgramsTypeId
nt
)
(
pgDouble
w
)
)
...
...
src/Gargantext/Database/Query/Table/NodeNodeNgrams2.hs
View file @
966bc15d
...
...
@@ -29,14 +29,14 @@ import Prelude
_queryNodeNodeNgrams2Table
::
Query
NodeNodeNgrams2Read
_queryNodeNodeNgrams2Table
=
query
Table
nodeNodeNgrams2Table
_queryNodeNodeNgrams2Table
=
select
Table
nodeNodeNgrams2Table
-- | Insert utils
insertNodeNodeNgrams2
::
[
NodeNodeNgrams2
]
->
Cmd
err
Int
insertNodeNodeNgrams2
=
insertNodeNodeNgrams2W
.
map
(
\
(
NodeNodeNgrams2
n1
n2
w
)
->
NodeNodeNgrams2
(
pgNodeId
n1
)
(
pg
Int4
n2
)
(
sql
Int4
n2
)
(
pgDouble
w
)
)
...
...
src/Gargantext/Database/Query/Table/Node_NodeNgramsNodeNgrams.hs
View file @
966bc15d
...
...
@@ -43,7 +43,7 @@ import Gargantext.Prelude
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
-- TODO not optimized (get all ngrams without filters)
...
...
@@ -56,8 +56,8 @@ insert_Node_NodeNgrams_NodeNgrams :: [Node_NodeNgrams_NodeNgrams] -> Cmd err Int
insert_Node_NodeNgrams_NodeNgrams
=
insert_Node_NodeNgrams_NodeNgrams_W
.
map
(
\
(
Node_NodeNgrams_NodeNgrams
n
ng1
ng2
maybeWeight
)
->
Node_NodeNgrams_NodeNgrams
(
pgNodeId
n
)
(
pg
Int4
<$>
ng1
)
(
pg
Int4
ng2
)
(
sql
Int4
<$>
ng1
)
(
sql
Int4
ng2
)
(
pgDouble
<$>
maybeWeight
)
)
...
...
src/Gargantext/Database/Query/Table/NodesNgramsRepo.hs
View file @
966bc15d
...
...
@@ -30,7 +30,7 @@ import Gargantext.Prelude
selectPatches
::
Query
RepoDbRead
selectPatches
=
proc
()
->
do
repos
<-
query
Table
repoTable
-<
()
repos
<-
select
Table
repoTable
-<
()
returnA
-<
repos
_selectRepo
::
Cmd
err
[
RepoDbNgrams
]
...
...
@@ -41,5 +41,5 @@ _insertRepos ns = mkCmd $ \conn -> runInsert_ conn $ Insert repoTable (toWrite n
where
toWrite
::
[
NgramsStatePatch
]
->
[
RepoDbWrite
]
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
insert
=
Insert
userTable
us
rCount
Nothing
deleteUsers
::
[
Username
]
->
Cmd
err
Int64
deleteUsers
us
=
mkCmd
$
\
c
->
runDelete
c
userTable
(
\
user
->
in_
(
map
pgStrictText
us
)
(
user_username
user
))
deleteUsers
us
=
mkCmd
$
\
c
->
runDelete_
c
$
Delete
userTable
(
\
user
->
in_
(
map
sqlStrictText
us
)
(
user_username
user
))
rCount
-- Updates email or password only (for now)
updateUserDB
::
UserWrite
->
Cmd
err
Int64
...
...
@@ -76,11 +78,11 @@ updateUserDB us = mkCmd $ \c -> runUpdate_ c (updateUserQuery us)
-----------------------------------------------------------------------
toUserWrite
::
NewUser
HashPassword
->
UserWrite
toUserWrite
(
NewUser
u
m
(
Auth
.
PasswordHash
p
))
=
UserDB
(
Nothing
)
(
pg
StrictText
p
)
(
Nothing
)
(
pgBool
True
)
(
pg
StrictText
u
)
(
pg
StrictText
"first_name"
)
(
pg
StrictText
"last_name"
)
(
pg
StrictText
m
)
UserDB
(
Nothing
)
(
sql
StrictText
p
)
(
Nothing
)
(
pgBool
True
)
(
sql
StrictText
u
)
(
sql
StrictText
"first_name"
)
(
sql
StrictText
"last_name"
)
(
sql
StrictText
m
)
(
pgBool
True
)
(
pgBool
True
)
Nothing
...
...
@@ -91,25 +93,23 @@ getUsersWith u = map toUserLight <$> runOpaQuery (selectUsersLightWith u)
selectUsersLightWith
::
Username
->
Query
UserRead
selectUsersLightWith
u
=
proc
()
->
do
row
<-
queryUserTable
-<
()
restrict
-<
user_username
row
.==
pg
StrictText
u
restrict
-<
user_username
row
.==
sql
StrictText
u
returnA
-<
row
----------------------------------------------------------
getUsersWithId
::
Int
->
Cmd
err
[
UserLight
]
getUsersWithId
i
=
map
toUserLight
<$>
runOpaQuery
(
selectUsersLightWithId
i
)
where
selectUsersLightWithId
::
Int
->
Query
UserRead
selectUsersLightWithId
i'
=
proc
()
->
do
row
<-
queryUserTable
-<
()
restrict
-<
user_id
row
.==
pg
Int4
i'
restrict
-<
user_id
row
.==
sql
Int4
i'
returnA
-<
row
queryUserTable
::
Query
UserRead
queryUserTable
=
query
Table
userTable
queryUserTable
=
select
Table
userTable
------------------------------------------------------------------
-- | Select User with some parameters
...
...
@@ -147,5 +147,5 @@ insertNewUsers newUsers = do
insertUsers
$
map
toUserWrite
users'
----------------------------------------------------------------------
instance
QueryRunnerColumnDefault
PGTimestamptz
(
Maybe
UTCTime
)
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
DefaultFromField
PGTimestamptz
(
Maybe
UTCTime
)
where
defaultFromField
=
fieldQueryRunnerColumn
src/Gargantext/Database/Query/Tree/Root.hs
View file @
966bc15d
...
...
@@ -31,7 +31,7 @@ import Gargantext.Database.Schema.Node (NodePoly(..), NodeRead)
import
Gargantext.Database.Schema.Node
(
queryNodeTable
)
import
Gargantext.Prelude
import
Opaleye
(
restrict
,
(
.==
),
Query
)
import
Opaleye.
PGTypes
(
pgStrictText
,
pg
Int4
)
import
Opaleye.
SqlTypes
(
sqlStrictText
,
sql
Int4
)
getRootId
::
(
HasNodeError
err
)
=>
User
->
Cmd
err
NodeId
...
...
@@ -119,21 +119,21 @@ selectRoot :: User -> Query NodeRead
selectRoot
(
UserName
username
)
=
proc
()
->
do
row
<-
queryNodeTable
-<
()
users
<-
queryUserTable
-<
()
restrict
-<
_node_typename
row
.==
(
pg
Int4
$
toDBid
NodeUser
)
restrict
-<
user_username
users
.==
(
pg
StrictText
username
)
restrict
-<
_node_typename
row
.==
(
sql
Int4
$
toDBid
NodeUser
)
restrict
-<
user_username
users
.==
(
sql
StrictText
username
)
restrict
-<
_node_user_id
row
.==
(
user_id
users
)
returnA
-<
row
selectRoot
(
UserDBId
uid
)
=
proc
()
->
do
row
<-
queryNodeTable
-<
()
restrict
-<
_node_typename
row
.==
(
pg
Int4
$
toDBid
NodeUser
)
restrict
-<
_node_user_id
row
.==
(
pg
Int4
uid
)
restrict
-<
_node_typename
row
.==
(
sql
Int4
$
toDBid
NodeUser
)
restrict
-<
_node_user_id
row
.==
(
sql
Int4
uid
)
returnA
-<
row
selectRoot
(
RootId
nid
)
=
proc
()
->
do
row
<-
queryNodeTable
-<
()
restrict
-<
_node_typename
row
.==
(
pg
Int4
$
toDBid
NodeUser
)
restrict
-<
_node_typename
row
.==
(
sql
Int4
$
toDBid
NodeUser
)
restrict
-<
_node_id
row
.==
(
pgNodeId
nid
)
returnA
-<
row
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
ngramsTable
::
Table
NgramsWrite
NgramsRead
ngramsTable
=
Table
"ngrams"
(
pNgramsDb
NgramsDB
{
_ngrams_id
=
optional
"id"
,
_ngrams_terms
=
required
"terms"
,
_ngrams_n
=
required
"n"
ngramsTable
=
Table
"ngrams"
(
pNgramsDb
NgramsDB
{
_ngrams_id
=
optional
TableField
"id"
,
_ngrams_terms
=
required
TableField
"terms"
,
_ngrams_n
=
required
TableField
"n"
}
)
...
...
@@ -117,15 +117,15 @@ instance ToParamSchema NgramsType where
toParamSchema
_
=
toParamSchema
(
Proxy
::
Proxy
TODO
)
instance
QueryRunnerColumnDefault
(
Nullable
PGInt4
)
NgramsTypeId
instance
DefaultFromField
(
Nullable
PGInt4
)
NgramsTypeId
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
pgNgramsType
::
NgramsType
->
Column
PGInt4
pgNgramsType
=
pgNgramsTypeId
.
ngramsTypeId
pgNgramsTypeId
::
NgramsTypeId
->
Column
PGInt4
pgNgramsTypeId
(
NgramsTypeId
n
)
=
pg
Int4
n
pgNgramsTypeId
(
NgramsTypeId
n
)
=
sql
Int4
n
ngramsTypeId
::
NgramsType
->
NgramsTypeId
ngramsTypeId
Authors
=
1
...
...
src/Gargantext/Database/Schema/Node.hs
View file @
966bc15d
...
...
@@ -55,22 +55,22 @@ $(makeAdaptorAndInstance "pNode" ''NodePoly)
$
(
makeLensesWith
abbreviatedFields
''
N
odePoly
)
nodeTable
::
Table
NodeWrite
NodeRead
nodeTable
=
Table
"nodes"
(
pNode
Node
{
_node_id
=
optional
"id"
,
_node_hash_id
=
optional
"hash_id"
,
_node_typename
=
required
"typename"
,
_node_user_id
=
required
"user_id"
nodeTable
=
Table
"nodes"
(
pNode
Node
{
_node_id
=
optional
TableField
"id"
,
_node_hash_id
=
optional
TableField
"hash_id"
,
_node_typename
=
required
TableField
"typename"
,
_node_user_id
=
required
TableField
"user_id"
,
_node_parent_id
=
optional
"parent_id"
,
_node_name
=
required
"name"
,
_node_date
=
optional
"date"
,
_node_parent_id
=
optional
TableField
"parent_id"
,
_node_name
=
required
TableField
"name"
,
_node_date
=
optional
TableField
"date"
,
_node_hyperdata
=
required
"hyperdata"
,
_node_hyperdata
=
required
TableField
"hyperdata"
-- ignoring ts_vector field here
}
)
queryNodeTable
::
Query
NodeRead
queryNodeTable
=
query
Table
nodeTable
queryNodeTable
=
select
Table
nodeTable
------------------------------------------------------------------------
type
NodeWrite
=
NodePoly
(
Maybe
(
Column
PGInt4
)
)
(
Maybe
(
Column
PGText
)
)
...
...
@@ -164,17 +164,17 @@ $(makeLenses ''NodePolySearch)
nodeTableSearch
::
Table
NodeSearchWrite
NodeSearchRead
nodeTableSearch
=
Table
"nodes"
(
pNodeSearch
NodeSearch
{
_ns_id
=
optional
"id"
,
_ns_typename
=
required
"typename"
,
_ns_user_id
=
required
"user_id"
NodeSearch
{
_ns_id
=
optional
TableField
"id"
,
_ns_typename
=
required
TableField
"typename"
,
_ns_user_id
=
required
TableField
"user_id"
,
_ns_parent_id
=
required
"parent_id"
,
_ns_name
=
required
"name"
,
_ns_date
=
optional
"date"
,
_ns_parent_id
=
required
TableField
"parent_id"
,
_ns_name
=
required
TableField
"name"
,
_ns_date
=
optional
TableField
"date"
,
_ns_hyperdata
=
required
"hyperdata"
,
_ns_search
=
optional
"search"
,
_ns_search_title
=
optional
"search_title"
,
_ns_hyperdata
=
required
TableField
"hyperdata"
,
_ns_search
=
optional
TableField
"search"
,
_ns_search_title
=
optional
TableField
"search_title"
}
)
------------------------------------------------------------------------
src/Gargantext/Database/Schema/NodeNode.hs
View file @
966bc15d
...
...
@@ -56,25 +56,25 @@ nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
nodeNodeTable
=
Table
"nodes_nodes"
(
pNodeNode
NodeNode
{
_nn_node1_id
=
required
"node1_id"
,
_nn_node2_id
=
required
"node2_id"
,
_nn_score
=
optional
"score"
,
_nn_category
=
optional
"category"
NodeNode
{
_nn_node1_id
=
required
TableField
"node1_id"
,
_nn_node2_id
=
required
TableField
"node2_id"
,
_nn_score
=
optional
TableField
"score"
,
_nn_category
=
optional
TableField
"category"
}
)
instance
QueryRunnerColumnDefault
(
Nullable
PGInt4
)
Int
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
DefaultFromField
(
Nullable
PGInt4
)
Int
where
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
(
Nullable
PGFloat8
)
Int
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
DefaultFromField
(
Nullable
PGFloat8
)
Int
where
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
(
Nullable
PGFloat8
)
Double
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
DefaultFromField
(
Nullable
PGFloat8
)
Double
where
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGFloat8
(
Maybe
Double
)
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
DefaultFromField
PGFloat8
(
Maybe
Double
)
where
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGInt4
(
Maybe
Int
)
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
DefaultFromField
PGInt4
(
Maybe
Int
)
where
defaultFromField
=
fieldQueryRunnerColumn
src/Gargantext/Database/Schema/NodeNodeNgrams.hs
View file @
966bc15d
...
...
@@ -62,11 +62,11 @@ makeLenses ''NodeNodeNgramsPoly
nodeNodeNgramsTable
::
Table
NodeNodeNgramsWrite
NodeNodeNgramsRead
nodeNodeNgramsTable
=
Table
"node_node_ngrams"
(
pNodeNodeNgrams
NodeNodeNgrams
{
_nnng_node1_id
=
required
"node1_id"
,
_nnng_node2_id
=
required
"node2_id"
,
_nnng_ngrams_id
=
required
"ngrams_id"
,
_nnng_ngramsType
=
required
"ngrams_type"
,
_nnng_weight
=
required
"weight"
{
_nnng_node1_id
=
required
TableField
"node1_id"
,
_nnng_node2_id
=
required
TableField
"node2_id"
,
_nnng_ngrams_id
=
required
TableField
"ngrams_id"
,
_nnng_ngramsType
=
required
TableField
"ngrams_type"
,
_nnng_weight
=
required
TableField
"weight"
}
)
src/Gargantext/Database/Schema/NodeNodeNgrams2.hs
View file @
966bc15d
...
...
@@ -53,9 +53,9 @@ makeLenses ''NodeNodeNgrams2Poly
nodeNodeNgrams2Table
::
Table
NodeNodeNgrams2Write
NodeNodeNgrams2Read
nodeNodeNgrams2Table
=
Table
"node_node_ngrams2"
(
pNodeNodeNgrams2
NodeNodeNgrams2
{
_nnng2_node_id
=
required
"node_id"
,
_nnng2_nodengrams_id
=
required
"nodengrams_id"
,
_nnng2_weight
=
required
"weight"
{
_nnng2_node_id
=
required
TableField
"node_id"
,
_nnng2_nodengrams_id
=
required
TableField
"nodengrams_id"
,
_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_
node_NodeNgrams_NodeNgrams_Table
=
Table
"node_nodengrams_nodengrams"
(
pNode_NodeNgrams_NodeNgrams
Node_NodeNgrams_NodeNgrams
{
_nnn_node_id
=
required
"node_id"
,
_nnn_nng1_id
=
optional
"node_ngrams1_id"
,
_nnn_nng2_id
=
required
"node_ngrams2_id"
,
_nnn_weight
=
optional
"weight"
{
_nnn_node_id
=
required
TableField
"node_id"
,
_nnn_nng1_id
=
optional
TableField
"node_ngrams1_id"
,
_nnn_nng2_id
=
required
TableField
"node_ngrams2_id"
,
_nnn_weight
=
optional
TableField
"weight"
}
)
instance
QueryRunnerColumnDefault
PGInt4
(
Maybe
Int
)
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
DefaultFromField
PGInt4
(
Maybe
Int
)
where
defaultFromField
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGFloat8
(
Maybe
Double
)
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
DefaultFromField
PGFloat8
(
Maybe
Double
)
where
defaultFromField
=
fieldQueryRunnerColumn
src/Gargantext/Database/Schema/NodesNgramsRepo.hs
View file @
966bc15d
...
...
@@ -46,17 +46,17 @@ type RepoDbNgrams = RepoDbPoly Int NgramsStatePatch
$
(
makeAdaptorAndInstance
"pRepoDbNgrams"
''
R
epoDbPoly
)
makeLenses
''
R
epoDbPoly
instance
QueryRunnerColumnDefault
PGJsonb
instance
DefaultFromField
PGJsonb
(
PatchMap
NgramsType
(
PatchMap
NodeId
NgramsTablePatch
))
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
defaultFromField
=
fieldQueryRunnerColumn
repoTable
::
Table
RepoDbWrite
RepoDbRead
repoTable
=
Table
"nodes_ngrams_repo"
(
pRepoDbNgrams
RepoDbNgrams
{
_rdp_version
=
required
"version"
,
_rdp_patches
=
required
"patches"
{
_rdp_version
=
required
TableField
"version"
,
_rdp_patches
=
required
TableField
"patches"
}
)
src/Gargantext/Database/Schema/User.hs
View file @
966bc15d
...
...
@@ -94,17 +94,17 @@ $(makeLensesWith abbreviatedFields ''UserPoly)
userTable
::
Table
UserWrite
UserRead
userTable
=
Table
"auth_user"
(
pUserDB
UserDB
{
user_id
=
optional
"id"
,
user_password
=
required
"password"
,
user_lastLogin
=
optional
"last_login"
,
user_isSuperUser
=
required
"is_superuser"
,
user_username
=
required
"username"
,
user_firstName
=
required
"first_name"
,
user_lastName
=
required
"last_name"
,
user_email
=
required
"email"
,
user_isStaff
=
required
"is_staff"
,
user_isActive
=
required
"is_active"
,
user_dateJoined
=
optional
"date_joined"
(
pUserDB
UserDB
{
user_id
=
optional
TableField
"id"
,
user_password
=
required
TableField
"password"
,
user_lastLogin
=
optional
TableField
"last_login"
,
user_isSuperUser
=
required
TableField
"is_superuser"
,
user_username
=
required
TableField
"username"
,
user_firstName
=
required
TableField
"first_name"
,
user_lastName
=
required
TableField
"last_name"
,
user_email
=
required
TableField
"email"
,
user_isStaff
=
required
TableField
"is_staff"
,
user_isActive
=
required
TableField
"is_active"
,
user_dateJoined
=
optional
TableField
"date_joined"
}
)
...
...
stack.yaml
View file @
966bc15d
...
...
@@ -43,10 +43,8 @@ extra-deps:
commit
:
8cb8aaf2962ad44d319fcea48442e4397b3c49e8
# Databases libs
#- git: https://github.com/delanoe/haskell-opaleye.git #- opaleye-0.6.7002.0)
# commit: 63ee65d974e9d20eaaf17a2e83652175988cbb79
-
git
:
https://github.com/cgenie/haskell-opaleye.git
commit
:
41e3212e7da83d295cd6d0fa4f0a2b55b86bbbca
-
git
:
https://github.com/delanoe/haskell-opaleye.git
commit
:
9089fa71006d99d01916375818620d78a565b743
-
git
:
https://github.com/delanoe/hsparql.git
commit
:
308c74b71a1abb0a91546fa57d353131248e3a7f
-
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