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
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Julien Moutinho
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