Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
153
Issues
153
List
Board
Labels
Milestones
Merge Requests
9
Merge Requests
9
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-gargantext
Commits
b7355306
Commit
b7355306
authored
Apr 10, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[WIP] Starting query Garg for a Hello Word.
parent
5897de6c
Pipeline
#813
failed with stage
Changes
5
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
27 additions
and
21 deletions
+27
-21
API.hs
src/Gargantext/API.hs
+5
-11
New.hs
src/Gargantext/API/Corpus/New.hs
+12
-4
Individu.hs
src/Gargantext/Core/Types/Individu.hs
+2
-1
Flow.hs
src/Gargantext/Database/Flow.hs
+5
-5
User.hs
src/Gargantext/Database/Schema/User.hs
+3
-0
No files found.
src/Gargantext/API.hs
View file @
b7355306
...
...
@@ -406,8 +406,8 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
-- TODO access
-- :<|> addUpload
-- :<|> (\corpus -> addWithQuery corpus :<|> addWithFile corpus)
:<|>
addCorpusWithForm
(
UserDBId
uid
)
-- "user1"
:<|>
addCorpusWithQuery
:<|>
addCorpusWithForm
(
UserDBId
uid
)
:<|>
addCorpusWithQuery
(
RootId
uid
)
:<|>
addAnnuaireWithForm
-- :<|> New.api uid -- TODO-SECURITY
...
...
@@ -416,16 +416,10 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
:<|>
waitAPI
{-
addUpload :: GargServer New.Upload
addUpload cId = (serveJobsAPI $ JobFunction (\i log -> New.addToCorpusJobFunction cid i (liftBase . log)))
:<|> (serveJobsAPI $ JobFunction (\i log -> New.addToCorpusWithForm cid i (liftBase . log)))
--}
addCorpusWithQuery
::
GargServer
New
.
AddWithQuery
addCorpusWithQuery
cid
=
addCorpusWithQuery
::
User
->
GargServer
New
.
AddWithQuery
addCorpusWithQuery
user
cid
=
serveJobsAPI
$
JobFunction
(
\
i
log
->
New
.
addToCorpus
JobFunction
cid
i
(
liftBase
.
log
))
JobFunction
(
\
i
log
->
New
.
addToCorpus
WithQuery
user
cid
i
(
liftBase
.
log
))
addWithFile
::
GargServer
New
.
AddWithFile
addWithFile
cid
i
f
=
...
...
src/Gargantext/API/Corpus/New.hs
View file @
b7355306
...
...
@@ -82,7 +82,7 @@ type Api = PostApi
type
PostApi
=
Summary
"New Corpus endpoint"
:>
ReqBody
'[
J
SON
]
Query
:>
Post
'[
J
SON
]
CorpusId
:>
Post
'[
J
SON
]
CorpusId
type
GetApi
=
Get
'[
J
SON
]
ApiInfo
-- | TODO manage several apis
...
...
@@ -182,18 +182,26 @@ type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint"
------------------------------------------------------------------------
-- TODO WithQuery also has a corpus id
addToCorpusJobFunction
::
FlowCmdM
env
err
m
=>
CorpusId
addToCorpusWithQuery
::
FlowCmdM
env
err
m
=>
User
->
CorpusId
->
WithQuery
->
(
ScraperStatus
->
m
()
)
->
m
ScraperStatus
addToCorpus
JobFunction
_cid
(
WithQuery
_q
_dbs
_
l
)
logStatus
=
do
addToCorpus
WithQuery
u
cid
(
WithQuery
q
_dbs
l
)
logStatus
=
do
-- TODO ...
logStatus
ScraperStatus
{
_scst_succeeded
=
Just
10
,
_scst_failed
=
Just
2
,
_scst_remaining
=
Just
138
,
_scst_events
=
Just
[]
}
printDebug
"addToCorpusWithQuery"
cid
-- TODO add cid
-- TODO if cid is folder -> create Corpus
-- if cid is corpus -> add to corpus
-- if cid is root -> create corpus in Private
cids
<-
flowCorpusSearchInDatabase
u
(
maybe
EN
identity
l
)
q
printDebug
"corpus id"
cids
-- TODO ...
pure
ScraperStatus
{
_scst_succeeded
=
Just
137
,
_scst_failed
=
Just
13
...
...
src/Gargantext/Core/Types/Individu.hs
View file @
b7355306
...
...
@@ -20,10 +20,11 @@ module Gargantext.Core.Types.Individu
import
Gargantext.Prelude
hiding
(
reverse
)
import
Data.Text
(
Text
,
pack
,
reverse
)
import
Gargantext.Database.Types.Node
(
NodeId
)
type
UserId
=
Int
data
User
=
UserDBId
UserId
|
UserName
Text
data
User
=
UserDBId
UserId
|
UserName
Text
|
RootId
NodeId
deriving
(
Eq
)
type
Username
=
Text
...
...
src/Gargantext/Database/Flow.hs
View file @
b7355306
...
...
@@ -213,9 +213,9 @@ flowCorpusUser :: (FlowCmdM env err m, MkCorpus c)
->
Maybe
c
->
[
NodeId
]
->
m
CorpusId
flowCorpusUser
l
user
Name
corpusName
ctype
ids
=
do
flowCorpusUser
l
user
corpusName
ctype
ids
=
do
-- User Flow
(
userId
,
_rootId
,
userCorpusId
)
<-
getOrMk_RootWithCorpus
user
Name
corpusName
ctype
(
userId
,
_rootId
,
userCorpusId
)
<-
getOrMk_RootWithCorpus
user
corpusName
ctype
listId
<-
getOrMkList
userCorpusId
userId
_cooc
<-
mkNode
NodeListCooc
listId
userId
-- TODO: check if present already, ignore
...
...
@@ -337,9 +337,9 @@ getOrMk_RootWithCorpus :: (HasNodeError err, MkCorpus a)
->
Either
CorpusName
[
CorpusId
]
->
Maybe
a
->
Cmd
err
(
UserId
,
RootId
,
CorpusId
)
getOrMk_RootWithCorpus
user
name
cName
c
=
do
(
userId
,
rootId
)
<-
getOrMkRoot
user
name
corpusId''
<-
if
user
name
==
UserName
userMaster
getOrMk_RootWithCorpus
user
cName
c
=
do
(
userId
,
rootId
)
<-
getOrMkRoot
user
corpusId''
<-
if
user
==
UserName
userMaster
then
do
ns
<-
getCorporaWithParentId
rootId
pure
$
map
_node_id
ns
...
...
src/Gargantext/Database/Schema/User.hs
View file @
b7355306
...
...
@@ -179,6 +179,9 @@ getUserId :: HasNodeError err
=>
User
->
Cmd
err
UserId
getUserId
(
UserDBId
uid
)
=
pure
uid
getUserId
(
RootId
rid
)
=
do
n
<-
getNode
rid
pure
$
_node_userId
n
getUserId
(
UserName
u
)
=
do
muser
<-
getUser
u
case
muser
of
...
...
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