Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Przemyslaw Kaminski
haskell-gargantext
Commits
77c37772
Commit
77c37772
authored
Dec 23, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[CODE ERGO] Instance method renamed
parent
70057b4c
Changes
17
Hide whitespace changes
Inline
Side-by-side
Showing
17 changed files
with
78 additions
and
78 deletions
+78
-78
Core.hs
src/Gargantext/Core.hs
+5
-5
Delete.hs
src/Gargantext/Database/Action/Delete.hs
+3
-3
Pairing.hs
src/Gargantext/Database/Action/Flow/Pairing.hs
+1
-1
NgramsByNode.hs
src/Gargantext/Database/Action/Metrics/NgramsByNode.hs
+14
-14
Search.hs
src/Gargantext/Database/Action/Search.hs
+5
-5
Config.hs
src/Gargantext/Database/Admin/Config.hs
+4
-4
NodeNodeNgrams.hs
src/Gargantext/Database/Admin/Trigger/NodeNodeNgrams.hs
+7
-7
Nodes.hs
src/Gargantext/Database/Admin/Trigger/Nodes.hs
+7
-7
NodesNodes.hs
src/Gargantext/Database/Admin/Trigger/NodesNodes.hs
+1
-1
Node.hs
src/Gargantext/Database/Admin/Types/Node.hs
+4
-4
Facet.hs
src/Gargantext/Database/Query/Facet.hs
+3
-3
Node.hs
src/Gargantext/Database/Query/Table/Node.hs
+7
-7
Children.hs
src/Gargantext/Database/Query/Table/Node/Children.hs
+1
-1
Insert.hs
src/Gargantext/Database/Query/Table/Node/Document/Insert.hs
+7
-7
Select.hs
src/Gargantext/Database/Query/Table/Node/Select.hs
+1
-1
NodeNode.hs
src/Gargantext/Database/Query/Table/NodeNode.hs
+5
-5
Root.hs
src/Gargantext/Database/Query/Tree/Root.hs
+3
-3
No files found.
src/Gargantext/Core.hs
View file @
77c37772
...
...
@@ -51,13 +51,13 @@ allLangs :: [Lang]
allLangs
=
[
minBound
..
]
class
HasDBid
a
where
hasDBid
::
a
->
Int
toDBid
::
a
->
Int
fromDBid
::
Int
->
a
instance
HasDBid
Lang
where
has
DBid
All
=
0
has
DBid
FR
=
1
has
DBid
EN
=
2
to
DBid
All
=
0
to
DBid
FR
=
1
to
DBid
EN
=
2
fromDBid
0
=
All
fromDBid
1
=
FR
...
...
@@ -70,7 +70,7 @@ data PostTagAlgo = CoreNLP
deriving
(
Show
,
Read
)
instance
HasDBid
PostTagAlgo
where
has
DBid
CoreNLP
=
1
to
DBid
CoreNLP
=
1
fromDBid
1
=
CoreNLP
fromDBid
_
=
panic
"HasDBid posTagAlgo : Not implemented"
src/Gargantext/Database/Action/Delete.hs
View file @
77c37772
...
...
@@ -44,13 +44,13 @@ deleteNode :: (HasConfig env, HasConnectionPool env, HasNodeError err)
deleteNode
u
nodeId
=
do
node'
<-
N
.
getNode
nodeId
case
(
view
node_typename
node'
)
of
nt
|
nt
==
has
DBid
NodeUser
->
panic
"Not allowed to delete NodeUser (yet)"
nt
|
nt
==
has
DBid
NodeTeam
->
do
nt
|
nt
==
to
DBid
NodeUser
->
panic
"Not allowed to delete NodeUser (yet)"
nt
|
nt
==
to
DBid
NodeTeam
->
do
uId
<-
getUserId
u
if
_node_userId
node'
==
uId
then
N
.
deleteNode
nodeId
else
delFolderTeam
u
nodeId
nt
|
nt
==
has
DBid
NodeFile
->
do
nt
|
nt
==
to
DBid
NodeFile
->
do
node
<-
getNodeWith
nodeId
(
Proxy
::
Proxy
HyperdataFile
)
let
(
HyperdataFile
{
_hff_path
=
path
})
=
node
^.
node_hyperdata
GPU
.
removeFile
$
unpack
path
...
...
src/Gargantext/Database/Action/Flow/Pairing.hs
View file @
77c37772
...
...
@@ -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
)
.==
(
pgInt4
$
has
DBid
nt'
)
restrict
-<
(
node
^.
node_typename
)
.==
(
pgInt4
$
to
DBid
nt'
)
restrict
-<
(
node_node
^.
nn_node1_id
)
.==
(
toNullable
$
pgNodeId
nId'
)
returnA
-<
node
^.
node_id
...
...
src/Gargantext/Database/Action/Metrics/NgramsByNode.hs
View file @
77c37772
...
...
@@ -73,7 +73,7 @@ getNodesByNgramsUser cId nt =
selectNgramsByNodeUser
cId'
nt'
=
runPGSQuery
queryNgramsByNodeUser
(
cId'
,
has
DBid
NodeDocument
,
to
DBid
NodeDocument
,
ngramsTypeId
nt'
-- , 100 :: Int -- limit
-- , 0 :: Int -- offset
...
...
@@ -86,7 +86,7 @@ getNodesByNgramsUser cId nt =
JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id
JOIN nodes n ON nn.node2_id = n.id
WHERE nn.node1_id = ? -- CorpusId
AND n.typename = ? --
has
DBid
AND n.typename = ? --
to
DBid
AND nng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0
GROUP BY nng.node2_id, ng.terms
...
...
@@ -184,7 +184,7 @@ selectNgramsOccurrencesOnlyByNodeUser cId nt tms =
runPGSQuery
queryNgramsOccurrencesOnlyByNodeUser
(
Values
fields
((
DPS
.
Only
.
unNgramsTerm
)
<$>
tms
)
,
cId
,
has
DBid
NodeDocument
,
to
DBid
NodeDocument
,
ngramsTypeId
nt
)
where
...
...
@@ -202,7 +202,7 @@ queryNgramsOccurrencesOnlyByNodeUser = [sql|
JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id
JOIN nodes n ON nn.node2_id = n.id
WHERE nn.node1_id = ? -- CorpusId
AND n.typename = ? --
has
DBid
AND n.typename = ? --
to
DBid
AND nng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0
GROUP BY nng.node2_id, ng.terms
...
...
@@ -217,7 +217,7 @@ queryNgramsOccurrencesOnlyByNodeUser' = [sql|
JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id
JOIN nodes n ON nn.node2_id = n.id
WHERE nn.node1_id = ? -- CorpusId
AND n.typename = ? --
has
DBid
AND n.typename = ? --
to
DBid
AND nng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0
GROUP BY nng.node2_id, ng.terms
...
...
@@ -267,7 +267,7 @@ selectNgramsOnlyByNodeUser cId ls nt tms =
,
Values
[
QualifiedIdentifier
Nothing
"int4"
]
(
DPS
.
Only
<$>
(
map
(
\
(
NodeId
n
)
->
n
)
ls
))
,
cId
,
has
DBid
NodeDocument
,
to
DBid
NodeDocument
,
ngramsTypeId
nt
)
where
...
...
@@ -284,7 +284,7 @@ queryNgramsOnlyByNodeUser = [sql|
JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id
JOIN nodes n ON nn.node2_id = n.id
WHERE nn.node1_id = ? -- CorpusId
AND n.typename = ? --
has
DBid
AND n.typename = ? --
to
DBid
AND nng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0
GROUP BY ng.terms, nng.node2_id
...
...
@@ -303,7 +303,7 @@ selectNgramsOnlyByNodeUser' cId ls nt tms =
,
Values
[
QualifiedIdentifier
Nothing
"int4"
]
(
DPS
.
Only
<$>
(
map
(
\
(
NodeId
n
)
->
n
)
ls
))
,
cId
,
has
DBid
NodeDocument
,
to
DBid
NodeDocument
,
ngramsTypeId
nt
)
where
...
...
@@ -386,13 +386,13 @@ selectNgramsByNodeMaster n ucId mcId p = runPGSQuery
queryNgramsByNodeMaster'
(
ucId
,
ngramsTypeId
NgramsTerms
,
has
DBid
NodeDocument
,
to
DBid
NodeDocument
,
p
,
has
DBid
NodeDocument
,
to
DBid
NodeDocument
,
p
,
n
,
mcId
,
has
DBid
NodeDocument
,
to
DBid
NodeDocument
,
ngramsTypeId
NgramsTerms
)
...
...
@@ -406,7 +406,7 @@ queryNgramsByNodeMaster' = [sql|
JOIN node_node_ngrams nng ON nng.node2_id = n.id
JOIN ngrams ng ON nng.ngrams_id = ng.id
WHERE nn.node1_id = ? -- UserCorpusId
-- AND n.typename = ? --
has
DBid
-- AND n.typename = ? --
to
DBid
AND nng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0
AND node_pos(n.id,?) >= ?
...
...
@@ -421,8 +421,8 @@ queryNgramsByNodeMaster' = [sql|
JOIN node_node_ngrams nng ON n.id = nng.node2_id
JOIN ngrams ng ON ng.id = nng.ngrams_id
WHERE n.parent_id = ? -- Master Corpus
has
DBid
AND n.typename = ? --
has
DBid
WHERE n.parent_id = ? -- Master Corpus
to
DBid
AND n.typename = ? --
to
DBid
AND nng.ngrams_type = ? -- NgramsTypeId
GROUP BY n.id, ng.terms
)
...
...
src/Gargantext/Database/Action/Search.hs
View file @
77c37772
...
...
@@ -50,7 +50,7 @@ searchDocInDatabase p t = runOpaQuery (queryDocInDatabase p t)
queryDocInDatabase
_
q
=
proc
()
->
do
row
<-
queryNodeSearchTable
-<
()
restrict
-<
(
_ns_search
row
)
@@
(
pgTSQuery
(
unpack
q
))
restrict
-<
(
_ns_typename
row
)
.==
(
pgInt4
$
has
DBid
NodeDocument
)
restrict
-<
(
_ns_typename
row
)
.==
(
pgInt4
$
to
DBid
NodeDocument
)
returnA
-<
(
_ns_id
row
,
_ns_hyperdata
row
)
------------------------------------------------------------------------
...
...
@@ -91,7 +91,7 @@ queryInCorpus cId t q = proc () -> do
then
(
nn
^.
nn_category
)
.==
(
toNullable
$
pgInt4
0
)
else
(
nn
^.
nn_category
)
.>=
(
toNullable
$
pgInt4
1
)
restrict
-<
(
n
^.
ns_search
)
@@
(
pgTSQuery
(
unpack
q
))
restrict
-<
(
n
^.
ns_typename
)
.==
(
pgInt4
$
has
DBid
NodeDocument
)
restrict
-<
(
n
^.
ns_typename
)
.==
(
pgInt4
$
to
DBid
NodeDocument
)
returnA
-<
FacetDoc
(
n
^.
ns_id
)
(
n
^.
ns_date
)
(
n
^.
ns_name
)
...
...
@@ -138,10 +138,10 @@ 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
)
.==
(
pgInt4
$
has
DBid
NodeDocument
)
restrict
-<
(
doc
^.
ns_typename
)
.==
(
pgInt4
$
to
DBid
NodeDocument
)
restrict
-<
(
corpus_doc
^.
nn_node1_id
)
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
(
annuaire_contact
^.
nn_node1_id
)
.==
(
toNullable
$
pgNodeId
aId
)
restrict
-<
(
contact
^.
node_typename
)
.==
(
toNullable
$
pgInt4
$
has
DBid
NodeContact
)
restrict
-<
(
contact
^.
node_typename
)
.==
(
toNullable
$
pgInt4
$
to
DBid
NodeContact
)
returnA
-<
(
contact
^.
node_id
,
contact
^.
node_date
,
contact
^.
node_hyperdata
...
...
@@ -273,6 +273,6 @@ textSearch :: HasDBid NodeType
->
Cmd
err
[(
Int
,
Value
,
Value
,
Value
,
Value
,
Maybe
Int
)]
textSearch
q
p
l
o
ord
=
runPGSQuery
textSearchQuery
(
q
,
p
,
p
,
typeId
,
ord
,
o
,
l
)
where
typeId
=
has
DBid
NodeDocument
typeId
=
to
DBid
NodeDocument
src/Gargantext/Database/Admin/Config.hs
View file @
77c37772
...
...
@@ -40,7 +40,7 @@ userArbitrary :: Text
userArbitrary
=
"user1"
instance
HasDBid
NodeType
where
has
DBid
=
nodeTypeId
to
DBid
=
nodeTypeId
fromDBid
=
fromNodeTypeId
...
...
@@ -96,10 +96,10 @@ nodeTypeId n =
-- NodeFavorites -> 15
hasNodeType
::
forall
a
.
Node
a
->
NodeType
->
Bool
hasNodeType
n
nt
=
(
view
node_typename
n
)
==
(
has
DBid
nt
)
hasNodeType
n
nt
=
(
view
node_typename
n
)
==
(
to
DBid
nt
)
isInNodeTypes
::
forall
a
.
Node
a
->
[
NodeType
]
->
Bool
isInNodeTypes
n
ts
=
elem
(
view
node_typename
n
)
(
map
has
DBid
ts
)
isInNodeTypes
n
ts
=
elem
(
view
node_typename
n
)
(
map
to
DBid
ts
)
-- | Nodes are typed in the database according to a specific ID
--
...
...
@@ -107,7 +107,7 @@ nodeTypeInv :: [(NodeTypeId, NodeType)]
nodeTypeInv
=
map
swap
nodeTypes
nodeTypes
::
[(
NodeType
,
NodeTypeId
)]
nodeTypes
=
[
(
n
,
has
DBid
n
)
|
n
<-
allNodeTypes
]
nodeTypes
=
[
(
n
,
to
DBid
n
)
|
n
<-
allNodeTypes
]
fromNodeTypeId
::
NodeTypeId
->
NodeType
fromNodeTypeId
tId
=
fromMaybe
(
panic
$
pack
$
"Type Id "
<>
show
tId
<>
" does not exist"
)
...
...
src/Gargantext/Database/Admin/Trigger/NodeNodeNgrams.hs
View file @
77c37772
...
...
@@ -25,7 +25,7 @@ import Gargantext.Prelude
import
qualified
Database.PostgreSQL.Simple
as
DPS
triggerCountInsert
::
HasDBid
NodeType
=>
Cmd
err
Int64
triggerCountInsert
=
execPGSQuery
query
(
hasDBid
NodeDocument
,
has
DBid
NodeList
)
triggerCountInsert
=
execPGSQuery
query
(
toDBid
NodeDocument
,
to
DBid
NodeList
)
where
query
::
DPS
.
Query
query
=
[
sql
|
...
...
@@ -61,9 +61,9 @@ triggerCountInsert = execPGSQuery query (hasDBid NodeDocument, hasDBid NodeList)
|]
triggerCountInsert2
::
HasDBid
NodeType
=>
Cmd
err
Int64
triggerCountInsert2
=
execPGSQuery
query
(
has
DBid
NodeCorpus
,
has
DBid
NodeDocument
,
has
DBid
NodeList
triggerCountInsert2
=
execPGSQuery
query
(
to
DBid
NodeCorpus
,
to
DBid
NodeDocument
,
to
DBid
NodeList
)
where
query
::
DPS
.
Query
...
...
@@ -105,9 +105,9 @@ triggerCountInsert2 = execPGSQuery query ( hasDBid NodeCorpus
-- TODO add the groups
triggerCoocInsert
::
HasDBid
NodeType
=>
Cmd
err
Int64
triggerCoocInsert
=
execPGSQuery
query
(
has
DBid
NodeCorpus
,
has
DBid
NodeDocument
,
has
DBid
NodeList
triggerCoocInsert
=
execPGSQuery
query
(
to
DBid
NodeCorpus
,
to
DBid
NodeDocument
,
to
DBid
NodeList
,
listTypeId
CandidateTerm
,
listTypeId
CandidateTerm
)
...
...
src/Gargantext/Database/Admin/Trigger/Nodes.hs
View file @
77c37772
...
...
@@ -26,9 +26,9 @@ import qualified Database.PostgreSQL.Simple as DPS
triggerSearchUpdate
::
HasDBid
NodeType
=>
Cmd
err
Int64
triggerSearchUpdate
=
execPGSQuery
query
(
has
DBid
NodeDocument
,
has
DBid
NodeDocument
,
has
DBid
NodeContact
triggerSearchUpdate
=
execPGSQuery
query
(
to
DBid
NodeDocument
,
to
DBid
NodeDocument
,
to
DBid
NodeContact
)
where
query
::
DPS
.
Query
...
...
@@ -70,12 +70,12 @@ triggerSearchUpdate = execPGSQuery query ( hasDBid NodeDocument
type
Secret
=
Text
triggerUpdateHash
::
HasDBid
NodeType
=>
Secret
->
Cmd
err
Int64
triggerUpdateHash
secret
=
execPGSQuery
query
(
has
DBid
NodeDocument
,
has
DBid
NodeContact
triggerUpdateHash
secret
=
execPGSQuery
query
(
to
DBid
NodeDocument
,
to
DBid
NodeContact
,
secret
,
secret
,
has
DBid
NodeDocument
,
has
DBid
NodeContact
,
to
DBid
NodeDocument
,
to
DBid
NodeContact
,
secret
,
secret
)
...
...
src/Gargantext/Database/Admin/Trigger/NodesNodes.hs
View file @
77c37772
...
...
@@ -29,7 +29,7 @@ import qualified Database.PostgreSQL.Simple as DPS
type
MasterListId
=
ListId
triggerDeleteCount
::
MasterListId
->
Cmd
err
Int64
triggerDeleteCount
lId
=
execPGSQuery
query
(
lId
,
has
DBid
NodeList
)
triggerDeleteCount
lId
=
execPGSQuery
query
(
lId
,
to
DBid
NodeList
)
where
query
::
DPS
.
Query
query
=
[
sql
|
...
...
src/Gargantext/Database/Admin/Types/Node.hs
View file @
77c37772
...
...
@@ -99,11 +99,11 @@ instance (Typeable hyperdata, ToSchema hyperdata) =>
instance
(
Arbitrary
nodeId
,
Arbitrary
hashId
,
Arbitrary
has
DBid
,
Arbitrary
to
DBid
,
Arbitrary
userId
,
Arbitrary
nodeParentId
,
Arbitrary
hyperdata
)
=>
Arbitrary
(
NodePoly
nodeId
hashId
has
DBid
userId
nodeParentId
)
=>
Arbitrary
(
NodePoly
nodeId
hashId
to
DBid
userId
nodeParentId
NodeName
UTCTime
hyperdata
)
where
--arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
arbitrary
=
Node
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
...
...
@@ -112,10 +112,10 @@ instance (Arbitrary nodeId
instance
(
Arbitrary
hyperdata
,
Arbitrary
nodeId
,
Arbitrary
has
DBid
,
Arbitrary
to
DBid
,
Arbitrary
userId
,
Arbitrary
nodeParentId
)
=>
Arbitrary
(
NodePolySearch
nodeId
has
DBid
userId
nodeParentId
)
=>
Arbitrary
(
NodePolySearch
nodeId
to
DBid
userId
nodeParentId
NodeName
UTCTime
hyperdata
(
Maybe
TSVector
))
where
--arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
arbitrary
=
NodeSearch
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
...
...
src/Gargantext/Database/Query/Facet.hs
View file @
77c37772
...
...
@@ -248,7 +248,7 @@ viewAuthorsDoc cId _ nt = proc () -> do
-}
restrict
-<
_node_id
contact'
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
_node_typename
doc
.==
(
pgInt4
$
has
DBid
nt
)
restrict
-<
_node_typename
doc
.==
(
pgInt4
$
to
DBid
nt
)
returnA
-<
FacetDoc
(
_node_id
doc
)
(
_node_date
doc
)
...
...
@@ -290,14 +290,14 @@ runViewDocuments :: HasDBid NodeType
runViewDocuments
cId
t
o
l
order
query
=
do
runOpaQuery
$
filterWith
o
l
order
sqlQuery
where
ntId
=
has
DBid
NodeDocument
ntId
=
to
DBid
NodeDocument
sqlQuery
=
viewDocuments
cId
t
ntId
query
runCountDocuments
::
HasDBid
NodeType
=>
CorpusId
->
IsTrash
->
Maybe
Text
->
Cmd
err
Int
runCountDocuments
cId
t
mQuery
=
do
runCountOpaQuery
sqlQuery
where
sqlQuery
=
viewDocuments
cId
t
(
has
DBid
NodeDocument
)
mQuery
sqlQuery
=
viewDocuments
cId
t
(
to
DBid
NodeDocument
)
mQuery
viewDocuments
::
CorpusId
...
...
src/Gargantext/Database/Query/Table/Node.hs
View file @
77c37772
...
...
@@ -75,7 +75,7 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
row
@
(
Node
_
_
typeId
_
parentId'
_
_
_
)
<-
queryNodeTable
-<
()
restrict
-<
parentId'
.==
(
pgNodeId
parentId
)
let
typeId'
=
maybe
0
has
DBid
maybeNodeType
let
typeId'
=
maybe
0
to
DBid
maybeNodeType
restrict
-<
if
typeId'
>
0
then
typeId
.==
(
pgInt4
(
typeId'
::
Int
))
...
...
@@ -122,7 +122,7 @@ getClosestParentIdByType nId nType = do
result
<-
runPGSQuery
query
(
nId
,
0
::
Int
)
case
result
of
[
DPS
.
Only
parentId
,
DPS
.
Only
pTypename
]
->
do
if
has
DBid
nType
==
pTypename
then
if
to
DBid
nType
==
pTypename
then
pure
$
Just
$
NodeId
parentId
else
getClosestParentIdByType
(
NodeId
parentId
)
nType
...
...
@@ -168,7 +168,7 @@ getNodesWithType nt _ = runOpaQuery $ selectNodesWithType nt
=>
NodeType
->
Query
NodeRead
selectNodesWithType
nt'
=
proc
()
->
do
row
@
(
Node
_
_
tn
_
_
_
_
_
)
<-
queryNodeTable
-<
()
restrict
-<
tn
.==
(
pgInt4
$
has
DBid
nt'
)
restrict
-<
tn
.==
(
pgInt4
$
to
DBid
nt'
)
returnA
-<
row
getNodesIdWithType
::
(
HasNodeError
err
,
HasDBid
NodeType
)
=>
NodeType
->
Cmd
err
[
NodeId
]
...
...
@@ -180,7 +180,7 @@ selectNodesIdWithType :: HasDBid NodeType
=>
NodeType
->
Query
(
Column
PGInt4
)
selectNodesIdWithType
nt
=
proc
()
->
do
row
@
(
Node
_
_
tn
_
_
_
_
_
)
<-
queryNodeTable
-<
()
restrict
-<
tn
.==
(
pgInt4
$
has
DBid
nt
)
restrict
-<
tn
.==
(
pgInt4
$
to
DBid
nt
)
returnA
-<
_node_id
row
------------------------------------------------------------------------
...
...
@@ -236,7 +236,7 @@ node nodeType name hyperData parentId userId =
Nothing
(
pgJSONB
$
cs
$
encode
hyperData
)
where
typeId
=
has
DBid
nodeType
typeId
=
to
DBid
nodeType
-------------------------------
insertNodes
::
[
NodeWrite
]
->
Cmd
err
Int64
...
...
@@ -250,7 +250,7 @@ insertNodes' ns = mkCmd $ \conn -> runInsert_ conn
ns' :: [NodeWrite]
ns' = map (\(Node i t u p n d h)
-> Node (pgNodeId <$> i)
(pgInt4 $
has
DBid t)
(pgInt4 $
to
DBid t)
(pgInt4 u)
(pgNodeId <$> p)
(pgStrictText n)
...
...
@@ -275,7 +275,7 @@ insertNodesWithParentR pid ns = insertNodesR (set node_parentId (pgNodeId <$> pi
node2table
::
HasDBid
NodeType
=>
UserId
->
Maybe
ParentId
->
Node'
->
NodeWrite
node2table
uid
pid
(
Node'
nt
txt
v
[]
)
=
Node
Nothing
Nothing
(
pgInt4
$
has
DBid
nt
)
(
pgInt4
uid
)
(
fmap
pgNodeId
pid
)
(
pgStrictText
txt
)
Nothing
(
pgStrictJSONB
$
cs
$
encode
v
)
node2table
uid
pid
(
Node'
nt
txt
v
[]
)
=
Node
Nothing
Nothing
(
pgInt4
$
to
DBid
nt
)
(
pgInt4
uid
)
(
fmap
pgNodeId
pid
)
(
pgStrictText
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 @
77c37772
...
...
@@ -74,7 +74,7 @@ selectChildren parentId maybeNodeType = proc () -> do
row
@
(
Node
nId
_
typeName
_
parent_id
_
_
_
)
<-
queryNodeTable
-<
()
(
NodeNode
n1id
n2id
_
_
)
<-
queryNodeNodeTable
-<
()
let
nodeType
=
maybe
0
has
DBid
maybeNodeType
let
nodeType
=
maybe
0
to
DBid
maybeNodeType
restrict
-<
typeName
.==
pgInt4
nodeType
restrict
-<
(
.||
)
(
parent_id
.==
(
pgNodeId
parentId
))
...
...
src/Gargantext/Database/Query/Table/Node/Document/Insert.hs
View file @
77c37772
...
...
@@ -69,7 +69,7 @@ import Database.PostgreSQL.Simple.SqlQQ
import
Database.PostgreSQL.Simple.ToField
(
toField
,
Action
{-, ToField-}
)
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
GHC.Generics
(
Generic
)
import
Gargantext.Core
(
HasDBid
(
has
DBid
))
import
Gargantext.Core
(
HasDBid
(
to
DBid
))
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
(
Cmd
,
runPGSQuery
{-, formatPGSQuery-}
)
...
...
@@ -104,7 +104,7 @@ class InsertDb a
instance
InsertDb
HyperdataDocument
where
insertDb'
u
p
h
=
[
toField
(
""
::
Text
)
,
toField
$
has
DBid
NodeDocument
,
toField
$
to
DBid
NodeDocument
,
toField
u
,
toField
p
,
toField
$
maybe
"No Title"
(
DT
.
take
255
)
(
_hd_title
h
)
...
...
@@ -115,7 +115,7 @@ instance InsertDb HyperdataDocument
instance
InsertDb
HyperdataContact
where
insertDb'
u
p
h
=
[
toField
(
""
::
Text
)
,
toField
$
has
DBid
NodeContact
,
toField
$
to
DBid
NodeContact
,
toField
u
,
toField
p
,
toField
$
maybe
"Contact"
(
DT
.
take
255
)
(
Just
"Name"
)
-- (_hc_name h)
...
...
@@ -223,7 +223,7 @@ instance (AddUniqId a, ToJSON a, HasDBid NodeType) => AddUniqId (Node a)
where
hashId
=
Just
$
"
\\
x"
<>
(
hash
$
DT
.
concat
params
)
params
=
[
secret
,
cs
$
show
$
has
DBid
NodeDocument
,
cs
$
show
$
to
DBid
NodeDocument
,
n
,
cs
$
show
p
,
cs
$
encode
h
...
...
@@ -235,7 +235,7 @@ instance (AddUniqId a, ToJSON a, HasDBid NodeType) => AddUniqId (Node a)
where
hashId = "\\x" <> (hash $ DT.concat params)
params = [ secret
, cs $ show $
has
DBid NodeDocument
, cs $ show $
to
DBid NodeDocument
, n
, cs $ show p
, cs $ encode h
...
...
@@ -275,7 +275,7 @@ class ToNode a
toNode
::
HasDBid
NodeType
=>
UserId
->
ParentId
->
a
->
Node
a
instance
ToNode
HyperdataDocument
where
toNode
u
p
h
=
Node
0
Nothing
(
has
DBid
NodeDocument
)
u
(
Just
p
)
n
date
h
toNode
u
p
h
=
Node
0
Nothing
(
to
DBid
NodeDocument
)
u
(
Just
p
)
n
date
h
where
n
=
maybe
"No Title"
(
DT
.
take
255
)
(
_hd_title
h
)
date
=
jour
y
m
d
...
...
@@ -285,7 +285,7 @@ instance ToNode HyperdataDocument where
-- TODO better Node
instance
ToNode
HyperdataContact
where
toNode
u
p
h
=
Node
0
Nothing
(
has
DBid
NodeContact
)
u
(
Just
p
)
"Contact"
date
h
toNode
u
p
h
=
Node
0
Nothing
(
to
DBid
NodeContact
)
u
(
Just
p
)
"Contact"
date
h
where
date
=
jour
2020
01
01
...
...
src/Gargantext/Database/Query/Table/Node/Select.hs
View file @
77c37772
...
...
@@ -32,7 +32,7 @@ selectNodesWithUsername nt u = runOpaQuery (q u)
q
u'
=
proc
()
->
do
(
n
,
usrs
)
<-
join'
-<
()
restrict
-<
user_username
usrs
.==
(
toNullable
$
pgStrictText
u'
)
restrict
-<
_node_typename
n
.==
(
pgInt4
$
has
DBid
nt
)
restrict
-<
_node_typename
n
.==
(
pgInt4
$
to
DBid
nt
)
returnA
-<
_node_id
n
join'
::
Query
(
NodeRead
,
UserReadNull
)
...
...
src/Gargantext/Database/Query/Table/NodeNode.hs
View file @
77c37772
...
...
@@ -85,7 +85,7 @@ getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
(NodeNode _ n1id n2id _ _) <- queryNodeNodeTable -< ()
let nodeType = maybe 0
has
DBid maybeNodeType
let nodeType = maybe 0
to
DBid maybeNodeType
restrict -< typeName .== pgInt4 nodeType
restrict -< (.||) (parent_id .== (pgNodeId parentId))
...
...
@@ -152,7 +152,7 @@ selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
(
n
,
nn
)
<-
joinInCorpus
-<
()
restrict
-<
nn
^.
nn_node1_id
.==
(
toNullable
$
pgNodeId
cId'
)
restrict
-<
nn
^.
nn_category
.>=
(
toNullable
$
pgInt4
1
)
restrict
-<
n
^.
node_typename
.==
(
pgInt4
$
has
DBid
NodeDocument
)
restrict
-<
n
^.
node_typename
.==
(
pgInt4
$
to
DBid
NodeDocument
)
returnA
-<
n
...
...
@@ -173,7 +173,7 @@ queryDocs cId = proc () -> do
(
n
,
nn
)
<-
joinInCorpus
-<
()
restrict
-<
nn
^.
nn_node1_id
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
nn
^.
nn_category
.>=
(
toNullable
$
pgInt4
1
)
restrict
-<
n
^.
node_typename
.==
(
pgInt4
$
has
DBid
NodeDocument
)
restrict
-<
n
^.
node_typename
.==
(
pgInt4
$
to
DBid
NodeDocument
)
returnA
-<
view
(
node_hyperdata
)
n
selectDocNodes
::
HasDBid
NodeType
=>
CorpusId
->
Cmd
err
[
Node
HyperdataDocument
]
...
...
@@ -184,7 +184,7 @@ queryDocNodes cId = proc () -> do
(
n
,
nn
)
<-
joinInCorpus
-<
()
restrict
-<
nn
^.
nn_node1_id
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
nn
^.
nn_category
.>=
(
toNullable
$
pgInt4
1
)
restrict
-<
n
^.
node_typename
.==
(
pgInt4
$
has
DBid
NodeDocument
)
restrict
-<
n
^.
node_typename
.==
(
pgInt4
$
to
DBid
NodeDocument
)
returnA
-<
n
joinInCorpus
::
O
.
Query
(
NodeRead
,
NodeNodeReadNull
)
...
...
@@ -208,6 +208,6 @@ 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
.==
(
pgInt4
$
has
DBid
nt
)
restrict
-<
n
^.
node_typename
.==
(
pgInt4
$
to
DBid
nt
)
returnA
-<
(
n
,
nn
^.
nn_node2_id
)
src/Gargantext/Database/Query/Tree/Root.hs
View file @
77c37772
...
...
@@ -119,21 +119,21 @@ selectRoot :: User -> Query NodeRead
selectRoot
(
UserName
username
)
=
proc
()
->
do
row
<-
queryNodeTable
-<
()
users
<-
queryUserTable
-<
()
restrict
-<
_node_typename
row
.==
(
pgInt4
$
has
DBid
NodeUser
)
restrict
-<
_node_typename
row
.==
(
pgInt4
$
to
DBid
NodeUser
)
restrict
-<
user_username
users
.==
(
pgStrictText
username
)
restrict
-<
_node_userId
row
.==
(
user_id
users
)
returnA
-<
row
selectRoot
(
UserDBId
uid
)
=
proc
()
->
do
row
<-
queryNodeTable
-<
()
restrict
-<
_node_typename
row
.==
(
pgInt4
$
has
DBid
NodeUser
)
restrict
-<
_node_typename
row
.==
(
pgInt4
$
to
DBid
NodeUser
)
restrict
-<
_node_userId
row
.==
(
pgInt4
uid
)
returnA
-<
row
selectRoot
(
RootId
nid
)
=
proc
()
->
do
row
<-
queryNodeTable
-<
()
restrict
-<
_node_typename
row
.==
(
pgInt4
$
has
DBid
NodeUser
)
restrict
-<
_node_typename
row
.==
(
pgInt4
$
to
DBid
NodeUser
)
restrict
-<
_node_id
row
.==
(
pgNodeId
nid
)
returnA
-<
row
selectRoot
UserPublic
=
panic
{-nodeError $ NodeError-}
"[G.D.Q.T.Root.selectRoot] No root for Public"
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