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
71fc2e41
Commit
71fc2e41
authored
Apr 17, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[API Query] connection with front ok
parent
20185e50
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
92 additions
and
65 deletions
+92
-65
API.hs
src/Gargantext/API.hs
+23
-12
New.hs
src/Gargantext/API/Corpus/New.hs
+62
-43
List.hs
src/Gargantext/API/Ngrams/List.hs
+1
-5
Flow.hs
src/Gargantext/Database/Action/Flow.hs
+6
-5
No files found.
src/Gargantext/API.hs
View file @
71fc2e41
...
@@ -97,7 +97,7 @@ import qualified Data.Text.IO as T
...
@@ -97,7 +97,7 @@ import qualified Data.Text.IO as T
import
qualified
Gargantext.API.Corpus.Annuaire
as
Annuaire
import
qualified
Gargantext.API.Corpus.Annuaire
as
Annuaire
import
qualified
Gargantext.API.Corpus.Export
as
Export
import
qualified
Gargantext.API.Corpus.Export
as
Export
import
qualified
Gargantext.API.Corpus.New
as
New
import
qualified
Gargantext.API.Corpus.New
as
New
import
qualified
Gargantext.API.Ngrams.List
as
List
--
import qualified Gargantext.API.Ngrams.List as List
import
qualified
Paths_gargantext
as
PG
-- cabal magic build module
import
qualified
Paths_gargantext
as
PG
-- cabal magic build module
showAsServantErr
::
GargError
->
ServerError
showAsServantErr
::
GargError
->
ServerError
...
@@ -300,22 +300,25 @@ type GargPrivateAPI' =
...
@@ -300,22 +300,25 @@ type GargPrivateAPI' =
:>
TreeAPI
:>
TreeAPI
-- :<|> New.Upload
-- :<|> New.Upload
:<|>
New
.
AddWithForm
--
:<|> New.AddWithForm
:<|>
New
.
AddWithQuery
:<|>
New
.
AddWithQuery
:<|>
"annuaire"
:>
Annuaire
.
AddWithForm
--
:<|> "annuaire" :> Annuaire.AddWithForm
-- :<|> New.AddWithFile
-- :<|> New.AddWithFile
-- :<|> "scraper" :> WithCallbacks ScraperAPI
-- :<|> "scraper" :> WithCallbacks ScraperAPI
-- :<|> "new" :> New.Api
-- :<|> "new" :> New.Api
:<|>
"lists"
:>
Summary
"List export API"
:>
Capture
"listId"
ListId
:>
List
.
API
:<|>
"wait"
:>
Summary
"Wait test"
:<|>
"wait"
:>
Summary
"Wait test"
:>
Capture
"x"
Int
:>
Capture
"x"
Int
:>
WaitAPI
-- Get '[JSON] Int
:>
WaitAPI
-- Get '[JSON] Int
-- TODO "list"
{-
:<|> "lists" :> Summary "List export API"
:> Capture "listId" ListId
:> List.API
-}
-- /mv/<id>/<id>
-- /mv/<id>/<id>
-- /merge/<id>/<id>
-- /merge/<id>/<id>
-- /rename/<id>
-- /rename/<id>
...
@@ -406,25 +409,33 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
...
@@ -406,25 +409,33 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
-- TODO access
-- TODO access
-- :<|> addUpload
-- :<|> addUpload
-- :<|> (\corpus -> addWithQuery corpus :<|> addWithFile corpus)
-- :<|> (\corpus -> addWithQuery corpus :<|> addWithFile corpus)
:<|>
addCorpusWithForm
(
UserDBId
uid
)
--
:<|> addCorpusWithForm (UserDBId uid)
:<|>
addCorpusWithQuery
(
RootId
(
NodeId
uid
))
:<|>
addCorpusWithQuery
(
RootId
(
NodeId
uid
))
:<|>
addAnnuaireWithForm
--
:<|> addAnnuaireWithForm
-- :<|> New.api uid -- TODO-SECURITY
-- :<|> New.api uid -- TODO-SECURITY
-- :<|> New.info uid -- TODO-SECURITY
-- :<|> New.info uid -- TODO-SECURITY
:<|>
List
.
api
:<|>
waitAPI
:<|>
waitAPI
-- :<|> List.api
addCorpusWithQuery
::
User
->
GargServer
New
.
AddWithQuery
addCorpusWithQuery
::
User
->
GargServer
New
.
AddWithQuery
addCorpusWithQuery
user
cid
=
addCorpusWithQuery
user
cid
=
serveJobsAPI
$
serveJobsAPI
$
JobFunction
(
\
i
log
->
New
.
addToCorpusWithQuery
user
cid
i
(
liftBase
.
log
))
JobFunction
(
\
q
log
->
let
log'
x
=
do
printDebug
"addToCorpusWithQuery"
x
liftBase
$
log
x
in
New
.
addToCorpusWithQuery
user
cid
q
log'
)
{-
addWithFile :: GargServer New.AddWithFile
addWithFile :: GargServer New.AddWithFile
addWithFile cid i f =
addWithFile cid i f =
serveJobsAPI $
serveJobsAPI $
JobFunction (\_i log -> New.addToCorpusWithFile cid i f (liftBase . log))
JobFunction (\_i log -> New.addToCorpusWithFile cid i f (liftBase . log))
-}
addCorpusWithForm
::
User
->
GargServer
New
.
AddWithForm
addCorpusWithForm
::
User
->
GargServer
New
.
AddWithForm
addCorpusWithForm
user
cid
=
addCorpusWithForm
user
cid
=
...
@@ -432,7 +443,7 @@ addCorpusWithForm user cid =
...
@@ -432,7 +443,7 @@ addCorpusWithForm user cid =
JobFunction
(
\
i
log
->
JobFunction
(
\
i
log
->
let
let
log'
x
=
do
log'
x
=
do
printDebug
"addCorpusWithForm"
x
printDebug
"add
To
CorpusWithForm"
x
liftBase
$
log
x
liftBase
$
log
x
in
New
.
addToCorpusWithForm
user
cid
i
log'
)
in
New
.
addToCorpusWithForm
user
cid
i
log'
)
...
...
src/Gargantext/API/Corpus/New.hs
View file @
71fc2e41
...
@@ -25,7 +25,7 @@ New corpus means either:
...
@@ -25,7 +25,7 @@ New corpus means either:
module
Gargantext.API.Corpus.New
module
Gargantext.API.Corpus.New
where
where
import
Control.Lens
hiding
(
elements
)
import
Control.Lens
hiding
(
elements
,
Empty
)
import
Data.Aeson
import
Data.Aeson
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Either
import
Data.Either
...
@@ -33,12 +33,13 @@ import Data.Maybe (fromMaybe)
...
@@ -33,12 +33,13 @@ import Data.Maybe (fromMaybe)
import
Data.Swagger
import
Data.Swagger
import
Data.Text
(
Text
)
import
Data.Text
(
Text
)
import
GHC.Generics
(
Generic
)
import
GHC.Generics
(
Generic
)
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Orchestrator.Types
(
ScraperStatus
(
..
))
import
qualified
Gargantext.API.Admin.Orchestrator.Types
as
T
import
Gargantext.API.Corpus.New.File
import
Gargantext.API.Corpus.New.File
import
Gargantext.Core
(
Lang
(
..
)
,
allLangs
)
import
Gargantext.Core
(
Lang
(
..
)
{-, allLangs-}
)
import
Gargantext.Core.Types.Individu
(
UserId
,
User
(
..
))
import
Gargantext.Core.Types.Individu
(
UserId
,
User
(
..
))
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
)
import
Gargantext.Database.Action.Flow
(
FlowCmdM
,
flowCorpus
,
getDataText
,
flowDataText
,
TermType
(
..
),
DataOrigin
(
..
)
,
allDataOrigins
)
import
Gargantext.Database.Action.Flow
(
FlowCmdM
,
flowCorpus
,
getDataText
,
flowDataText
,
TermType
(
..
),
DataOrigin
(
..
)
{-, allDataOrigins-}
)
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
,
ToHyperdataDocument
(
..
))
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
,
ToHyperdataDocument
(
..
))
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Servant
import
Servant
...
@@ -46,14 +47,15 @@ import Servant.API.Flatten (Flat)
...
@@ -46,14 +47,15 @@ import Servant.API.Flatten (Flat)
import
Servant.Job.Core
import
Servant.Job.Core
import
Servant.Job.Types
import
Servant.Job.Types
import
Servant.Job.Utils
(
jsonOptions
)
import
Servant.Job.Utils
(
jsonOptions
)
import
Servant.Multipart
--
import Servant.Multipart
import
Test.QuickCheck
(
elements
)
--
import Test.QuickCheck (elements)
import
Test.QuickCheck.Arbitrary
import
Test.QuickCheck.Arbitrary
import
Web.FormUrlEncoded
(
FromForm
)
import
Web.FormUrlEncoded
(
FromForm
)
import
qualified
Gargantext.Text.Corpus.API
as
API
import
qualified
Gargantext.Text.Corpus.API
as
API
import
qualified
Gargantext.Text.Corpus.Parsers
as
Parser
(
FileFormat
(
..
),
parseFormat
)
import
qualified
Gargantext.Text.Corpus.Parsers
as
Parser
(
FileFormat
(
..
),
parseFormat
)
------------------------------------------------------------------------
------------------------------------------------------------------------
{-
data Query = Query { query_query :: Text
data Query = Query { query_query :: Text
, query_node_id :: Int
, query_node_id :: Int
, query_lang :: Lang
, query_lang :: Lang
...
@@ -75,9 +77,11 @@ instance Arbitrary Query where
...
@@ -75,9 +77,11 @@ instance Arbitrary Query where
instance ToSchema Query where
instance ToSchema Query where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "query_")
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "query_")
-}
------------------------------------------------------------------------
------------------------------------------------------------------------
{-
type Api = PostApi
type Api = PostApi
:<|> GetApi
:<|> GetApi
...
@@ -85,6 +89,7 @@ type PostApi = Summary "New Corpus endpoint"
...
@@ -85,6 +89,7 @@ type PostApi = Summary "New Corpus endpoint"
:> ReqBody '[JSON] Query
:> ReqBody '[JSON] Query
:> Post '[JSON] CorpusId
:> Post '[JSON] CorpusId
type GetApi = Get '[JSON] ApiInfo
type GetApi = Get '[JSON] ApiInfo
-}
-- | TODO manage several apis
-- | TODO manage several apis
-- TODO-ACCESS
-- TODO-ACCESS
...
@@ -118,11 +123,30 @@ info :: FlowCmdM env err m => UserId -> m ApiInfo
...
@@ -118,11 +123,30 @@ info :: FlowCmdM env err m => UserId -> m ApiInfo
info
_u
=
pure
$
ApiInfo
API
.
externalAPIs
info
_u
=
pure
$
ApiInfo
API
.
externalAPIs
------------------------------------------------------------------------
------------------------------------------------------------------------
data
Database
=
Empty
|
PubMed
|
HAL
|
IsTex
|
Isidore
deriving
(
Eq
,
Show
,
Generic
)
deriveJSON
(
unPrefix
""
)
''
D
atabase
instance
ToSchema
Database
database2origin
::
Database
->
DataOrigin
database2origin
Empty
=
InternalOrigin
T
.
IsTex
database2origin
PubMed
=
ExternalOrigin
T
.
PubMed
database2origin
HAL
=
ExternalOrigin
T
.
HAL
database2origin
IsTex
=
ExternalOrigin
T
.
IsTex
database2origin
Isidore
=
ExternalOrigin
T
.
Isidore
------------------------------------------------------------------------
------------------------------------------------------------------------
data
WithQuery
=
WithQuery
data
WithQuery
=
WithQuery
{
_wq_query
::
!
Text
{
_wq_query
::
!
Text
,
_wq_databases
::
!
[
DataOrigin
]
,
_wq_databases
::
!
Database
,
_wq_lang
::
!
(
Maybe
(
TermType
Lang
))
,
_wq_lang
::
!
Lang
,
_wq_node_id
::
!
Int
}
}
deriving
Generic
deriving
Generic
...
@@ -152,22 +176,13 @@ type AsyncJobs event ctI input output =
...
@@ -152,22 +176,13 @@ type AsyncJobs event ctI input output =
Flat
(
AsyncJobsAPI'
'U
n
safe
'S
a
fe
ctI
'[
J
SON
]
Maybe
event
input
output
)
Flat
(
AsyncJobsAPI'
'U
n
safe
'S
a
fe
ctI
'[
J
SON
]
Maybe
event
input
output
)
------------------------------------------------------------------------
------------------------------------------------------------------------
type
Upload
=
Summary
"Corpus Upload endpoint"
:>
"corpus"
:>
Capture
"corpus_id"
CorpusId
:<|>
"addWithquery"
:>
AsyncJobsAPI
ScraperStatus
WithQuery
ScraperStatus
:<|>
"addWithfile"
:>
AsyncJobs
ScraperStatus
'[
F
ormUrlEncoded
]
WithForm
ScraperStatus
type
AddWithQuery
=
Summary
"Add with Query to corpus endpoint"
type
AddWithQuery
=
Summary
"Add with Query to corpus endpoint"
:>
"corpus"
:>
"corpus"
:>
Capture
"corpus_id"
CorpusId
:>
Capture
"corpus_id"
CorpusId
:>
"add"
:>
"query"
:>
"query"
:>
"async"
:>
AsyncJobs
ScraperStatus
'[
J
SON
]
WithQuery
ScraperStatus
:>
AsyncJobsAPI
ScraperStatus
WithQuery
ScraperStatus
{-
type AddWithFile = Summary "Add with MultipartData to corpus endpoint"
type AddWithFile = Summary "Add with MultipartData to corpus endpoint"
:> "corpus"
:> "corpus"
:> Capture "corpus_id" CorpusId
:> Capture "corpus_id" CorpusId
...
@@ -177,6 +192,7 @@ type AddWithFile = Summary "Add with MultipartData to corpus endpoint"
...
@@ -177,6 +192,7 @@ type AddWithFile = Summary "Add with MultipartData to corpus endpoint"
:> QueryParam "fileType" FileType
:> QueryParam "fileType" FileType
:> "async"
:> "async"
:> AsyncJobs ScraperStatus '[JSON] () ScraperStatus
:> AsyncJobs ScraperStatus '[JSON] () ScraperStatus
-}
type
AddWithForm
=
Summary
"Add with FormUrlEncoded to corpus endpoint"
type
AddWithForm
=
Summary
"Add with FormUrlEncoded to corpus endpoint"
:>
"corpus"
:>
"corpus"
...
@@ -194,7 +210,7 @@ addToCorpusWithQuery :: FlowCmdM env err m
...
@@ -194,7 +210,7 @@ addToCorpusWithQuery :: FlowCmdM env err m
->
WithQuery
->
WithQuery
->
(
ScraperStatus
->
m
()
)
->
(
ScraperStatus
->
m
()
)
->
m
ScraperStatus
->
m
ScraperStatus
addToCorpusWithQuery
u
cid
(
WithQuery
q
dbs
l
)
logStatus
=
do
addToCorpusWithQuery
u
cid
(
WithQuery
q
dbs
l
_nid
)
logStatus
=
do
-- TODO ...
-- TODO ...
logStatus
ScraperStatus
{
_scst_succeeded
=
Just
10
logStatus
ScraperStatus
{
_scst_succeeded
=
Just
10
,
_scst_failed
=
Just
2
,
_scst_failed
=
Just
2
...
@@ -206,8 +222,8 @@ addToCorpusWithQuery u cid (WithQuery q dbs l) logStatus = do
...
@@ -206,8 +222,8 @@ addToCorpusWithQuery u cid (WithQuery q dbs l) logStatus = do
-- TODO if cid is folder -> create Corpus
-- TODO if cid is folder -> create Corpus
-- if cid is corpus -> add to corpus
-- if cid is corpus -> add to corpus
-- if cid is root -> create corpus in Private
-- if cid is root -> create corpus in Private
txts
<-
mapM
(
\
db
->
getDataText
db
(
fromMaybe
(
Multi
EN
)
l
)
q
(
Just
10000
))
dbs
txts
<-
mapM
(
\
db
->
getDataText
db
(
Multi
l
)
q
(
Just
10000
))
[
database2origin
dbs
]
cids
<-
mapM
(
\
txt
->
flowDataText
u
txt
(
fromMaybe
(
Multi
EN
)
l
)
cid
)
txts
cids
<-
mapM
(
\
txt
->
flowDataText
u
txt
(
Multi
l
)
cid
)
txts
printDebug
"corpus id"
cids
printDebug
"corpus id"
cids
-- TODO ...
-- TODO ...
pure
ScraperStatus
{
_scst_succeeded
=
Just
137
pure
ScraperStatus
{
_scst_succeeded
=
Just
137
...
@@ -216,27 +232,6 @@ addToCorpusWithQuery u cid (WithQuery q dbs l) logStatus = do
...
@@ -216,27 +232,6 @@ addToCorpusWithQuery u cid (WithQuery q dbs l) logStatus = do
,
_scst_events
=
Just
[]
,
_scst_events
=
Just
[]
}
}
addToCorpusWithFile
::
FlowCmdM
env
err
m
=>
CorpusId
->
MultipartData
Mem
->
Maybe
FileType
->
(
ScraperStatus
->
m
()
)
->
m
ScraperStatus
addToCorpusWithFile
cid
input
filetype
logStatus
=
do
logStatus
ScraperStatus
{
_scst_succeeded
=
Just
10
,
_scst_failed
=
Just
2
,
_scst_remaining
=
Just
138
,
_scst_events
=
Just
[]
}
printDebug
"addToCorpusWithFile"
cid
_h
<-
postUpload
cid
filetype
input
pure
ScraperStatus
{
_scst_succeeded
=
Just
137
,
_scst_failed
=
Just
13
,
_scst_remaining
=
Just
0
,
_scst_events
=
Just
[]
}
addToCorpusWithForm
::
FlowCmdM
env
err
m
addToCorpusWithForm
::
FlowCmdM
env
err
m
=>
User
=>
User
->
CorpusId
->
CorpusId
...
@@ -282,3 +277,27 @@ addToCorpusWithForm user cid (WithForm ft d l _n) logStatus = do
...
@@ -282,3 +277,27 @@ addToCorpusWithForm user cid (WithForm ft d l _n) logStatus = do
,
_scst_events
=
Just
[]
,
_scst_events
=
Just
[]
}
}
{-
addToCorpusWithFile :: FlowCmdM env err m
=> CorpusId
-> MultipartData Mem
-> Maybe FileType
-> (ScraperStatus -> m ())
-> m ScraperStatus
addToCorpusWithFile cid input filetype logStatus = do
logStatus ScraperStatus { _scst_succeeded = Just 10
, _scst_failed = Just 2
, _scst_remaining = Just 138
, _scst_events = Just []
}
printDebug "addToCorpusWithFile" cid
_h <- postUpload cid filetype input
pure ScraperStatus { _scst_succeeded = Just 137
, _scst_failed = Just 13
, _scst_remaining = Just 0
, _scst_events = Just []
}
-}
src/Gargantext/API/Ngrams/List.hs
View file @
71fc2e41
...
@@ -54,11 +54,7 @@ type API = Get '[JSON, HTML] (Headers '[Header "Content-Disposition" Text] Ngra
...
@@ -54,11 +54,7 @@ type API = Get '[JSON, HTML] (Headers '[Header "Content-Disposition" Text] Ngra
:<|>
PostAPI
:<|>
PostAPI
api
::
ListId
->
GargServer
API
api
::
ListId
->
GargServer
API
api
l
=
api
l
=
get
l
:<|>
postAsync
l
get
l
:<|>
-- post l
postAsync
l
data
HTML
data
HTML
instance
Accept
HTML
where
instance
Accept
HTML
where
...
...
src/Gargantext/Database/Action/Flow.hs
View file @
71fc2e41
...
@@ -103,8 +103,8 @@ import qualified Gargantext.Text.Corpus.API as API
...
@@ -103,8 +103,8 @@ import qualified Gargantext.Text.Corpus.API as API
------------------------------------------------------------------------
------------------------------------------------------------------------
-- TODO use internal with API name (could be old data)
-- TODO use internal with API name (could be old data)
data
DataOrigin
=
Internal
{
_do_api
::
API
.
ExternalAPIs
}
data
DataOrigin
=
Internal
Origin
{
_do_api
::
API
.
ExternalAPIs
}
|
External
{
_do_api
::
API
.
ExternalAPIs
}
|
External
Origin
{
_do_api
::
API
.
ExternalAPIs
}
-- TODO Web
-- TODO Web
deriving
(
Generic
,
Eq
)
deriving
(
Generic
,
Eq
)
...
@@ -114,7 +114,8 @@ instance ToSchema DataOrigin where
...
@@ -114,7 +114,8 @@ instance ToSchema DataOrigin where
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"_do_"
)
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"_do_"
)
allDataOrigins
::
[
DataOrigin
]
allDataOrigins
::
[
DataOrigin
]
allDataOrigins
=
map
Internal
API
.
externalAPIs
<>
map
External
API
.
externalAPIs
allDataOrigins
=
map
InternalOrigin
API
.
externalAPIs
<>
map
ExternalOrigin
API
.
externalAPIs
---------------
---------------
...
@@ -129,10 +130,10 @@ getDataText :: FlowCmdM env err m
...
@@ -129,10 +130,10 @@ getDataText :: FlowCmdM env err m
->
API
.
Query
->
API
.
Query
->
Maybe
API
.
Limit
->
Maybe
API
.
Limit
->
m
DataText
->
m
DataText
getDataText
(
External
api
)
la
q
li
=
liftBase
$
DataNew
getDataText
(
External
Origin
api
)
la
q
li
=
liftBase
$
DataNew
<$>
splitEvery
500
<$>
splitEvery
500
<$>
API
.
get
api
(
_tt_lang
la
)
q
li
<$>
API
.
get
api
(
_tt_lang
la
)
q
li
getDataText
(
Internal
_
)
_la
q
_li
=
do
getDataText
(
Internal
Origin
_
)
_la
q
_li
=
do
(
_masterUserId
,
_masterRootId
,
cId
)
<-
getOrMk_RootWithCorpus
(
_masterUserId
,
_masterRootId
,
cId
)
<-
getOrMk_RootWithCorpus
(
UserName
userMaster
)
(
UserName
userMaster
)
(
Left
""
)
(
Left
""
)
...
...
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