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
Christian Merten
haskell-gargantext
Commits
02f60d0d
Commit
02f60d0d
authored
Mar 27, 2024
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
Merge remote-tracking branch 'origin/169-dev-singulars-plurals' into dev
parents
5248845f
0f038a40
Changes
36
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
36 changed files
with
221 additions
and
218 deletions
+221
-218
Main.hs
bin/gargantext-import/Main.hs
+11
-10
Main.hs
bin/gargantext-init/Main.hs
+4
-5
Contact.hs
src/Gargantext/API/Node/Contact.hs
+3
-6
New.hs
src/Gargantext/API/Node/Corpus/New.hs
+2
-2
Searx.hs
src/Gargantext/API/Node/Corpus/Searx.hs
+2
-3
Flow.hs
src/Gargantext/Database/Action/Flow.hs
+25
-32
Facet.hs
src/Gargantext/Database/Query/Facet.hs
+4
-5
Types.hs
src/Gargantext/Database/Query/Facet/Types.hs
+5
-5
Filter.hs
src/Gargantext/Database/Query/Filter.hs
+0
-3
Join.hs
src/Gargantext/Database/Query/Join.hs
+2
-6
Context.hs
src/Gargantext/Database/Query/Table/Context.hs
+4
-6
ContextNodeNgrams.hs
src/Gargantext/Database/Query/Table/ContextNodeNgrams.hs
+0
-3
ContextNodeNgrams2.hs
src/Gargantext/Database/Query/Table/ContextNodeNgrams2.hs
+0
-4
Ngrams.hs
src/Gargantext/Database/Query/Table/Ngrams.hs
+2
-2
NgramsPostag.hs
src/Gargantext/Database/Query/Table/NgramsPostag.hs
+31
-5
Node.hs
src/Gargantext/Database/Query/Table/Node.hs
+9
-5
Children.hs
src/Gargantext/Database/Query/Table/Node/Children.hs
+6
-7
Contact.hs
src/Gargantext/Database/Query/Table/Node/Contact.hs
+1
-1
Add.hs
src/Gargantext/Database/Query/Table/Node/Document/Add.hs
+2
-2
Insert.hs
src/Gargantext/Database/Query/Table/Node/Document/Insert.hs
+2
-1
Error.hs
src/Gargantext/Database/Query/Table/Node/Error.hs
+2
-2
Select.hs
src/Gargantext/Database/Query/Table/Node/Select.hs
+4
-4
Update.hs
src/Gargantext/Database/Query/Table/Node/Update.hs
+4
-7
UpdateOpaleye.hs
src/Gargantext/Database/Query/Table/Node/UpdateOpaleye.hs
+5
-8
User.hs
src/Gargantext/Database/Query/Table/Node/User.hs
+4
-4
NodeContext_NodeContext.hs
...argantext/Database/Query/Table/NodeContext_NodeContext.hs
+2
-3
NodeNgrams.hs
src/Gargantext/Database/Query/Table/NodeNgrams.hs
+2
-2
NodeNode.hs
src/Gargantext/Database/Query/Table/NodeNode.hs
+0
-1
NodeNodeNgrams.hs
src/Gargantext/Database/Query/Table/NodeNodeNgrams.hs
+0
-4
Node_NodeNgramsNodeNgrams.hs
...gantext/Database/Query/Table/Node_NodeNgramsNodeNgrams.hs
+0
-5
NodesNgramsRepo.hs
src/Gargantext/Database/Query/Table/NodesNgramsRepo.hs
+0
-5
User.hs
src/Gargantext/Database/Query/Table/User.hs
+3
-8
Error.hs
src/Gargantext/Database/Query/Tree/Error.hs
+3
-5
Root.hs
src/Gargantext/Database/Query/Tree/Root.hs
+65
-34
Setup.hs
test/Test/API/Setup.hs
+11
-12
Query.hs
test/Test/Ngrams/Query.hs
+1
-1
No files found.
bin/gargantext-import/Main.hs
View file @
02f60d0d
...
@@ -15,22 +15,22 @@ Import a corpus binary.
...
@@ -15,22 +15,22 @@ Import a corpus binary.
module
Main
where
module
Main
where
import
Data.Either
import
Data.Text
qualified
as
Text
import
qualified
Data.Text
as
Text
import
Gargantext.API.Dev
(
withDevEnv
,
runCmdGargDev
)
import
Gargantext.API.Admin.EnvTypes
(
DevEnv
(
..
),
DevJobHandle
(
..
))
import
Gargantext.API.Admin.EnvTypes
(
DevEnv
(
..
),
DevJobHandle
(
..
))
import
Gargantext.API.Errors.Types
import
Gargantext.API.Dev
(
withDevEnv
,
runCmdGargDev
)
import
Gargantext.API.Errors.Types
(
BackendInternalError
)
import
Gargantext.API.Node
()
-- instances
import
Gargantext.API.Node
()
-- instances
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core.Text.Corpus.Parsers
(
FileFormat
(
..
),
FileType
(
..
))
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Core.Types.Query
(
Limit
)
import
Gargantext.Core.Types.Query
(
Limit
)
import
Gargantext.Database.Action.Flow
(
flowCorpusFile
,
flowAnnuaire
,
TermType
(
..
))
import
Gargantext.Database.Action.Flow
(
flowCorpusFile
,
flowAnnuaire
,
TermType
(
..
))
import
Gargantext.Database.Action.Flow.Types
(
FlowCmdM
)
import
Gargantext.Database.Action.Flow.Types
(
FlowCmdM
)
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
)
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
)
import
Gargantext.Database.Query.Tree.Root
(
MkCorpusUser
(
MkCorpusUserNormalCorpusName
))
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.
Core.Text.Corpus.Parsers
(
FileFormat
(
..
),
FileType
(
..
)
)
import
Gargantext.
Utils.Jobs.Monad
(
MonadJobStatus
,
JobHandle
)
import
Gargantext.Utils.Jobs
(
MonadJobStatus
,
JobHandle
)
main
::
IO
()
main
::
IO
()
main
=
do
main
=
do
...
@@ -46,13 +46,14 @@ main = do
...
@@ -46,13 +46,14 @@ main = do
Nothing
->
panicTrace
$
"Cannot read limit: "
<>
(
Text
.
pack
limit
)
Nothing
->
panicTrace
$
"Cannot read limit: "
<>
(
Text
.
pack
limit
)
Just
l
->
l
Just
l
->
l
corpus
::
forall
m
.
(
FlowCmdM
DevEnv
BackendInternalError
m
,
MonadJobStatus
m
,
JobHandle
m
~
DevJobHandle
)
=>
m
CorpusId
corpus
::
forall
m
.
(
FlowCmdM
DevEnv
BackendInternalError
m
,
MonadJobStatus
m
,
JobHandle
m
~
DevJobHandle
)
=>
m
CorpusId
corpus
=
flowCorpusFile
(
UserName
$
cs
user
)
(
Left
(
cs
name
::
Text
))
limit'
tt
format
Plain
corpusPath
Nothing
DevJobHandle
mkCorpusUser
=
MkCorpusUserNormalCorpusName
(
UserName
$
cs
user
)
(
cs
name
::
Text
)
corpus
=
flowCorpusFile
mkCorpusUser
limit'
tt
format
Plain
corpusPath
Nothing
DevJobHandle
corpusCsvHal
::
forall
m
.
(
FlowCmdM
DevEnv
BackendInternalError
m
,
MonadJobStatus
m
,
JobHandle
m
~
DevJobHandle
)
=>
m
CorpusId
corpusCsvHal
::
forall
m
.
(
FlowCmdM
DevEnv
BackendInternalError
m
,
MonadJobStatus
m
,
JobHandle
m
~
DevJobHandle
)
=>
m
CorpusId
corpusCsvHal
=
flowCorpusFile
(
UserName
$
cs
user
)
(
Left
(
cs
name
::
Text
))
limit'
tt
CsvHal
Plain
corpusPath
Nothing
DevJobHandle
corpusCsvHal
=
flowCorpusFile
mkCorpusUser
limit'
tt
CsvHal
Plain
corpusPath
Nothing
DevJobHandle
annuaire
::
forall
m
.
(
FlowCmdM
DevEnv
BackendInternalError
m
,
MonadJobStatus
m
,
JobHandle
m
~
DevJobHandle
)
=>
m
CorpusId
annuaire
::
forall
m
.
(
FlowCmdM
DevEnv
BackendInternalError
m
,
MonadJobStatus
m
,
JobHandle
m
~
DevJobHandle
)
=>
m
CorpusId
annuaire
=
flowAnnuaire
(
UserName
$
cs
user
)
(
Left
"Annuaire"
)
(
Multi
EN
)
corpusPath
DevJobHandle
annuaire
=
flowAnnuaire
(
MkCorpusUserNormalCorpusName
(
UserName
$
cs
user
)
"Annuaire"
)
(
Multi
EN
)
corpusPath
DevJobHandle
{-
{-
let debatCorpus :: forall m. FlowCmdM DevEnv BackendInternalError m => m CorpusId
let debatCorpus :: forall m. FlowCmdM DevEnv BackendInternalError m => m CorpusId
...
...
bin/gargantext-init/Main.hs
View file @
02f60d0d
...
@@ -15,21 +15,21 @@ Import a corpus binary.
...
@@ -15,21 +15,21 @@ Import a corpus binary.
module
Main
where
module
Main
where
import
Data.List.NonEmpty
qualified
as
NE
import
Gargantext.API.Dev
(
withDevEnv
,
runCmdDev
)
import
Gargantext.API.Dev
(
withDevEnv
,
runCmdDev
)
import
Gargantext.API.Errors.Types
import
Gargantext.API.Errors.Types
import
Gargantext.API.Node
()
-- instances only
import
Gargantext.API.Node
()
-- instances only
import
Gargantext.Core.Types.Individu
(
User
(
..
),
arbitraryNewUsers
,
NewUser
(
..
),
arbitraryUsername
,
GargPassword
(
..
))
import
Gargantext.Core.Types.Individu
(
User
(
..
),
arbitraryNewUsers
,
NewUser
(
..
),
arbitraryUsername
,
GargPassword
(
..
))
import
Gargantext.Database.Action.Flow
(
getOrMkRoot
,
getOrMk_RootWithCorpus
)
import
Gargantext.Database.Action.Flow
(
getOrMkRoot
,
getOrMkRootWithCorpus
)
import
Gargantext.Database.Admin.Config
(
userMaster
,
corpusMasterName
)
import
Gargantext.Database.Admin.Trigger.Init
(
initFirstTriggers
,
initLastTriggers
)
import
Gargantext.Database.Admin.Trigger.Init
(
initFirstTriggers
,
initLastTriggers
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataCorpus
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataCorpus
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
(
Cmd
,
DBCmd
)
import
Gargantext.Database.Prelude
(
Cmd
,
DBCmd
)
import
Gargantext.Database.Query.Table.Node
(
getOrMkList
)
import
Gargantext.Database.Query.Table.Node
(
getOrMkList
)
import
Gargantext.Database.Query.Table.User
(
insertNewUsers
,
)
import
Gargantext.Database.Query.Table.User
(
insertNewUsers
,
)
import
Gargantext.Database.Query.Tree.Root
(
MkCorpusUser
(
MkCorpusUserMaster
))
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Prelude.Config
(
GargConfig
(
..
),
readConfig
)
import
Gargantext.Prelude.Config
(
GargConfig
(
..
),
readConfig
)
import
qualified
Data.List.NonEmpty
as
NE
main
::
IO
()
main
::
IO
()
...
@@ -63,8 +63,7 @@ main = do
...
@@ -63,8 +63,7 @@ main = do
initMaster
::
Cmd
BackendInternalError
(
UserId
,
RootId
,
CorpusId
,
ListId
)
initMaster
::
Cmd
BackendInternalError
(
UserId
,
RootId
,
CorpusId
,
ListId
)
initMaster
=
do
initMaster
=
do
(
masterUserId
,
masterRootId
,
masterCorpusId
)
(
masterUserId
,
masterRootId
,
masterCorpusId
)
<-
getOrMk_RootWithCorpus
(
UserName
userMaster
)
<-
getOrMkRootWithCorpus
MkCorpusUserMaster
(
Left
corpusMasterName
)
(
Nothing
::
Maybe
HyperdataCorpus
)
(
Nothing
::
Maybe
HyperdataCorpus
)
masterListId
<-
getOrMkList
masterCorpusId
masterUserId
masterListId
<-
getOrMkList
masterCorpusId
masterUserId
_triggers
<-
initLastTriggers
masterListId
_triggers
<-
initLastTriggers
masterListId
...
...
src/Gargantext/API/Node/Contact.hs
View file @
02f60d0d
...
@@ -22,11 +22,7 @@ module Gargantext.API.Node.Contact
...
@@ -22,11 +22,7 @@ module Gargantext.API.Node.Contact
import
Conduit
(
yield
)
import
Conduit
(
yield
)
import
Data.Aeson
import
Data.Aeson
import
Data.Either
(
Either
(
Right
))
import
Data.Maybe
(
Maybe
(
..
))
import
Data.Swagger
(
ToSchema
)
import
Data.Swagger
(
ToSchema
)
import
Data.Text
(
Text
)
import
GHC.Generics
(
Generic
)
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
(
AuthenticatedUser
)
)
import
Gargantext.API.Admin.Auth.Types
(
AuthenticatedUser
(
AuthenticatedUser
)
)
import
Gargantext.API.Admin.EnvTypes
(
Env
,
GargJob
(
..
))
import
Gargantext.API.Admin.EnvTypes
(
Env
,
GargJob
(
..
))
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
(
..
),
AsyncJobs
)
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
(
..
),
AsyncJobs
)
...
@@ -42,12 +38,13 @@ import Gargantext.Database.Action.Flow.Types (FlowCmdM)
...
@@ -42,12 +38,13 @@ import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import
Gargantext.Database.Admin.Types.Hyperdata.Contact
(
HyperdataContact
,
hyperdataContact
)
import
Gargantext.Database.Admin.Types.Hyperdata.Contact
(
HyperdataContact
,
hyperdataContact
)
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
(
HyperdataAnnuaire
(
..
)
)
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
(
HyperdataAnnuaire
(
..
)
)
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
,
NodeId
)
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
,
NodeId
)
import
Gargantext.Prelude
((
$
),
{-printDebug,-}
)
import
Gargantext.Prelude
((
$
),
Generic
,
Maybe
(
..
),
Text
)
import
Gargantext.Utils.Aeson
qualified
as
GUA
import
Gargantext.Utils.Aeson
qualified
as
GUA
import
Gargantext.Utils.Jobs
(
serveJobsAPI
,
MonadJobStatus
(
..
))
import
Gargantext.Utils.Jobs
(
serveJobsAPI
,
MonadJobStatus
(
..
))
import
Servant
import
Servant
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck.Arbitrary
(
Arbitrary
(
arbitrary
)
)
import
Test.QuickCheck.Arbitrary
(
Arbitrary
(
arbitrary
)
)
import
Gargantext.Database.Query.Tree.Root
(
MkCorpusUser
(
MkCorpusUserNormalCorpusIds
))
------------------------------------------------------------------------
------------------------------------------------------------------------
type
API
=
"contact"
:>
Summary
"Contact endpoint"
type
API
=
"contact"
:>
Summary
"Contact endpoint"
...
@@ -85,7 +82,7 @@ addContact :: (HasSettings env, FlowCmdM env err m, MonadJobStatus m)
...
@@ -85,7 +82,7 @@ addContact :: (HasSettings env, FlowCmdM env err m, MonadJobStatus m)
addContact
u
nId
(
AddContactParams
fn
ln
)
jobHandle
=
do
addContact
u
nId
(
AddContactParams
fn
ln
)
jobHandle
=
do
markStarted
2
jobHandle
markStarted
2
jobHandle
_
<-
flow
(
Nothing
::
Maybe
HyperdataAnnuaire
)
u
(
Right
[
nId
])
(
Multi
EN
)
Nothing
(
1
,
yield
$
hyperdataContact
fn
ln
)
jobHandle
_
<-
flow
(
Nothing
::
Maybe
HyperdataAnnuaire
)
(
MkCorpusUserNormalCorpusIds
u
[
nId
])
(
Multi
EN
)
Nothing
(
1
,
yield
$
hyperdataContact
fn
ln
)
jobHandle
markComplete
jobHandle
markComplete
jobHandle
addContact
_uId
_nId
_p
jobHandle
=
do
addContact
_uId
_nId
_p
jobHandle
=
do
...
...
src/Gargantext/API/Node/Corpus/New.hs
View file @
02f60d0d
...
@@ -56,6 +56,7 @@ import Gargantext.Database.GargDB qualified as GargDB
...
@@ -56,6 +56,7 @@ import Gargantext.Database.GargDB qualified as GargDB
import
Gargantext.Database.Prelude
(
hasConfig
)
import
Gargantext.Database.Prelude
(
hasConfig
)
import
Gargantext.Database.Query.Table.Node
(
getNodeWith
,
getOrMkList
)
import
Gargantext.Database.Query.Table.Node
(
getNodeWith
,
getOrMkList
)
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateHyperdata
)
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateHyperdata
)
import
Gargantext.Database.Query.Tree.Root
(
MkCorpusUser
(
MkCorpusUserNormalCorpusIds
))
import
Gargantext.Database.Schema.Node
(
node_hyperdata
)
import
Gargantext.Database.Schema.Node
(
node_hyperdata
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Prelude.Config
(
gc_max_docs_parsers
)
import
Gargantext.Prelude.Config
(
gc_max_docs_parsers
)
...
@@ -335,8 +336,7 @@ addToCorpusWithForm user cid nwf jobHandle = do
...
@@ -335,8 +336,7 @@ addToCorpusWithForm user cid nwf jobHandle = do
-- TODO granularity of the logStatus
-- TODO granularity of the logStatus
-- printDebug "flowCorpus with (corpus_id, lang)" (cid, l)
-- printDebug "flowCorpus with (corpus_id, lang)" (cid, l)
_cid'
<-
flowCorpus
user
_cid'
<-
flowCorpus
(
MkCorpusUserNormalCorpusIds
user
[
cid
])
(
Right
[
cid
])
(
Multi
l
)
(
Multi
l
)
(
Just
(
nwf
^.
wf_selection
))
(
Just
(
nwf
^.
wf_selection
))
--(Just $ fromIntegral $ length docs, docsC')
--(Just $ fromIntegral $ length docs, docsC')
...
...
src/Gargantext/API/Node/Corpus/Searx.hs
View file @
02f60d0d
...
@@ -35,7 +35,6 @@ import Gargantext.Core.Utils.Prefix (unPrefix)
...
@@ -35,7 +35,6 @@ import Gargantext.Core.Utils.Prefix (unPrefix)
import
Gargantext.Database.Action.Flow
(
addDocumentsToHyperCorpus
)
--, DataText(..))
import
Gargantext.Database.Action.Flow
(
addDocumentsToHyperCorpus
)
--, DataText(..))
import
Gargantext.Database.Action.Flow.List
(
flowList_DbRepo
)
import
Gargantext.Database.Action.Flow.List
(
flowList_DbRepo
)
import
Gargantext.Database.Action.User
(
getUserId
)
import
Gargantext.Database.Action.User
(
getUserId
)
import
Gargantext.Database.Admin.Config
(
userMaster
)
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
(
HyperdataCorpus
)
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
(
HyperdataCorpus
)
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
(
..
))
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
(
..
))
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
,
ListId
,
NodeType
(
NodeTexts
))
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
,
ListId
,
NodeType
(
NodeTexts
))
...
@@ -43,7 +42,7 @@ import Gargantext.Database.Prelude (hasConfig)
...
@@ -43,7 +42,7 @@ import Gargantext.Database.Prelude (hasConfig)
import
Gargantext.Database.Query.Table.Node
(
getOrMkList
,
insertDefaultNodeIfNotExists
)
import
Gargantext.Database.Query.Table.Node
(
getOrMkList
,
insertDefaultNodeIfNotExists
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Tree.Error
(
HasTreeError
)
import
Gargantext.Database.Query.Tree.Error
(
HasTreeError
)
import
Gargantext.Database.Query.Tree.Root
(
getOrMk
_RootWithCorpus
)
import
Gargantext.Database.Query.Tree.Root
(
getOrMk
RootWithCorpus
,
MkCorpusUser
(
MkCorpusUserMaster
)
)
import
Gargantext.Prelude
hiding
(
All
)
import
Gargantext.Prelude
hiding
(
All
)
import
Gargantext.Prelude.Config
import
Gargantext.Prelude.Config
import
Gargantext.Utils.Jobs
(
JobHandle
,
MonadJobStatus
(
..
))
import
Gargantext.Utils.Jobs
(
JobHandle
,
MonadJobStatus
(
..
))
...
@@ -148,7 +147,7 @@ insertSearxResponse user cId listId l (Right (SearxResponse { _srs_results })) =
...
@@ -148,7 +147,7 @@ insertSearxResponse user cId listId l (Right (SearxResponse { _srs_results })) =
let
mCorpus
=
Nothing
::
Maybe
HyperdataCorpus
let
mCorpus
=
Nothing
::
Maybe
HyperdataCorpus
void
$
addDocumentsToHyperCorpus
server
mCorpus
(
Multi
l
)
cId
docs'
void
$
addDocumentsToHyperCorpus
server
mCorpus
(
Multi
l
)
cId
docs'
(
_masterUserId
,
_masterRootId
,
masterCorpusId
)
(
_masterUserId
,
_masterRootId
,
masterCorpusId
)
<-
getOrMk
_RootWithCorpus
(
UserName
userMaster
)
(
Left
""
)
mCorpus
<-
getOrMk
RootWithCorpus
MkCorpusUserMaster
mCorpus
let
gp
=
GroupWithPosTag
l
server
HashMap
.
empty
let
gp
=
GroupWithPosTag
l
server
HashMap
.
empty
-- gp = case l of
-- gp = case l of
-- FR -> GroupWithPosTag l Spacy HashMap.empty
-- FR -> GroupWithPosTag l Spacy HashMap.empty
...
...
src/Gargantext/Database/Action/Flow.hs
View file @
02f60d0d
This diff is collapsed.
Click to expand it.
src/Gargantext/Database/Query/Facet.hs
View file @
02f60d0d
...
@@ -41,15 +41,15 @@ module Gargantext.Database.Query.Facet
...
@@ -41,15 +41,15 @@ module Gargantext.Database.Query.Facet
import
Control.Arrow
(
returnA
)
import
Control.Arrow
(
returnA
)
import
Control.Lens
((
^.
))
import
Control.Lens
((
^.
))
import
Data.Text
qualified
as
T
import
Data.Text
qualified
as
T
import
Gargantext.Core
import
Gargantext.Core
(
HasDBid
(
toDBid
)
)
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
,
IsTrash
)
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
,
IsTrash
)
import
Gargantext.Database.Prelude
(
DBCmd
,
runCountOpaQuery
,
runOpaQuery
)
import
Gargantext.Database.Prelude
(
DBCmd
,
runCountOpaQuery
,
runOpaQuery
)
import
Gargantext.Database.Query.Facet.Types
import
Gargantext.Database.Query.Facet.Types
import
Gargantext.Database.Query.Filter
import
Gargantext.Database.Query.Filter
(
limit'
,
offset'
)
import
Gargantext.Database.Query.Table.Context
import
Gargantext.Database.Query.Table.Context
(
queryContextSearchTable
)
import
Gargantext.Database.Query.Table.ContextNodeNgrams
import
Gargantext.Database.Query.Table.ContextNodeNgrams
import
Gargantext.Database.Query.Table.Ngrams
import
Gargantext.Database.Query.Table.Ngrams
(
NgramsRead
,
NgramsPoly
(
_ngrams_id
),
queryNgramsTable
,
ngrams_id
)
import
Gargantext.Database.Query.Table.Node
(
defaultList
)
import
Gargantext.Database.Query.Table.Node
(
defaultList
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.NodeContext
(
queryNodeContextTable
)
import
Gargantext.Database.Query.Table.NodeContext
(
queryNodeContextTable
)
...
@@ -58,7 +58,6 @@ import Gargantext.Database.Schema.Node
...
@@ -58,7 +58,6 @@ import Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.NodeContext
import
Gargantext.Database.Schema.NodeContext
import
Opaleye
import
Opaleye
import
Opaleye.Aggregate
qualified
as
OAgg
import
Opaleye.Aggregate
qualified
as
OAgg
import
Opaleye.Internal.Unpackspec
()
import
Protolude
hiding
(
null
,
map
,
sum
,
not
)
import
Protolude
hiding
(
null
,
map
,
sum
,
not
)
------------------------------------------------------------------------
------------------------------------------------------------------------
...
...
src/Gargantext/Database/Query/Facet/Types.hs
View file @
02f60d0d
...
@@ -5,18 +5,18 @@ module Gargantext.Database.Query.Facet.Types where
...
@@ -5,18 +5,18 @@ module Gargantext.Database.Query.Facet.Types where
import
Data.Aeson
(
FromJSON
,
ToJSON
)
import
Data.Aeson
(
FromJSON
,
ToJSON
)
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Profunctor.Product.TH
(
makeAdaptorAndInstance
)
import
Data.Profunctor.Product.TH
(
makeAdaptorAndInstance
)
import
Data.Swagger
import
Data.Swagger
(
ToParamSchema
,
ToSchema
(
..
),
genericDeclareNamedSchema
)
import
qualified
Data.Text
as
T
import
Data.Text
qualified
as
T
import
Data.Time
(
UTCTime
)
import
Data.Time
(
UTCTime
)
import
Data.Time.Segment
(
jour
)
import
Data.Time.Segment
(
jour
)
import
Gargantext.
Core.Types
import
Gargantext.
Database.Admin.Types.Node
(
NodeId
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
,
wellNamedSchema
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
,
wellNamedSchema
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataDocument
,
arbitraryHyperdataDocuments
)
import
Gargantext.Database.Admin.Types.Hyperdata
.Document
(
HyperdataDocument
,
arbitraryHyperdataDocuments
)
import
Opaleye
import
Opaleye
import
Protolude
hiding
(
null
,
map
,
sum
,
not
)
import
Protolude
hiding
(
null
,
map
,
sum
,
not
)
import
Servant.API
(
FromHttpApiData
(
..
),
ToHttpApiData
(
..
))
import
Servant.API
(
FromHttpApiData
(
..
),
ToHttpApiData
(
..
))
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck.Arbitrary
import
Test.QuickCheck.Arbitrary
(
Arbitrary
(
arbitrary
)
)
-- | DocFacet
-- | DocFacet
...
...
src/Gargantext/Database/Query/Filter.hs
View file @
02f60d0d
...
@@ -10,9 +10,6 @@ Portability : POSIX
...
@@ -10,9 +10,6 @@ Portability : POSIX
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module
Gargantext.Database.Query.Filter
module
Gargantext.Database.Query.Filter
...
...
src/Gargantext/Database/Query/Join.hs
View file @
02f60d0d
...
@@ -15,10 +15,7 @@ Multiple Join functions with Opaleye.
...
@@ -15,10 +15,7 @@ Multiple Join functions with Opaleye.
{-# LANGUAGE Arrows #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE TemplateHaskell #-}
------------------------------------------------------------------------
------------------------------------------------------------------------
...
@@ -36,11 +33,10 @@ module Gargantext.Database.Query.Join ( leftJoin2
...
@@ -36,11 +33,10 @@ module Gargantext.Database.Query.Join ( leftJoin2
where
where
import
Control.Arrow
((
>>>
),
returnA
)
import
Control.Arrow
((
>>>
),
returnA
)
import
Data.Profunctor.Product.Default
import
Data.Profunctor.Product.Default
(
Default
)
import
Gargantext.Prelude
import
Gargantext.Prelude
(
Applicative
((
<*>
)),
(
<$>
)
)
import
Opaleye
hiding
(
keepWhen
)
import
Opaleye
hiding
(
keepWhen
)
import
Opaleye.Internal.Join
(
NullMaker
(
..
))
import
Opaleye.Internal.Join
(
NullMaker
(
..
))
import
qualified
Opaleye.Internal.Unpackspec
()
keepWhen
::
(
a
->
Field
SqlBool
)
->
SelectArr
a
a
keepWhen
::
(
a
->
Field
SqlBool
)
->
SelectArr
a
a
...
...
src/Gargantext/Database/Query/Table/Context.hs
View file @
02f60d0d
...
@@ -12,22 +12,20 @@ Portability : POSIX
...
@@ -12,22 +12,20 @@ Portability : POSIX
{-# LANGUAGE Arrows #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeFamilies #-}
module
Gargantext.Database.Query.Table.Context
module
Gargantext.Database.Query.Table.Context
where
where
import
Control.Arrow
(
returnA
)
import
Control.Arrow
(
returnA
)
import
Gargantext.Core
import
Gargantext.Core
(
HasDBid
(
toDBid
)
)
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
)
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
)
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata.Any
(
HyperdataAny
)
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
,
HyperdataDocumentV3
)
import
Gargantext.Database.Prelude
(
DBCmd
,
JSONB
,
runOpaQuery
)
import
Gargantext.Database.Prelude
(
DBCmd
,
JSONB
,
runOpaQuery
)
import
Gargantext.Database.Query.Filter
(
limit'
,
offset'
)
import
Gargantext.Database.Query.Filter
(
limit'
,
offset'
)
import
Gargantext.Database.Query.Table.Node.Error
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
,
nodeError
,
NodeError
(
NoContextFound
)
)
import
Gargantext.Database.Schema.Context
import
Gargantext.Database.Schema.Context
import
Gargantext.Prelude
hiding
(
sum
,
head
)
import
Gargantext.Prelude
hiding
(
sum
,
head
)
import
Opaleye
hiding
(
FromField
)
import
Opaleye
hiding
(
FromField
)
...
...
src/Gargantext/Database/Query/Table/ContextNodeNgrams.hs
View file @
02f60d0d
...
@@ -11,9 +11,6 @@ Portability : POSIX
...
@@ -11,9 +11,6 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TemplateHaskell #-}
module
Gargantext.Database.Query.Table.ContextNodeNgrams
module
Gargantext.Database.Query.Table.ContextNodeNgrams
(
module
Gargantext
.
Database
.
Schema
.
ContextNodeNgrams
(
module
Gargantext
.
Database
.
Schema
.
ContextNodeNgrams
...
...
src/Gargantext/Database/Query/Table/ContextNodeNgrams2.hs
View file @
02f60d0d
...
@@ -11,10 +11,6 @@ Portability : POSIX
...
@@ -11,10 +11,6 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TemplateHaskell #-}
module
Gargantext.Database.Query.Table.ContextNodeNgrams2
module
Gargantext.Database.Query.Table.ContextNodeNgrams2
(
module
Gargantext
.
Database
.
Schema
.
ContextNodeNgrams2
(
module
Gargantext
.
Database
.
Schema
.
ContextNodeNgrams2
,
insertContextNodeNgrams2
,
insertContextNodeNgrams2
...
...
src/Gargantext/Database/Query/Table/Ngrams.hs
View file @
02f60d0d
...
@@ -30,7 +30,7 @@ import Data.List qualified as List
...
@@ -30,7 +30,7 @@ import Data.List qualified as List
import
Data.Map.Strict
qualified
as
Map
import
Data.Map.Strict
qualified
as
Map
import
Database.PostgreSQL.Simple
qualified
as
PGS
import
Database.PostgreSQL.Simple
qualified
as
PGS
import
Gargantext.Core.Text.Ngrams
(
Ngrams
,
NgramsType
)
import
Gargantext.Core.Text.Ngrams
(
Ngrams
,
NgramsType
)
import
Gargantext.
Core.Types
import
Gargantext.
Database.Admin.Types.Node
(
pgNodeId
,
CorpusId
,
ListId
,
DocId
)
import
Gargantext.Database.Prelude
(
runOpaQuery
,
formatPGSQuery
,
runPGSQuery
,
DBCmd
)
import
Gargantext.Database.Prelude
(
runOpaQuery
,
formatPGSQuery
,
runPGSQuery
,
DBCmd
)
import
Gargantext.Database.Query.Join
(
leftJoin3
)
import
Gargantext.Database.Query.Join
(
leftJoin3
)
import
Gargantext.Database.Query.Table.ContextNodeNgrams2
import
Gargantext.Database.Query.Table.ContextNodeNgrams2
...
@@ -38,7 +38,7 @@ import Gargantext.Database.Query.Table.NodeNgrams (queryNodeNgramsTable)
...
@@ -38,7 +38,7 @@ import Gargantext.Database.Query.Table.NodeNgrams (queryNodeNgramsTable)
import
Gargantext.Database.Schema.Ngrams
import
Gargantext.Database.Schema.Ngrams
import
Gargantext.Database.Schema.NodeNgrams
import
Gargantext.Database.Schema.NodeNgrams
import
Gargantext.Database.Schema.Prelude
import
Gargantext.Database.Schema.Prelude
import
Gargantext.Database.Types
import
Gargantext.Database.Types
(
Indexed
(
Indexed
)
)
import
Gargantext.Prelude
import
Gargantext.Prelude
queryNgramsTable
::
Select
NgramsRead
queryNgramsTable
::
Select
NgramsRead
...
...
src/Gargantext/Database/Query/Table/NgramsPostag.hs
View file @
02f60d0d
...
@@ -24,7 +24,7 @@ import Data.HashMap.Strict qualified as HashMap
...
@@ -24,7 +24,7 @@ import Data.HashMap.Strict qualified as HashMap
import
Data.List
qualified
as
List
import
Data.List
qualified
as
List
import
Database.PostgreSQL.Simple
qualified
as
PGS
import
Database.PostgreSQL.Simple
qualified
as
PGS
import
Gargantext.Core
import
Gargantext.Core
import
Gargantext.Core.Text.Ngrams
(
Ngrams
,
ngramsSize
,
ngramsTerms
)
import
Gargantext.Core.Text.Ngrams
(
Ngrams
(
..
)
,
ngramsSize
,
ngramsTerms
)
import
Gargantext.Core.Types
(
POS
)
import
Gargantext.Core.Types
(
POS
)
import
Gargantext.Database.Prelude
(
runPGSQuery
,
runPGSQuery_
,
DBCmd
)
import
Gargantext.Database.Prelude
(
runPGSQuery
,
runPGSQuery_
,
DBCmd
)
import
Gargantext.Database.Query.Table.Ngrams
(
NgramsId
,
insertNgrams
)
import
Gargantext.Database.Query.Table.Ngrams
(
NgramsId
,
insertNgrams
)
...
@@ -154,14 +154,40 @@ SELECT terms,id FROM ins_form_ret
...
@@ -154,14 +154,40 @@ SELECT terms,id FROM ins_form_ret
-- TODO add lang and postag algo
-- TODO add lang and postag algo
-- TODO remove when form == lem in insert
-- TODO remove when form == lem in insert
selectLems
::
Lang
->
NLPServerConfig
->
[
Ngrams
]
->
DBCmd
err
[(
Form
,
Lem
)]
selectLems
::
Lang
->
NLPServerConfig
->
[
Ngrams
]
->
DBCmd
err
[(
Form
,
Lem
)]
selectLems
l
(
NLPServerConfig
{
server
})
ns
=
runPGSQuery
querySelectLems
(
PGS
.
Only
$
Values
fields
datas
)
selectLems
l
(
NLPServerConfig
{
server
})
ns
=
runPGSQuery
querySelectLems
(
PGS
.
In
(
map
_ngramsTerms
ns
),
toDBid
l
,
toDBid
server
)
----------------------
querySelectLems
::
PGS
.
Query
querySelectLems
=
[
sql
|
WITH
trms
AS (SELECT id, terms, n
FROM ngrams
WHERE terms IN ?)
, input_rows(lang_id, algo_id, terms,n)
AS (SELECT ? as lang_id, ? as algo_id, terms, n, id
FROM trms)
, lems AS ( select ir.terms as t1, n2.terms as t2, sum(np.score) as score from input_rows ir
JOIN ngrams_postag np ON np.ngrams_id = ir.id
JOIN ngrams n2 ON n2.id = np.lemm_id
WHERE np.lang_id = ir.lang_id
AND np.algo_id = ir.algo_id
GROUP BY ir.terms, n2.terms
ORDER BY score DESC
)
SELECT t1,t2 from lems
|]
-- | This is the same as 'selectLems', but slower.
selectLems'
::
Lang
->
NLPServerConfig
->
[
Ngrams
]
->
DBCmd
err
[(
Form
,
Lem
)]
selectLems'
l
(
NLPServerConfig
{
server
})
ns
=
runPGSQuery
querySelectLems'
(
PGS
.
Only
$
Values
fields
datas
)
where
where
fields
=
map
(
QualifiedIdentifier
Nothing
)
[
"int4"
,
"int4"
,
"text"
,
"int4"
]
fields
=
map
(
QualifiedIdentifier
Nothing
)
[
"int4"
,
"int4"
,
"text"
,
"int4"
]
datas
=
map
(
\
d
->
[
toField
$
toDBid
l
,
toField
$
toDBid
server
]
<>
toRow
d
)
ns
datas
=
map
(
\
d
->
[
toField
$
toDBid
l
,
toField
$
toDBid
server
]
<>
toRow
d
)
ns
----------------------
querySelectLems
::
PGS
.
Query
querySelectLems
'
::
PGS
.
Query
querySelectLems
=
[
sql
|
querySelectLems
'
=
[
sql
|
WITH input_rows(lang_id, algo_id, terms,n)
WITH input_rows(lang_id, algo_id, terms,n)
AS (?) -- ((VALUES ('automata' :: "text")))
AS (?) -- ((VALUES ('automata' :: "text")))
, lems AS ( select n1.terms as t1 ,n2.terms as t2 ,sum(np.score) as score from input_rows ir
, lems AS ( select n1.terms as t1 ,n2.terms as t2 ,sum(np.score) as score from input_rows ir
...
...
src/Gargantext/Database/Query/Table/Node.hs
View file @
02f60d0d
...
@@ -14,7 +14,6 @@ Portability : POSIX
...
@@ -14,7 +14,6 @@ Portability : POSIX
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ViewPatterns #-}
...
@@ -23,14 +22,19 @@ module Gargantext.Database.Query.Table.Node
...
@@ -23,14 +22,19 @@ module Gargantext.Database.Query.Table.Node
import
Control.Arrow
(
returnA
)
import
Control.Arrow
(
returnA
)
import
Control.Lens
(
set
,
view
)
import
Control.Lens
(
set
,
view
)
import
Data.Aeson
import
Data.Aeson
(
encode
,
Value
,
ToJSON
)
import
Database.PostgreSQL.Simple
qualified
as
PGS
import
Database.PostgreSQL.Simple
qualified
as
PGS
import
Database.PostgreSQL.Simple.SqlQQ
(
sql
)
import
Database.PostgreSQL.Simple.SqlQQ
(
sql
)
import
Gargantext.Core
import
Gargantext.Core
(
HasDBid
(
toDBid
)
)
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
)
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
)
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata.Any
(
HyperdataAny
)
import
Gargantext.Database.Admin.Types.Hyperdata.Default
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
(
HyperdataAnnuaire
,
HyperdataCorpus
)
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
,
HyperdataDocumentV3
)
import
Gargantext.Database.Admin.Types.Hyperdata.List
(
HyperdataList
)
import
Gargantext.Database.Admin.Types.Hyperdata.Model
(
HyperdataModel
)
import
Gargantext.Database.Admin.Types.Hyperdata.Prelude
(
Hyperdata
)
import
Gargantext.Database.Admin.Types.Hyperdata.Default
(
defaultHyperdata
,
DefaultHyperdata
(
..
)
)
import
Gargantext.Database.Prelude
(
DBCmd
,
JSONB
,
mkCmd
,
runPGSQuery
,
runOpaQuery
)
import
Gargantext.Database.Prelude
(
DBCmd
,
JSONB
,
mkCmd
,
runPGSQuery
,
runOpaQuery
)
import
Gargantext.Database.Query.Filter
(
limit'
,
offset'
)
import
Gargantext.Database.Query.Filter
(
limit'
,
offset'
)
import
Gargantext.Database.Query.Table.Node.Error
import
Gargantext.Database.Query.Table.Node.Error
...
...
src/Gargantext/Database/Query/Table/Node/Children.hs
View file @
02f60d0d
...
@@ -10,23 +10,22 @@ Portability : POSIX
...
@@ -10,23 +10,22 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE Arrows #-}
module
Gargantext.Database.Query.Table.Node.Children
module
Gargantext.Database.Query.Table.Node.Children
where
where
import
Control.Arrow
(
returnA
)
import
Control.Arrow
(
returnA
)
import
Data.Proxy
import
Gargantext.Core
(
HasDBid
(
toDBid
)
)
import
Gargantext.Core
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
)
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataDocument
,
HyperdataContact
)
import
Gargantext.Database.Admin.Types.Hyperdata.Contact
(
HyperdataContact
)
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
)
import
Gargantext.Database.Prelude
(
DBCmd
,
JSONB
,
runCountOpaQuery
,
runOpaQuery
)
import
Gargantext.Database.Prelude
(
DBCmd
,
JSONB
,
runCountOpaQuery
,
runOpaQuery
)
import
Gargantext.Database.Query.Filter
import
Gargantext.Database.Query.Filter
(
limit'
,
offset'
)
import
Gargantext.Database.Query.Table.NodeContext
import
Gargantext.Database.Query.Table.NodeContext
(
NodeContextPoly
(
NodeContext
),
queryNodeContextTable
)
import
Gargantext.Database.Schema.Context
import
Gargantext.Database.Schema.Context
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Node
(
NodeRead
,
NodePoly
(
Node
,
_node_id
),
queryNodeTable
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Opaleye
import
Opaleye
...
...
src/Gargantext/Database/Query/Table/Node/Contact.hs
View file @
02f60d0d
...
@@ -13,7 +13,7 @@ module Gargantext.Database.Query.Table.Node.Contact
...
@@ -13,7 +13,7 @@ module Gargantext.Database.Query.Table.Node.Contact
where
where
import
Gargantext.Database.Admin.Types.Node
(
Node
)
import
Gargantext.Database.Admin.Types.Node
(
Node
)
import
Gargantext.Database.Admin.Types.Hyperdata.Contact
import
Gargantext.Database.Admin.Types.Hyperdata.Contact
(
HyperdataContact
)
------------------------------------------------------------------------
------------------------------------------------------------------------
...
...
src/Gargantext/Database/Query/Table/Node/Document/Add.hs
View file @
02f60d0d
...
@@ -20,11 +20,11 @@ module Gargantext.Database.Query.Table.Node.Document.Add
...
@@ -20,11 +20,11 @@ module Gargantext.Database.Query.Table.Node.Document.Add
where
where
import
Database.PostgreSQL.Simple
(
Query
,
Only
(
..
))
import
Database.PostgreSQL.Simple
(
Query
,
Only
(
..
))
import
Database.PostgreSQL.Simple.SqlQQ
import
Database.PostgreSQL.Simple.SqlQQ
(
sql
)
import
Database.PostgreSQL.Simple.ToField
(
toField
)
import
Database.PostgreSQL.Simple.ToField
(
toField
)
import
Database.PostgreSQL.Simple.ToRow
(
ToRow
(
..
))
import
Database.PostgreSQL.Simple.ToRow
(
ToRow
(
..
))
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
,
ContextId
,
NodeId
,
ParentId
)
import
Gargantext.Database.Prelude
(
runPGSQuery
,
formatPGSQuery
,
DBCmd
)
import
Gargantext.Database.Prelude
(
runPGSQuery
,
formatPGSQuery
,
DBCmd
)
import
Gargantext.Prelude
import
Gargantext.Prelude
...
...
src/Gargantext/Database/Query/Table/Node/Document/Insert.hs
View file @
02f60d0d
...
@@ -66,7 +66,8 @@ import Database.PostgreSQL.Simple.SqlQQ ( sql )
...
@@ -66,7 +66,8 @@ import Database.PostgreSQL.Simple.SqlQQ ( sql )
import
Database.PostgreSQL.Simple.ToField
(
toField
,
Action
{-, ToField-}
)
import
Database.PostgreSQL.Simple.ToField
(
toField
,
Action
{-, ToField-}
)
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
Gargantext.Core
(
HasDBid
(
toDBid
))
import
Gargantext.Core
(
HasDBid
(
toDBid
))
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata.Contact
(
HyperdataContact
)
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
(
..
)
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
(
runPGSQuery
,
DBCmd
{-, formatPGSQuery-}
)
import
Gargantext.Database.Prelude
(
runPGSQuery
,
DBCmd
{-, formatPGSQuery-}
)
import
Gargantext.Database.Schema.Node
(
NodePoly
(
..
))
import
Gargantext.Database.Schema.Node
(
NodePoly
(
..
))
...
...
src/Gargantext/Database/Query/Table/Node/Error.hs
View file @
02f60d0d
...
@@ -27,9 +27,9 @@ module Gargantext.Database.Query.Table.Node.Error (
...
@@ -27,9 +27,9 @@ module Gargantext.Database.Query.Table.Node.Error (
)
where
)
where
import
Control.Lens
(
Prism
'
,
(
#
),
(
^?
))
import
Control.Lens
(
Prism
'
,
(
#
),
(
^?
))
import
Data.Aeson
import
Data.Aeson
(
object
,
ToJSON
(
toJSON
)
)
import
Data.Text
qualified
as
T
import
Data.Text
qualified
as
T
import
Gargantext.Core.Types.Individu
import
Gargantext.Core.Types.Individu
(
renderUser
,
User
,
Username
)
import
Gargantext.Database.Admin.Types.Node
(
ListId
,
NodeId
(
..
),
ContextId
,
UserId
,
ParentId
)
import
Gargantext.Database.Admin.Types.Node
(
ListId
,
NodeId
(
..
),
ContextId
,
UserId
,
ParentId
)
import
Gargantext.Prelude
hiding
(
sum
,
head
)
import
Gargantext.Prelude
hiding
(
sum
,
head
)
import
Prelude
hiding
(
null
,
id
,
map
,
sum
,
show
)
import
Prelude
hiding
(
null
,
id
,
map
,
sum
,
show
)
...
...
src/Gargantext/Database/Query/Table/Node/Select.hs
View file @
02f60d0d
...
@@ -16,12 +16,12 @@ module Gargantext.Database.Query.Table.Node.Select
...
@@ -16,12 +16,12 @@ module Gargantext.Database.Query.Table.Node.Select
where
where
import
Control.Arrow
(
returnA
)
import
Control.Arrow
(
returnA
)
import
Gargantext.Core
import
Gargantext.Core
(
HasDBid
(
toDBid
)
)
import
Gargantext.
Core.Types
import
Gargantext.
Database.Admin.Types.Node
(
NodeType
,
NodeId
)
import
Gargantext.Core.Types.Individu
(
Username
)
import
Gargantext.Core.Types.Individu
(
Username
)
import
Gargantext.Database.Prelude
(
DBCmd
,
runOpaQuery
)
import
Gargantext.Database.Prelude
(
DBCmd
,
runOpaQuery
)
import
Gargantext.Database.Query.Table.User
import
Gargantext.Database.Query.Table.User
(
UserPoly
(
user_username
,
user_id
),
queryUserTable
)
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Node
(
NodePoly
(
_node_id
,
_node_user_id
,
_node_typename
),
queryNodeTable
)
import
Opaleye
import
Opaleye
import
Protolude
import
Protolude
...
...
src/Gargantext/Database/Query/Table/Node/Update.hs
View file @
02f60d0d
...
@@ -9,18 +9,15 @@ Portability : POSIX
...
@@ -9,18 +9,15 @@ Portability : POSIX
-}
-}
{-# LANGUAGE QuasiQuotes #-}
module
Gargantext.Database.Query.Table.Node.Update
(
Update
(
..
),
update
)
module
Gargantext.Database.Query.Table.Node.Update
(
Update
(
..
),
update
)
where
where
import
qualified
Data.Text
as
DT
import
Data.Text
qualified
as
DT
import
Database.PostgreSQL.Simple
import
Database.PostgreSQL.Simple
(
Only
(
Only
)
)
import
Gargantext.Prelude
import
Gargantext.Core.Types
(
Name
)
import
Gargantext.Core.Types
(
Name
)
import
Gargantext.Database.Prelude
(
DBCmd
,
runPGSQuery
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
,
ParentId
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
,
ParentId
)
import
Gargantext.Database.Prelude
(
DBCmd
,
runPGSQuery
)
import
Gargantext.Prelude
-- import Data.ByteString
-- import Data.ByteString
--rename :: NodeId -> Text -> IO ByteString
--rename :: NodeId -> Text -> IO ByteString
...
...
src/Gargantext/Database/Query/Table/Node/UpdateOpaleye.hs
View file @
02f60d0d
...
@@ -9,19 +9,16 @@ Portability : POSIX
...
@@ -9,19 +9,16 @@ Portability : POSIX
-}
-}
{-# LANGUAGE QuasiQuotes #-}
module
Gargantext.Database.Query.Table.Node.UpdateOpaleye
module
Gargantext.Database.Query.Table.Node.UpdateOpaleye
where
where
import
Data.Aeson
(
encode
)
import
Data.Aeson
(
encode
)
import
Gargantext.Core
import
Gargantext.Core
(
HasDBid
)
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata
.Prelude
(
HyperdataC
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
(
NodeType
,
pgNodeId
,
NodeId
)
import
Gargantext.Database.Prelude
(
mkCmd
,
DBCmd
)
import
Gargantext.Database.Prelude
(
mkCmd
,
DBCmd
)
import
Gargantext.Database.Query.Table.Node
import
Gargantext.Database.Query.Table.Node
(
getNodeWithType
,
getNodesIdWithType
,
getNodesWithType
)
import
Gargantext.Database.Query.Table.Node.Error
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Node
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Opaleye
import
Opaleye
...
...
src/Gargantext/Database/Query/Table/Node/User.hs
View file @
02f60d0d
...
@@ -12,13 +12,13 @@ Portability : POSIX
...
@@ -12,13 +12,13 @@ Portability : POSIX
module
Gargantext.Database.Query.Table.Node.User
module
Gargantext.Database.Query.Table.Node.User
where
where
import
Gargantext.Core
import
Gargantext.Core
(
HasDBid
)
import
Gargantext.Core.Types
(
Name
)
import
Gargantext.Core.Types
(
Name
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataUser
(
..
),
defaultHyperdataUser
)
import
Gargantext.Database.Admin.Types.Hyperdata
.User
(
HyperdataUser
(
..
),
defaultHyperdataUser
)
import
Gargantext.Database.Admin.Types.Node
(
Node
,
NodeId
(
..
),
UserId
,
NodeType
(
..
),
pgNodeId
)
import
Gargantext.Database.Admin.Types.Node
(
Node
,
NodeId
(
..
),
UserId
,
NodeType
(
..
),
pgNodeId
)
import
Gargantext.Database.Prelude
(
DBCmd
,
runOpaQuery
)
import
Gargantext.Database.Prelude
(
DBCmd
,
runOpaQuery
)
import
Gargantext.Database.Query.Table.Node
import
Gargantext.Database.Query.Table.Node
(
node
,
selectNode
)
import
Gargantext.Database.Schema.Node
-- (Node(..))
import
Gargantext.Database.Schema.Node
(
NodeWrite
)
-- (Node(..))
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Opaleye
(
limit
)
import
Opaleye
(
limit
)
...
...
src/Gargantext/Database/Query/Table/NodeContext_NodeContext.hs
View file @
02f60d0d
...
@@ -10,7 +10,6 @@ Portability : POSIX
...
@@ -10,7 +10,6 @@ Portability : POSIX
{-# LANGUAGE Arrows #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module
Gargantext.Database.Query.Table.NodeContext_NodeContext
module
Gargantext.Database.Query.Table.NodeContext_NodeContext
(
module
Gargantext
.
Database
.
Schema
.
NodeContext_NodeContext
(
module
Gargantext
.
Database
.
Schema
.
NodeContext_NodeContext
...
@@ -20,10 +19,10 @@ module Gargantext.Database.Query.Table.NodeContext_NodeContext
...
@@ -20,10 +19,10 @@ module Gargantext.Database.Query.Table.NodeContext_NodeContext
where
where
import
Database.PostgreSQL.Simple
qualified
as
PGS
import
Database.PostgreSQL.Simple
qualified
as
PGS
import
Gargantext.
Core.Types
import
Gargantext.
Database.Admin.Types.Node
(
ContactId
,
CorpusId
,
AnnuaireId
,
DocId
)
import
Gargantext.Database.Prelude
(
DBCmd
,
runPGSQuery
)
import
Gargantext.Database.Prelude
(
DBCmd
,
runPGSQuery
)
import
Gargantext.Database.Schema.NodeContext_NodeContext
import
Gargantext.Database.Schema.NodeContext_NodeContext
import
Gargantext.Database.Schema.Prelude
hiding
(
sum
)
import
Gargantext.Database.Schema.Prelude
(
QualifiedIdentifier
(
QualifiedIdentifier
),
Values
(
Values
),
sql
)
import
Gargantext.Prelude
import
Gargantext.Prelude
{-
{-
...
...
src/Gargantext/Database/Query/Table/NodeNgrams.hs
View file @
02f60d0d
...
@@ -30,9 +30,9 @@ import Data.List.Extra (nubOrd)
...
@@ -30,9 +30,9 @@ import Data.List.Extra (nubOrd)
import
Data.Map.Strict
qualified
as
Map
import
Data.Map.Strict
qualified
as
Map
import
Data.Maybe
(
fromJust
)
import
Data.Maybe
(
fromJust
)
import
Database.PostgreSQL.Simple
qualified
as
PGS
(
Query
,
Only
(
..
))
import
Database.PostgreSQL.Simple
qualified
as
PGS
(
Query
,
Only
(
..
))
import
Gargantext.Core
import
Gargantext.Core
(
HasDBid
(
toDBid
)
)
import
Gargantext.Core.Text.Ngrams
(
NgramsType
)
import
Gargantext.Core.Text.Ngrams
(
NgramsType
)
import
Gargantext.
Core.Types
import
Gargantext.
Database.Admin.Types.Node
(
ListId
)
import
Gargantext.Database.Prelude
(
DBCmd
,
runPGSQuery
)
import
Gargantext.Database.Prelude
(
DBCmd
,
runPGSQuery
)
import
Gargantext.Database.Schema.Ngrams
(
fromNgramsTypeId
)
import
Gargantext.Database.Schema.Ngrams
(
fromNgramsTypeId
)
import
Gargantext.Database.Schema.NodeNgrams
import
Gargantext.Database.Schema.NodeNgrams
...
...
src/Gargantext/Database/Query/Table/NodeNode.hs
View file @
02f60d0d
...
@@ -16,7 +16,6 @@ commentary with @some markup@.
...
@@ -16,7 +16,6 @@ commentary with @some markup@.
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module
Gargantext.Database.Query.Table.NodeNode
module
Gargantext.Database.Query.Table.NodeNode
(
module
Gargantext
.
Database
.
Schema
.
NodeNode
(
module
Gargantext
.
Database
.
Schema
.
NodeNode
...
...
src/Gargantext/Database/Query/Table/NodeNodeNgrams.hs
View file @
02f60d0d
...
@@ -11,10 +11,6 @@ Portability : POSIX
...
@@ -11,10 +11,6 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TemplateHaskell #-}
module
Gargantext.Database.Query.Table.NodeNodeNgrams
module
Gargantext.Database.Query.Table.NodeNodeNgrams
(
module
Gargantext
.
Database
.
Schema
.
NodeNodeNgrams
(
module
Gargantext
.
Database
.
Schema
.
NodeNodeNgrams
,
queryNodeNodeNgramsTable
,
queryNodeNodeNgramsTable
...
...
src/Gargantext/Database/Query/Table/Node_NodeNgramsNodeNgrams.hs
View file @
02f60d0d
...
@@ -23,11 +23,6 @@ Next Step benchmark:
...
@@ -23,11 +23,6 @@ Next Step benchmark:
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module
Gargantext.Database.Query.Table.Node_NodeNgramsNodeNgrams
module
Gargantext.Database.Query.Table.Node_NodeNgramsNodeNgrams
where
where
...
...
src/Gargantext/Database/Query/Table/NodesNgramsRepo.hs
View file @
02f60d0d
...
@@ -11,11 +11,6 @@ Portability : POSIX
...
@@ -11,11 +11,6 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module
Gargantext.Database.Query.Table.NodesNgramsRepo
module
Gargantext.Database.Query.Table.NodesNgramsRepo
where
where
...
...
src/Gargantext/Database/Query/Table/User.hs
View file @
02f60d0d
...
@@ -15,9 +15,6 @@ Functions to deal with users, database side.
...
@@ -15,9 +15,6 @@ Functions to deal with users, database side.
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ViewPatterns #-}
module
Gargantext.Database.Query.Table.User
module
Gargantext.Database.Query.Table.User
...
@@ -53,16 +50,14 @@ module Gargantext.Database.Query.Table.User
...
@@ -53,16 +50,14 @@ module Gargantext.Database.Query.Table.User
import
Control.Arrow
(
returnA
)
import
Control.Arrow
(
returnA
)
import
Control.Lens
((
^.
),
(
?~
))
import
Control.Lens
((
^.
),
(
?~
))
import
Data.List.NonEmpty
qualified
as
NE
import
Data.List.NonEmpty
qualified
as
NE
import
Data.Proxy
import
Data.Time
(
UTCTime
)
import
Data.Time
(
UTCTime
)
import
Data.UUID
qualified
as
UUID
import
Data.UUID
qualified
as
UUID
import
Gargantext.Core
(
HasDBid
,
toDBid
)
import
Gargantext.Core
(
HasDBid
,
toDBid
)
import
Gargantext.Core.Types.Individu
import
Gargantext.Core.Types.Individu
import
Gargantext.Database.Admin.Config
()
import
Gargantext.Database.Admin.Config
()
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataUser
(
..
),
hu_pubmed_api_key
,
hu_epo_api_user
,
hu_epo_api_token
)
import
Gargantext.Database.Admin.Types.Hyperdata.User
(
HyperdataUser
(
..
),
hu_pubmed_api_key
,
hu_epo_api_user
,
hu_epo_api_token
)
import
Gargantext.Database.Admin.Types.Node
(
NodeType
(
NodeUser
),
Node
,
NodeId
(
..
),
pgNodeId
)
import
Gargantext.Database.Admin.Types.Node
(
NodeType
(
NodeUser
),
Node
,
NodeId
(
..
),
UserId
(
..
),
pgNodeId
)
import
Gargantext.Database.Admin.Types.Node
(
UserId
(
..
))
import
Gargantext.Database.Prelude
(
DBCmd
,
runOpaQuery
,
mkCmd
)
import
Gargantext.Database.Prelude
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateNodeWithType
)
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateNodeWithType
)
import
Gargantext.Database.Schema.Node
(
NodeRead
,
node_hyperdata
,
queryNodeTable
,
node_id
,
node_user_id
,
node_typename
)
import
Gargantext.Database.Schema.Node
(
NodeRead
,
node_hyperdata
,
queryNodeTable
,
node_id
,
node_user_id
,
node_typename
)
...
...
src/Gargantext/Database/Query/Tree/Error.hs
View file @
02f60d0d
...
@@ -9,17 +9,15 @@ Portability : POSIX
...
@@ -9,17 +9,15 @@ Portability : POSIX
-}
-}
{-# LANGUAGE QuasiQuotes #-}
module
Gargantext.Database.Query.Tree.Error
module
Gargantext.Database.Query.Tree.Error
where
where
import
Control.Lens
(
Prism
'
,
(
#
))
import
Control.Lens
(
Prism
'
,
(
#
))
import
Gargantext.Core.Types
import
Data.List.NonEmpty
qualified
as
NE
import
Data.Text
qualified
as
T
import
Gargantext.Database.Admin.Types.Node
(
NodeId
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Prelude
qualified
import
Prelude
qualified
import
qualified
Data.List.NonEmpty
as
NE
import
qualified
Data.Text
as
T
------------------------------------------------------------------------
------------------------------------------------------------------------
data
TreeError
=
NoRoot
data
TreeError
=
NoRoot
...
...
src/Gargantext/Database/Query/Tree/Root.hs
View file @
02f60d0d
...
@@ -14,20 +14,19 @@ module Gargantext.Database.Query.Tree.Root
...
@@ -14,20 +14,19 @@ module Gargantext.Database.Query.Tree.Root
where
where
import
Control.Arrow
(
returnA
)
import
Control.Arrow
(
returnA
)
import
Gargantext.Core
import
Gargantext.Core
(
HasDBid
(
..
))
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Core.Types.Main
(
CorpusName
)
import
Gargantext.Core.Types.Main
(
CorpusName
)
import
Gargantext.Database.Action.Node
import
Gargantext.Database.Action.Node
(
mkNodeWithParent
)
import
Gargantext.Database.Action.User
(
getUserId
,
getUsername
)
import
Gargantext.Database.Action.User
(
getUserId
,
getUsername
)
import
Gargantext.Database.Admin.Config
import
Gargantext.Database.Admin.Config
(
corpusMasterName
,
userMaster
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataUser
)
import
Gargantext.Database.Admin.Types.Hyperdata
.User
(
HyperdataUser
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
(
runOpaQuery
,
DBCmd
)
import
Gargantext.Database.Prelude
(
runOpaQuery
,
DBCmd
)
import
Gargantext.Database.Query.Table.Node
import
Gargantext.Database.Query.Table.Node
import
Gargantext.Database.Query.Table.Node.Error
import
Gargantext.Database.Query.Table.Node.Error
import
Gargantext.Database.Query.Table.User
(
queryUserTable
,
UserPoly
(
..
))
import
Gargantext.Database.Query.Table.User
(
queryUserTable
,
UserPoly
(
..
))
import
Gargantext.Database.Schema.Node
(
NodePoly
(
..
),
NodeRead
)
import
Gargantext.Database.Schema.Node
(
NodePoly
(
..
),
NodeRead
,
queryNodeTable
)
import
Gargantext.Database.Schema.Node
(
queryNodeTable
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Opaleye
(
restrict
,
(
.==
),
Select
)
import
Opaleye
(
restrict
,
(
.==
),
Select
)
import
Opaleye.SqlTypes
(
sqlStrictText
,
sqlInt4
)
import
Opaleye.SqlTypes
(
sqlStrictText
,
sqlInt4
)
...
@@ -61,30 +60,62 @@ getOrMkRoot user = do
...
@@ -61,30 +60,62 @@ getOrMkRoot user = do
pure
(
userId
,
rootId
)
pure
(
userId
,
rootId
)
getOrMk_RootWithCorpus
::
(
HasNodeError
err
,
MkCorpus
a
)
-- | Datatype for the `getOrMkRootWithCorpus`.
=>
User
-- There are only 3 possibilities:
->
Either
CorpusName
[
CorpusId
]
-- - User is userMaster and then there is no corpus name
-- - User is a normal user and then we pass corpus name
-- - User is a normal user and then we pass corpus ids
data
MkCorpusUser
=
MkCorpusUserMaster
|
MkCorpusUserNormalCorpusName
User
CorpusName
|
MkCorpusUserNormalCorpusIds
User
[
CorpusId
]
deriving
(
Eq
,
Show
)
userFromMkCorpusUser
::
MkCorpusUser
->
User
userFromMkCorpusUser
MkCorpusUserMaster
=
UserName
userMaster
userFromMkCorpusUser
(
MkCorpusUserNormalCorpusIds
u
_cids
)
=
u
userFromMkCorpusUser
(
MkCorpusUserNormalCorpusName
u
_cname
)
=
u
getOrMkRootWithCorpus
::
(
HasNodeError
err
,
MkCorpus
a
)
=>
MkCorpusUser
->
Maybe
a
->
Maybe
a
->
DBCmd
err
(
UserId
,
RootId
,
CorpusId
)
->
DBCmd
err
(
UserId
,
RootId
,
CorpusId
)
getOrMk_RootWithCorpus
user
cName
c
=
do
getOrMkRootWithCorpus
MkCorpusUserMaster
c
=
do
(
userId
,
rootId
)
<-
getOrMkRoot
(
UserName
userMaster
)
corpusId''
<-
do
ns
<-
getCorporaWithParentId
rootId
pure
$
map
_node_id
ns
case
corpusId''
of
[]
->
mkCorpus
corpusMasterName
c
rootId
userId
cIds
->
do
corpusId
<-
maybe
(
nodeError
NoCorpusFound
)
pure
(
head
cIds
)
pure
(
userId
,
rootId
,
corpusId
)
getOrMkRootWithCorpus
(
MkCorpusUserNormalCorpusName
user
cName
)
c
=
do
(
userId
,
rootId
)
<-
getOrMkRoot
user
mkCorpus
cName
c
rootId
userId
getOrMkRootWithCorpus
(
MkCorpusUserNormalCorpusIds
user
[]
)
c
=
do
getOrMkRootWithCorpus
(
MkCorpusUserNormalCorpusName
user
"Default"
)
c
getOrMkRootWithCorpus
(
MkCorpusUserNormalCorpusIds
user
cIds
)
_c
=
do
(
userId
,
rootId
)
<-
getOrMkRoot
user
(
userId
,
rootId
)
<-
getOrMkRoot
user
corpusId''
<-
if
user
==
UserName
userMaster
corpusId
<-
maybe
(
nodeError
NoCorpusFound
)
pure
(
head
cIds
)
then
do
pure
(
userId
,
rootId
,
corpusId
)
ns
<-
getCorporaWithParentId
rootId
pure
$
map
_node_id
ns
else
-- | Helper function for `getOrMkRootWithCorpus`.
pure
$
fromRight
[]
cName
mkCorpus
::
(
HasNodeError
err
,
MkCorpus
a
)
=>
CorpusName
corpusId'
<-
if
corpusId''
/=
[]
->
Maybe
a
then
pure
corpusId''
->
RootId
else
do
->
UserId
c'
<-
mk
(
Just
$
fromLeft
"Default"
cName
)
c
rootId
userId
->
DBCmd
err
(
UserId
,
RootId
,
CorpusId
)
_tId
<-
case
head
c'
of
mkCorpus
cName
c
rootId
userId
=
do
Nothing
->
errorWith
"[G.D.Q.T.Root.getOrMk...] mk Corpus failed"
c'
<-
mk
(
Just
cName
)
c
rootId
userId
Just
c''
->
insertDefaultNode
NodeTexts
c''
userId
_tId
<-
case
head
c'
of
pure
c'
Nothing
->
errorWith
"[G.D.Q.T.Root.getOrMk...] mk Corpus failed"
Just
c''
->
insertDefaultNode
NodeTexts
c''
userId
corpusId
<-
maybe
(
nodeError
NoCorpusFound
)
pure
(
head
corpusId'
)
corpusId
<-
maybe
(
nodeError
NoCorpusFound
)
pure
(
head
c'
)
pure
(
userId
,
rootId
,
corpusId
)
pure
(
userId
,
rootId
,
corpusId
)
...
@@ -118,20 +149,20 @@ selectRoot :: User -> Select NodeRead
...
@@ -118,20 +149,20 @@ selectRoot :: User -> Select NodeRead
selectRoot
(
UserName
username
)
=
proc
()
->
do
selectRoot
(
UserName
username
)
=
proc
()
->
do
row
<-
queryNodeTable
-<
()
row
<-
queryNodeTable
-<
()
users
<-
queryUserTable
-<
()
users
<-
queryUserTable
-<
()
restrict
-<
_node_typename
row
.==
(
sqlInt4
$
toDBid
NodeUser
)
restrict
-<
_node_typename
row
.==
sqlInt4
(
toDBid
NodeUser
)
restrict
-<
user_username
users
.==
(
sqlStrictText
username
)
restrict
-<
user_username
users
.==
sqlStrictText
username
restrict
-<
_node_user_id
row
.==
(
user_id
users
)
restrict
-<
_node_user_id
row
.==
user_id
users
returnA
-<
row
returnA
-<
row
selectRoot
(
UserDBId
uid
)
=
proc
()
->
do
selectRoot
(
UserDBId
uid
)
=
proc
()
->
do
row
<-
queryNodeTable
-<
()
row
<-
queryNodeTable
-<
()
restrict
-<
_node_typename
row
.==
(
sqlInt4
$
toDBid
NodeUser
)
restrict
-<
_node_typename
row
.==
sqlInt4
(
toDBid
NodeUser
)
restrict
-<
_node_user_id
row
.==
(
sqlInt4
$
_UserId
uid
)
restrict
-<
_node_user_id
row
.==
sqlInt4
(
_UserId
uid
)
returnA
-<
row
returnA
-<
row
selectRoot
(
RootId
nid
)
=
selectRoot
(
RootId
nid
)
=
proc
()
->
do
proc
()
->
do
row
<-
queryNodeTable
-<
()
row
<-
queryNodeTable
-<
()
restrict
-<
_node_typename
row
.==
(
sqlInt4
$
toDBid
NodeUser
)
restrict
-<
_node_typename
row
.==
sqlInt4
(
toDBid
NodeUser
)
restrict
-<
_node_id
row
.==
(
pgNodeId
nid
)
restrict
-<
_node_id
row
.==
pgNodeId
nid
returnA
-<
row
returnA
-<
row
test/Test/API/Setup.hs
View file @
02f60d0d
...
@@ -3,6 +3,7 @@
...
@@ -3,6 +3,7 @@
module
Test.API.Setup
where
module
Test.API.Setup
where
-- import Gargantext.Prelude (printDebug)
import
Control.Lens
import
Control.Lens
import
Control.Monad.Reader
import
Control.Monad.Reader
import
Gargantext.API
(
makeApp
)
import
Gargantext.API
(
makeApp
)
...
@@ -21,24 +22,24 @@ import Gargantext.Database.Admin.Trigger.Init
...
@@ -21,24 +22,24 @@ import Gargantext.Database.Admin.Trigger.Init
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Prelude
import
Gargantext.Database.Prelude
import
Gargantext.Database.Query.Table.Node
(
getOrMkList
)
import
Gargantext.Database.Query.Table.Node
(
getOrMkList
)
-- import Gargantext.Prelude (printDebug
)
import
Gargantext.Database.Query.Tree.Root
(
MkCorpusUser
(
..
)
)
import
Gargantext.Prelude.Config
import
Gargantext.Prelude.Config
import
Gargantext.Prelude.Mail
qualified
as
Mail
import
Gargantext.Prelude.NLP
qualified
as
NLP
import
Gargantext.System.Logging
import
Gargantext.System.Logging
import
Gargantext.Utils.Jobs
qualified
as
Jobs
import
Gargantext.Utils.Jobs.Monad
qualified
as
Jobs
import
Gargantext.Utils.Jobs.Queue
qualified
as
Jobs
import
Gargantext.Utils.Jobs.Settings
qualified
as
Jobs
import
Network.HTTP.Client.TLS
(
newTlsManager
)
import
Network.HTTP.Client.TLS
(
newTlsManager
)
import
Network.Wai
(
Application
)
import
Network.Wai
(
Application
)
import
Network.Wai.Handler.Warp
qualified
as
Warp
import
Prelude
import
Prelude
import
Servant.Auth.Client
()
import
Servant.Auth.Client
()
import
Servant.Client
import
Servant.Client
import
Servant.Job.Async
qualified
as
ServantAsync
import
Test.Database.Setup
(
withTestDB
,
fakeIniPath
,
testEnvToPgConnectionInfo
)
import
Test.Database.Setup
(
withTestDB
,
fakeIniPath
,
testEnvToPgConnectionInfo
)
import
Test.Database.Types
import
Test.Database.Types
import
qualified
Gargantext.Prelude.Mail
as
Mail
import
qualified
Gargantext.Prelude.NLP
as
NLP
import
qualified
Gargantext.Utils.Jobs
as
Jobs
import
qualified
Gargantext.Utils.Jobs.Monad
as
Jobs
import
qualified
Gargantext.Utils.Jobs.Queue
as
Jobs
import
qualified
Gargantext.Utils.Jobs.Settings
as
Jobs
import
qualified
Network.Wai.Handler.Warp
as
Warp
import
qualified
Servant.Job.Async
as
ServantAsync
newTestEnv
::
TestEnv
->
Logger
(
GargM
Env
BackendInternalError
)
->
Warp
.
Port
->
IO
Env
newTestEnv
::
TestEnv
->
Logger
(
GargM
Env
BackendInternalError
)
->
Warp
.
Port
->
IO
Env
...
@@ -97,9 +98,7 @@ setupEnvironment env = flip runReaderT env $ runTestMonad $ do
...
@@ -97,9 +98,7 @@ setupEnvironment env = flip runReaderT env $ runTestMonad $ do
void
$
initFirstTriggers
"secret_key"
void
$
initFirstTriggers
"secret_key"
void
$
new_user
$
mkNewUser
(
userMaster
<>
"@cnrs.com"
)
(
GargPassword
"secret_key"
)
void
$
new_user
$
mkNewUser
(
userMaster
<>
"@cnrs.com"
)
(
GargPassword
"secret_key"
)
(
masterUserId
,
_masterRootId
,
masterCorpusId
)
(
masterUserId
,
_masterRootId
,
masterCorpusId
)
<-
getOrMk_RootWithCorpus
(
UserName
userMaster
)
<-
getOrMkRootWithCorpus
MkCorpusUserMaster
(
Nothing
::
Maybe
HyperdataCorpus
)
(
Left
corpusMasterName
)
(
Nothing
::
Maybe
HyperdataCorpus
)
masterListId
<-
getOrMkList
masterCorpusId
masterUserId
masterListId
<-
getOrMkList
masterCorpusId
masterUserId
-- printDebug "[setupEnvironment] masterListId: " masterListId
-- printDebug "[setupEnvironment] masterListId: " masterListId
void
$
initLastTriggers
masterListId
void
$
initLastTriggers
masterListId
...
...
test/Test/Ngrams/Query.hs
View file @
02f60d0d
...
@@ -36,7 +36,7 @@ mockFlatCorpus = Versioned 0 $ Map.fromList [
...
@@ -36,7 +36,7 @@ mockFlatCorpus = Versioned 0 $ Map.fromList [
mockQueryFn
::
Maybe
T
.
Text
->
NgramsTerm
->
Bool
mockQueryFn
::
Maybe
T
.
Text
->
NgramsTerm
->
Bool
mockQueryFn
searchQuery
(
NgramsTerm
nt
)
=
mockQueryFn
searchQuery
(
NgramsTerm
nt
)
=
maybe
(
const
True
)
T
.
isInfixOf
(
T
.
toLower
<$>
searchQuery
)
(
T
.
toLower
nt
)
maybe
(
const
True
)
(
T
.
isInfixOf
.
T
.
toLower
)
searchQuery
(
T
.
toLower
nt
)
unitTests
::
TestTree
unitTests
::
TestTree
unitTests
=
testGroup
"Query tests"
unitTests
=
testGroup
"Query tests"
...
...
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