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
f63b5188
Commit
f63b5188
authored
Jun 19, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[RENAME] ScraperStatus -> JobLog
parent
3041d86d
Changes
11
Hide whitespace changes
Inline
Side-by-side
Showing
11 changed files
with
137 additions
and
118 deletions
+137
-118
Orchestrator.hs
src/Gargantext/API/Admin/Orchestrator.hs
+8
-9
Types.hs
src/Gargantext/API/Admin/Orchestrator/Types.hs
+10
-9
Settings.hs
src/Gargantext/API/Admin/Settings.hs
+2
-2
List.hs
src/Gargantext/API/Ngrams/List.hs
+5
-5
Node.hs
src/Gargantext/API/Node.hs
+0
-2
Annuaire.hs
src/Gargantext/API/Node/Corpus/Annuaire.hs
+5
-5
New.hs
src/Gargantext/API/Node/Corpus/New.hs
+38
-28
New.hs
src/Gargantext/API/Node/New.hs
+7
-7
Update.hs
src/Gargantext/API/Node/Update.hs
+44
-33
Prelude.hs
src/Gargantext/API/Prelude.hs
+13
-13
API.hs
src/Gargantext/Viz/Graph/API.hs
+5
-5
No files found.
src/Gargantext/API/Admin/Orchestrator.hs
View file @
f63b5188
...
@@ -16,18 +16,17 @@ module Gargantext.API.Admin.Orchestrator where
...
@@ -16,18 +16,17 @@ module Gargantext.API.Admin.Orchestrator where
import
Control.Lens
hiding
(
elements
)
import
Control.Lens
hiding
(
elements
)
import
Data.Aeson
import
Data.Aeson
import
qualified
Data.ByteString.Lazy.Char8
as
LBS
import
Data.Text
import
Data.Text
import
Gargantext.API.Admin.Orchestrator.Scrapy.Schedule
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Settings
import
Gargantext.Prelude
import
Servant
import
Servant
import
Servant.Job.Async
import
Servant.Job.Async
import
Servant.Job.Client
import
Servant.Job.Client
import
Servant.Job.Server
import
Servant.Job.Server
import
Servant.Job.Utils
(
extendBaseUrl
)
import
Servant.Job.Utils
(
extendBaseUrl
)
import
qualified
Data.ByteString.Lazy.Char8
as
LBS
import
Gargantext.Prelude
import
Gargantext.API.Admin.Settings
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Orchestrator.Scrapy.Schedule
callJobScrapy
::
(
ToJSON
e
,
FromJSON
e
,
FromJSON
o
,
MonadClientJob
m
)
callJobScrapy
::
(
ToJSON
e
,
FromJSON
e
,
FromJSON
o
,
MonadClientJob
m
)
=>
JobServerURL
e
Schedule
o
=>
JobServerURL
e
Schedule
o
...
@@ -44,7 +43,7 @@ callJobScrapy jurl schedule = do
...
@@ -44,7 +43,7 @@ callJobScrapy jurl schedule = do
logConsole
::
ToJSON
a
=>
a
->
IO
()
logConsole
::
ToJSON
a
=>
a
->
IO
()
logConsole
=
LBS
.
putStrLn
.
encode
logConsole
=
LBS
.
putStrLn
.
encode
callScraper
::
MonadClientJob
m
=>
URL
->
ScraperInput
->
m
ScraperStatus
callScraper
::
MonadClientJob
m
=>
URL
->
ScraperInput
->
m
JobLog
callScraper
url
input
=
callScraper
url
input
=
callJobScrapy
jurl
$
\
cb
->
callJobScrapy
jurl
$
\
cb
->
Schedule
Schedule
...
@@ -64,11 +63,11 @@ callScraper url input =
...
@@ -64,11 +63,11 @@ callScraper url input =
,(
"callback"
,
[
toUrlPiece
cb
])]
,(
"callback"
,
[
toUrlPiece
cb
])]
}
}
where
where
jurl
::
JobServerURL
ScraperStatus
Schedule
ScraperStatus
jurl
::
JobServerURL
JobLog
Schedule
JobLog
jurl
=
JobServerURL
url
Callback
jurl
=
JobServerURL
url
Callback
pipeline
::
FromJSON
e
=>
URL
->
ClientEnv
->
ScraperInput
pipeline
::
FromJSON
e
=>
URL
->
ClientEnv
->
ScraperInput
->
(
e
->
IO
()
)
->
IO
ScraperStatus
->
(
e
->
IO
()
)
->
IO
JobLog
pipeline
scrapyurl
client_env
input
log_status
=
do
pipeline
scrapyurl
client_env
input
log_status
=
do
e
<-
runJobMLog
client_env
log_status
$
callScraper
scrapyurl
input
e
<-
runJobMLog
client_env
log_status
$
callScraper
scrapyurl
input
either
(
panic
.
cs
.
show
)
pure
e
-- TODO throwError
either
(
panic
.
cs
.
show
)
pure
e
-- TODO throwError
...
...
src/Gargantext/API/Admin/Orchestrator/Types.hs
View file @
f63b5188
...
@@ -20,7 +20,6 @@ import Test.QuickCheck (elements)
...
@@ -20,7 +20,6 @@ import Test.QuickCheck (elements)
import
Test.QuickCheck.Arbitrary
import
Test.QuickCheck.Arbitrary
------------------------------------------------------------------------
------------------------------------------------------------------------
instance
Arbitrary
a
=>
Arbitrary
(
JobStatus
'S
a
fe
a
)
where
instance
Arbitrary
a
=>
Arbitrary
(
JobStatus
'S
a
fe
a
)
where
arbitrary
=
panic
"TODO"
arbitrary
=
panic
"TODO"
...
@@ -90,7 +89,9 @@ instance ToJSON ScraperEvent where
...
@@ -90,7 +89,9 @@ instance ToJSON ScraperEvent where
instance
FromJSON
ScraperEvent
where
instance
FromJSON
ScraperEvent
where
parseJSON
=
genericParseJSON
$
jsonOptions
"_scev_"
parseJSON
=
genericParseJSON
$
jsonOptions
"_scev_"
data
ScraperStatus
=
ScraperStatus
data
JobLog
=
JobLog
{
_scst_succeeded
::
!
(
Maybe
Int
)
{
_scst_succeeded
::
!
(
Maybe
Int
)
,
_scst_failed
::
!
(
Maybe
Int
)
,
_scst_failed
::
!
(
Maybe
Int
)
,
_scst_remaining
::
!
(
Maybe
Int
)
,
_scst_remaining
::
!
(
Maybe
Int
)
...
@@ -98,20 +99,20 @@ data ScraperStatus = ScraperStatus
...
@@ -98,20 +99,20 @@ data ScraperStatus = ScraperStatus
}
}
deriving
(
Show
,
Generic
)
deriving
(
Show
,
Generic
)
instance
Arbitrary
ScraperStatus
where
instance
Arbitrary
JobLog
where
arbitrary
=
ScraperStatus
arbitrary
=
JobLog
<$>
arbitrary
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
instance
ToJSON
ScraperStatus
where
instance
ToJSON
JobLog
where
toJSON
=
genericToJSON
$
jsonOptions
"_scst_"
toJSON
=
genericToJSON
$
jsonOptions
"_scst_"
instance
FromJSON
ScraperStatus
where
instance
FromJSON
JobLog
where
parseJSON
=
genericParseJSON
$
jsonOptions
"_scst_"
parseJSON
=
genericParseJSON
$
jsonOptions
"_scst_"
instance
ToSchema
ScraperStatus
-- TODO _scst_ prefix
instance
ToSchema
JobLog
-- TODO _scst_ prefix
instance
ToSchema
ScraperInput
-- TODO _scin_ prefix
instance
ToSchema
ScraperInput
-- TODO _scin_ prefix
instance
ToSchema
ScraperEvent
-- TODO _scev_ prefix
instance
ToSchema
ScraperEvent
-- TODO _scev_ prefix
...
@@ -122,6 +123,6 @@ instance ToParamSchema Offset -- where
...
@@ -122,6 +123,6 @@ instance ToParamSchema Offset -- where
instance
ToParamSchema
Limit
-- where
instance
ToParamSchema
Limit
-- where
-- toParamSchema = panic "TODO"
-- toParamSchema = panic "TODO"
type
ScrapersEnv
=
JobEnv
ScraperStatus
ScraperStatus
type
ScrapersEnv
=
JobEnv
JobLog
JobLog
type
ScraperAPI
=
AsyncJobsAPI
ScraperStatus
ScraperInput
ScraperStatus
type
ScraperAPI
=
AsyncJobsAPI
JobLog
ScraperInput
JobLog
src/Gargantext/API/Admin/Settings.hs
View file @
f63b5188
...
@@ -156,10 +156,10 @@ instance HasRepo Env where
...
@@ -156,10 +156,10 @@ instance HasRepo Env where
instance
HasSettings
Env
where
instance
HasSettings
Env
where
settings
=
env_settings
settings
=
env_settings
instance
Servant
.
Job
.
Core
.
HasEnv
Env
(
Job
ScraperStatus
ScraperStatus
)
where
instance
Servant
.
Job
.
Core
.
HasEnv
Env
(
Job
JobLog
JobLog
)
where
_env
=
env_scrapers
.
Servant
.
Job
.
Core
.
_env
_env
=
env_scrapers
.
Servant
.
Job
.
Core
.
_env
instance
HasJobEnv
Env
ScraperStatus
ScraperStatus
where
instance
HasJobEnv
Env
JobLog
JobLog
where
job_env
=
env_scrapers
job_env
=
env_scrapers
data
MockEnv
=
MockEnv
data
MockEnv
=
MockEnv
...
...
src/Gargantext/API/Ngrams/List.hs
View file @
f63b5188
...
@@ -93,7 +93,7 @@ type PostAPI = Summary "Update List"
...
@@ -93,7 +93,7 @@ type PostAPI = Summary "Update List"
:>
"add"
:>
"add"
:>
"form"
:>
"form"
:>
"async"
:>
"async"
:>
AsyncJobs
ScraperStatus
'[
F
ormUrlEncoded
]
WithFile
ScraperStatus
:>
AsyncJobs
JobLog
'[
F
ormUrlEncoded
]
WithFile
JobLog
postAsync
::
ListId
->
GargServer
PostAPI
postAsync
::
ListId
->
GargServer
PostAPI
postAsync
lId
=
postAsync
lId
=
...
@@ -103,18 +103,18 @@ postAsync lId =
...
@@ -103,18 +103,18 @@ postAsync lId =
postAsync'
::
FlowCmdM
env
err
m
postAsync'
::
FlowCmdM
env
err
m
=>
ListId
=>
ListId
->
WithFile
->
WithFile
->
(
ScraperStatus
->
m
()
)
->
(
JobLog
->
m
()
)
->
m
ScraperStatus
->
m
JobLog
postAsync'
l
(
WithFile
_
m
_
)
logStatus
=
do
postAsync'
l
(
WithFile
_
m
_
)
logStatus
=
do
logStatus
ScraperStatus
{
_scst_succeeded
=
Just
0
logStatus
JobLog
{
_scst_succeeded
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
1
,
_scst_remaining
=
Just
1
,
_scst_events
=
Just
[]
,
_scst_events
=
Just
[]
}
}
_r
<-
post
l
m
_r
<-
post
l
m
pure
ScraperStatus
{
_scst_succeeded
=
Just
1
pure
JobLog
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_events
=
Just
[]
,
_scst_events
=
Just
[]
...
...
src/Gargantext/API/Node.hs
View file @
f63b5188
...
@@ -324,5 +324,3 @@ putNode :: forall err a. (HasNodeError err, JSONB a, ToJSON a)
...
@@ -324,5 +324,3 @@ putNode :: forall err a. (HasNodeError err, JSONB a, ToJSON a)
->
Cmd
err
Int
->
Cmd
err
Int
putNode
n
h
=
fromIntegral
<$>
updateHyperdata
n
h
putNode
n
h
=
fromIntegral
<$>
updateHyperdata
n
h
-------------------------------------------------------------
-------------------------------------------------------------
src/Gargantext/API/Node/Corpus/Annuaire.hs
View file @
f63b5188
...
@@ -62,14 +62,14 @@ type AddWithForm = Summary "Add with FormUrlEncoded to annuaire endpoint"
...
@@ -62,14 +62,14 @@ type AddWithForm = Summary "Add with FormUrlEncoded to annuaire endpoint"
:>
"add"
:>
"add"
:>
"form"
:>
"form"
:>
"async"
:>
"async"
:>
AsyncJobs
ScraperStatus
'[
F
ormUrlEncoded
]
AnnuaireWithForm
ScraperStatus
:>
AsyncJobs
JobLog
'[
F
ormUrlEncoded
]
AnnuaireWithForm
JobLog
------------------------------------------------------------------------
------------------------------------------------------------------------
addToAnnuaireWithForm
::
FlowCmdM
env
err
m
addToAnnuaireWithForm
::
FlowCmdM
env
err
m
=>
AnnuaireId
=>
AnnuaireId
->
AnnuaireWithForm
->
AnnuaireWithForm
->
(
ScraperStatus
->
m
()
)
->
(
JobLog
->
m
()
)
->
m
ScraperStatus
->
m
JobLog
addToAnnuaireWithForm
_cid
(
AnnuaireWithForm
ft
_d
_l
)
logStatus
=
do
addToAnnuaireWithForm
_cid
(
AnnuaireWithForm
ft
_d
_l
)
logStatus
=
do
printDebug
"ft"
ft
printDebug
"ft"
ft
...
@@ -86,7 +86,7 @@ addToAnnuaireWithForm _cid (AnnuaireWithForm ft _d _l) logStatus = do
...
@@ -86,7 +86,7 @@ addToAnnuaireWithForm _cid (AnnuaireWithForm ft _d _l) logStatus = do
-- <$> take 1000000
-- <$> take 1000000
-- <$> parse (cs d)
-- <$> parse (cs d)
logStatus
ScraperStatus
{
_scst_succeeded
=
Just
1
logStatus
JobLog
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
1
,
_scst_remaining
=
Just
1
,
_scst_events
=
Just
[]
,
_scst_events
=
Just
[]
...
@@ -98,7 +98,7 @@ addToAnnuaireWithForm _cid (AnnuaireWithForm ft _d _l) logStatus = do
...
@@ -98,7 +98,7 @@ addToAnnuaireWithForm _cid (AnnuaireWithForm ft _d _l) logStatus = do
-- printDebug "cid'" cid'
-- printDebug "cid'" cid'
pure
ScraperStatus
{
_scst_succeeded
=
Just
2
pure
JobLog
{
_scst_succeeded
=
Just
2
,
_scst_failed
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_events
=
Just
[]
,
_scst_events
=
Just
[]
...
...
src/Gargantext/API/Node/Corpus/New.hs
View file @
f63b5188
...
@@ -27,7 +27,7 @@ import Data.Maybe (fromMaybe)
...
@@ -27,7 +27,7 @@ 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
(
ScraperStatus
(
..
))
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
(
..
))
import
qualified
Gargantext.API.Admin.Orchestrator.Types
as
T
import
qualified
Gargantext.API.Admin.Orchestrator.Types
as
T
import
Gargantext.API.Node.Corpus.New.File
import
Gargantext.API.Node.Corpus.New.File
import
Gargantext.Core
(
Lang
(
..
)
{-, allLangs-}
)
import
Gargantext.Core
(
Lang
(
..
)
{-, allLangs-}
)
...
@@ -173,7 +173,7 @@ type AddWithQuery = Summary "Add with Query to corpus endpoint"
...
@@ -173,7 +173,7 @@ type AddWithQuery = Summary "Add with Query to corpus endpoint"
:>
"corpus"
:>
"corpus"
:>
Capture
"corpus_id"
CorpusId
:>
Capture
"corpus_id"
CorpusId
:>
"query"
:>
"query"
:>
AsyncJobs
ScraperStatus
'[
J
SON
]
WithQuery
ScraperStatus
:>
AsyncJobs
JobLog
'[
J
SON
]
WithQuery
JobLog
{-
{-
type AddWithFile = Summary "Add with MultipartData to corpus endpoint"
type AddWithFile = Summary "Add with MultipartData to corpus endpoint"
...
@@ -184,7 +184,7 @@ type AddWithFile = Summary "Add with MultipartData to corpus endpoint"
...
@@ -184,7 +184,7 @@ type AddWithFile = Summary "Add with MultipartData to corpus endpoint"
:> MultipartForm Mem (MultipartData Mem)
:> MultipartForm Mem (MultipartData Mem)
:> QueryParam "fileType" FileType
:> QueryParam "fileType" FileType
:> "async"
:> "async"
:> AsyncJobs
ScraperStatus '[JSON] () ScraperStatus
:> AsyncJobs
JobLog '[JSON] () JobLog
-}
-}
type
AddWithForm
=
Summary
"Add with FormUrlEncoded to corpus endpoint"
type
AddWithForm
=
Summary
"Add with FormUrlEncoded to corpus endpoint"
...
@@ -193,7 +193,7 @@ type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint"
...
@@ -193,7 +193,7 @@ type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint"
:>
"add"
:>
"add"
:>
"form"
:>
"form"
:>
"async"
:>
"async"
:>
AsyncJobs
ScraperStatus
'[
F
ormUrlEncoded
]
NewWithForm
ScraperStatus
:>
AsyncJobs
JobLog
'[
F
ormUrlEncoded
]
NewWithForm
JobLog
------------------------------------------------------------------------
------------------------------------------------------------------------
...
@@ -202,13 +202,13 @@ addToCorpusWithQuery :: FlowCmdM env err m
...
@@ -202,13 +202,13 @@ addToCorpusWithQuery :: FlowCmdM env err m
=>
User
=>
User
->
CorpusId
->
CorpusId
->
WithQuery
->
WithQuery
->
(
ScraperStatus
->
m
()
)
->
(
JobLog
->
m
()
)
->
m
ScraperStatus
->
m
JobLog
addToCorpusWithQuery
u
cid
(
WithQuery
q
dbs
l
_nid
)
logStatus
=
do
addToCorpusWithQuery
u
cid
(
WithQuery
q
dbs
l
_nid
)
logStatus
=
do
-- TODO ...
-- TODO ...
logStatus
ScraperStatus
{
_scst_succeeded
=
Just
1
0
logStatus
JobLog
{
_scst_succeeded
=
Just
0
,
_scst_failed
=
Just
2
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
138
,
_scst_remaining
=
Just
5
,
_scst_events
=
Just
[]
,
_scst_events
=
Just
[]
}
}
printDebug
"addToCorpusWithQuery"
cid
printDebug
"addToCorpusWithQuery"
cid
...
@@ -217,11 +217,18 @@ addToCorpusWithQuery u cid (WithQuery q dbs l _nid) logStatus = do
...
@@ -217,11 +217,18 @@ addToCorpusWithQuery u cid (WithQuery q dbs l _nid) logStatus = do
-- 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
(
Multi
l
)
q
(
Just
10000
))
[
database2origin
dbs
]
txts
<-
mapM
(
\
db
->
getDataText
db
(
Multi
l
)
q
(
Just
10000
))
[
database2origin
dbs
]
logStatus
JobLog
{
_scst_succeeded
=
Just
2
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
1
,
_scst_events
=
Just
[]
}
cids
<-
mapM
(
\
txt
->
flowDataText
u
txt
(
Multi
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
JobLog
{
_scst_succeeded
=
Just
3
,
_scst_failed
=
Just
13
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_events
=
Just
[]
,
_scst_events
=
Just
[]
}
}
...
@@ -230,10 +237,16 @@ addToCorpusWithForm :: FlowCmdM env err m
...
@@ -230,10 +237,16 @@ addToCorpusWithForm :: FlowCmdM env err m
=>
User
=>
User
->
CorpusId
->
CorpusId
->
NewWithForm
->
NewWithForm
->
(
ScraperStatus
->
m
()
)
->
(
JobLog
->
m
()
)
->
m
ScraperStatus
->
m
JobLog
addToCorpusWithForm
user
cid
(
NewWithForm
ft
d
l
_n
)
logStatus
=
do
addToCorpusWithForm
user
cid
(
NewWithForm
ft
d
l
_n
)
logStatus
=
do
printDebug
"Parsing corpus: "
cid
logStatus
JobLog
{
_scst_succeeded
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
2
,
_scst_events
=
Just
[]
}
let
let
parse
=
case
ft
of
parse
=
case
ft
of
CSV_HAL
->
Parser
.
parseFormat
Parser
.
CsvHal
CSV_HAL
->
Parser
.
parseFormat
Parser
.
CsvHal
...
@@ -241,22 +254,20 @@ addToCorpusWithForm user cid (NewWithForm ft d l _n) logStatus = do
...
@@ -241,22 +254,20 @@ addToCorpusWithForm user cid (NewWithForm ft d l _n) logStatus = do
WOS
->
Parser
.
parseFormat
Parser
.
WOS
WOS
->
Parser
.
parseFormat
Parser
.
WOS
PresseRIS
->
Parser
.
parseFormat
Parser
.
RisPresse
PresseRIS
->
Parser
.
parseFormat
Parser
.
RisPresse
logStatus
ScraperStatus
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
1
,
_scst_events
=
Just
[]
}
printDebug
"Parsing corpus: "
cid
-- TODO granularity of the logStatus
-- TODO granularity of the logStatus
docs
<-
liftBase
$
splitEvery
500
docs
<-
liftBase
$
splitEvery
500
<$>
take
1000000
<$>
take
1000000
<$>
parse
(
cs
d
)
<$>
parse
(
cs
d
)
printDebug
"Parsing corpus finished : "
cid
printDebug
"Parsing corpus finished : "
cid
printDebug
"Starting extraction : "
cid
logStatus
JobLog
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
1
,
_scst_events
=
Just
[]
}
printDebug
"Starting extraction : "
cid
-- TODO granularity of the logStatus
-- TODO granularity of the logStatus
_cid'
<-
flowCorpus
user
_cid'
<-
flowCorpus
user
(
Right
[
cid
])
(
Right
[
cid
])
...
@@ -264,8 +275,7 @@ addToCorpusWithForm user cid (NewWithForm ft d l _n) logStatus = do
...
@@ -264,8 +275,7 @@ addToCorpusWithForm user cid (NewWithForm ft d l _n) logStatus = do
(
map
(
map
toHyperdataDocument
)
docs
)
(
map
(
map
toHyperdataDocument
)
docs
)
printDebug
"Extraction finished : "
cid
printDebug
"Extraction finished : "
cid
pure
JobLog
{
_scst_succeeded
=
Just
2
pure
ScraperStatus
{
_scst_succeeded
=
Just
2
,
_scst_failed
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_events
=
Just
[]
,
_scst_events
=
Just
[]
...
@@ -276,10 +286,10 @@ addToCorpusWithFile :: FlowCmdM env err m
...
@@ -276,10 +286,10 @@ addToCorpusWithFile :: FlowCmdM env err m
=> CorpusId
=> CorpusId
-> MultipartData Mem
-> MultipartData Mem
-> Maybe FileType
-> Maybe FileType
-> (
ScraperStatus
-> m ())
-> (
JobLog
-> m ())
-> m
ScraperStatus
-> m
JobLog
addToCorpusWithFile cid input filetype logStatus = do
addToCorpusWithFile cid input filetype logStatus = do
logStatus
ScraperStatus
{ _scst_succeeded = Just 10
logStatus
JobLog
{ _scst_succeeded = Just 10
, _scst_failed = Just 2
, _scst_failed = Just 2
, _scst_remaining = Just 138
, _scst_remaining = Just 138
, _scst_events = Just []
, _scst_events = Just []
...
@@ -287,7 +297,7 @@ addToCorpusWithFile cid input filetype logStatus = do
...
@@ -287,7 +297,7 @@ addToCorpusWithFile cid input filetype logStatus = do
printDebug "addToCorpusWithFile" cid
printDebug "addToCorpusWithFile" cid
_h <- postUpload cid filetype input
_h <- postUpload cid filetype input
pure
ScraperStatus
{ _scst_succeeded = Just 137
pure
JobLog
{ _scst_succeeded = Just 137
, _scst_failed = Just 13
, _scst_failed = Just 13
, _scst_remaining = Just 0
, _scst_remaining = Just 0
, _scst_events = Just []
, _scst_events = Just []
...
...
src/Gargantext/API/Node/New.hs
View file @
f63b5188
...
@@ -24,7 +24,7 @@ import Data.Aeson
...
@@ -24,7 +24,7 @@ import Data.Aeson
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
(
ScraperStatus
(
..
))
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
(
..
))
import
Gargantext.API.Node.Corpus.New
(
AsyncJobs
)
import
Gargantext.API.Node.Corpus.New
(
AsyncJobs
)
import
Gargantext.API.Prelude
import
Gargantext.API.Prelude
import
Gargantext.Database.Action.Flow.Types
import
Gargantext.Database.Action.Flow.Types
...
@@ -68,7 +68,7 @@ postNode uId pId (PostNode nodeName nt) = do
...
@@ -68,7 +68,7 @@ postNode uId pId (PostNode nodeName nt) = do
------------------------------------------------------------------------
------------------------------------------------------------------------
type
PostNodeAsync
=
Summary
"Post Node"
type
PostNodeAsync
=
Summary
"Post Node"
:>
"async"
:>
"async"
:>
AsyncJobs
ScraperStatus
'[
F
ormUrlEncoded
]
PostNode
ScraperStatus
:>
AsyncJobs
JobLog
'[
F
ormUrlEncoded
]
PostNode
JobLog
postNodeAsyncAPI
::
UserId
->
NodeId
->
GargServer
PostNodeAsync
postNodeAsyncAPI
::
UserId
->
NodeId
->
GargServer
PostNodeAsync
...
@@ -81,12 +81,12 @@ postNodeAsync :: FlowCmdM env err m
...
@@ -81,12 +81,12 @@ postNodeAsync :: FlowCmdM env err m
=>
UserId
=>
UserId
->
NodeId
->
NodeId
->
PostNode
->
PostNode
->
(
ScraperStatus
->
m
()
)
->
(
JobLog
->
m
()
)
->
m
ScraperStatus
->
m
JobLog
postNodeAsync
uId
nId
(
PostNode
nodeName
tn
)
logStatus
=
do
postNodeAsync
uId
nId
(
PostNode
nodeName
tn
)
logStatus
=
do
printDebug
"postNodeAsync"
nId
printDebug
"postNodeAsync"
nId
logStatus
ScraperStatus
{
_scst_succeeded
=
Just
1
logStatus
JobLog
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
2
,
_scst_remaining
=
Just
2
,
_scst_events
=
Just
[]
,
_scst_events
=
Just
[]
...
@@ -95,7 +95,7 @@ postNodeAsync uId nId (PostNode nodeName tn) logStatus = do
...
@@ -95,7 +95,7 @@ postNodeAsync uId nId (PostNode nodeName tn) logStatus = do
nodeUser
<-
getNodeUser
(
NodeId
uId
)
nodeUser
<-
getNodeUser
(
NodeId
uId
)
-- _ <- threadDelay 1000
-- _ <- threadDelay 1000
logStatus
ScraperStatus
{
_scst_succeeded
=
Just
1
logStatus
JobLog
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
2
,
_scst_remaining
=
Just
2
,
_scst_events
=
Just
[]
,
_scst_events
=
Just
[]
...
@@ -104,7 +104,7 @@ postNodeAsync uId nId (PostNode nodeName tn) logStatus = do
...
@@ -104,7 +104,7 @@ postNodeAsync uId nId (PostNode nodeName tn) logStatus = do
let
uId'
=
nodeUser
^.
node_userId
let
uId'
=
nodeUser
^.
node_userId
_
<-
mkNodeWithParent
tn
(
Just
nId
)
uId'
nodeName
_
<-
mkNodeWithParent
tn
(
Just
nId
)
uId'
nodeName
pure
ScraperStatus
{
_scst_succeeded
=
Just
3
pure
JobLog
{
_scst_succeeded
=
Just
3
,
_scst_failed
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_events
=
Just
[]
,
_scst_events
=
Just
[]
...
...
src/Gargantext/API/Node/Update.hs
View file @
f63b5188
...
@@ -19,12 +19,12 @@ module Gargantext.API.Node.Update
...
@@ -19,12 +19,12 @@ module Gargantext.API.Node.Update
import
Data.Aeson
import
Data.Aeson
import
Data.Swagger
import
Data.Swagger
import
GHC.Generics
(
Generic
)
import
GHC.Generics
(
Generic
)
import
Gargantext.API.Admin.Orchestrator.Types
(
ScraperStatus
(
..
))
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
(
..
))
import
Gargantext.API.Node.Corpus.New
(
AsyncJobs
)
import
Gargantext.API.Node.Corpus.New
(
AsyncJobs
)
import
Gargantext.API.Prelude
(
GargServer
{-, simuLogs-}
)
import
Gargantext.API.Prelude
(
GargServer
{-, simuLogs-}
)
import
Gargantext.Database.Action.Flow.Types
(
FlowCmdM
)
import
Gargantext.Database.Action.Flow.Types
(
FlowCmdM
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Prelude
(
Ord
,
Eq
,
(
<$>
),
(
$
),
liftBase
,
(
.
),
Int
,
(
-
),
pure
,
(
*
),
(
^
),
printDebug
)
import
Gargantext.Prelude
(
Ord
,
Eq
,
(
<$>
),
(
$
),
liftBase
,
(
.
),
Int
,
pure
,
(
*
),
printDebug
,
(
^
))
-- (-), (^)
)
import
Prelude
(
Enum
,
Bounded
,
minBound
,
maxBound
)
import
Prelude
(
Enum
,
Bounded
,
minBound
,
maxBound
)
import
Servant
import
Servant
import
Servant.Job.Async
(
JobFunction
(
..
),
serveJobsAPI
)
import
Servant.Job.Async
(
JobFunction
(
..
),
serveJobsAPI
)
...
@@ -97,57 +97,68 @@ instance Arbitrary Charts where
...
@@ -97,57 +97,68 @@ instance Arbitrary Charts where
arbitrary
=
elements
[
minBound
..
maxBound
]
arbitrary
=
elements
[
minBound
..
maxBound
]
------------------------------------------------------------------------
------------------------------------------------------------------------
api
::
UserId
->
NodeId
->
GargServer
API
api
::
UserId
->
NodeId
->
GargServer
API
api
uId
nId
=
api
uId
nId
=
serveJobsAPI
$
serveJobsAPI
$
JobFunction
(
\
p
logs
->
updateNode
uId
nId
p
(
liftBase
.
logs
))
JobFunction
(
\
p
log
->
let
log'
x
=
do
printDebug
"updateNode"
x
liftBase
$
log
x
in
updateNode
uId
nId
p
(
liftBase
.
log'
)
)
updateNode
::
FlowCmdM
env
err
m
updateNode
::
FlowCmdM
env
err
m
=>
UserId
=>
UserId
->
NodeId
->
NodeId
->
UpdateNodeParams
->
UpdateNodeParams
->
(
ScraperStatus
->
m
()
)
->
(
JobLog
->
m
()
)
->
m
ScraperStatus
->
m
JobLog
updateNode
_uId
_nId
_
logStatus
=
do
updateNode
uId
nId
_p
logStatus
=
do
-- Why this does not work ?
-- Why this does not work ?
-- simuLogs logStatus 100
-- simuLogs logStatus 100
logStatus
$
ScraperStatus
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
10
,
_scst_events
=
Just
[]
}
let
let
m
=
(
10
::
Int
)
^
(
6
::
Int
)
m
=
(
10
::
Int
)
^
(
6
::
Int
)
printDebug
"updateNode xxxxxxxxxxxxxxxxxxxx"
nId
--liftBase $ threadDelay ( m * 10)
logStatus
$
JobLog
{
_scst_succeeded
=
Just
3
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
10
,
_scst_events
=
Just
[]
}
{-
status t n = do
status t n = do
_
<-
liftBase
$
threadDelay
(
m
*
100
)
_ <- liftBase $ threadDelay ( m * 100
0
)
let
s
=
ScraperStatus
{
_scst_succeeded
=
Just
n
let s =
JobLog
{ _scst_succeeded = Just n
, _scst_failed = Just 0
, _scst_failed = Just 0
, _scst_remaining = Just (t - n)
, _scst_remaining = Just (t - n)
, _scst_events = Just []
, _scst_events = Just []
}
}
printDebug "status " s
printDebug "status " s
pure s
pure s
-}
s1
<-
status
10
2
printDebug
"updateNode yyyyyyyyyyyyyyyyyyyy"
uId
logStatus
s1
--liftBase $ threadDelay ( m * 10)
logStatus
$
JobLog
{
_scst_succeeded
=
Just
6
s2
<-
status
10
5
,
_scst_failed
=
Just
0
logStatus
s2
,
_scst_remaining
=
Just
4
,
_scst_events
=
Just
[]
s3
<-
status
10
7
}
logStatus
s3
printDebug
"updateNode zzzzzzzzzzzzzzzzzzzz"
nId
status
10
10
liftBase
$
threadDelay
(
m
*
10
)
pure
$
JobLog
{
_scst_succeeded
=
Just
10
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_events
=
Just
[]
}
------------------------------------------------------------------------
------------------------------------------------------------------------
type
API
=
Summary
"
Share Node with username
"
type
API
=
Summary
"
Update node according to NodeType params
"
:>
AsyncJobs
ScraperStatus
'[
J
SON
]
UpdateNodeParams
ScraperStatus
:>
AsyncJobs
JobLog
'[
J
SON
]
UpdateNodeParams
JobLog
src/Gargantext/API/Prelude.hs
View file @
f63b5188
...
@@ -82,7 +82,7 @@ type GargServerC env err m =
...
@@ -82,7 +82,7 @@ type GargServerC env err m =
,
Exception
err
,
Exception
err
,
HasRepo
env
,
HasRepo
env
,
HasSettings
env
,
HasSettings
env
,
HasJobEnv
env
ScraperStatus
ScraperStatus
,
HasJobEnv
env
JobLog
JobLog
)
)
type
GargServerT
env
err
m
api
=
GargServerC
env
err
m
=>
ServerT
api
m
type
GargServerT
env
err
m
api
=
GargServerC
env
err
m
=>
ServerT
api
m
...
@@ -98,7 +98,7 @@ type EnvC env =
...
@@ -98,7 +98,7 @@ type EnvC env =
(
HasConnectionPool
env
(
HasConnectionPool
env
,
HasRepo
env
,
HasRepo
env
,
HasSettings
env
,
HasSettings
env
,
HasJobEnv
env
ScraperStatus
ScraperStatus
,
HasJobEnv
env
JobLog
JobLog
)
)
-------------------------------------------------------------------
-------------------------------------------------------------------
...
@@ -154,12 +154,12 @@ instance HasJoseError GargError where
...
@@ -154,12 +154,12 @@ instance HasJoseError GargError where
-- | Simulate logs
-- | Simulate logs
simuLogs
::
MonadBase
IO
m
simuLogs
::
MonadBase
IO
m
=>
(
ScraperStatus
->
m
()
)
=>
(
JobLog
->
m
()
)
->
Int
->
Int
->
m
ScraperStatus
->
m
JobLog
simuLogs
logStatus
t
=
do
simuLogs
logStatus
t
=
do
{-
{-
let task =
ScraperStatus
{ _scst_succeeded = Just 0
let task =
JobLog
{ _scst_succeeded = Just 0
, _scst_failed = Just 0
, _scst_failed = Just 0
, _scst_remaining = Just 0
, _scst_remaining = Just 0
, _scst_events = Just []
, _scst_events = Just []
...
@@ -167,7 +167,7 @@ simuLogs logStatus t = do
...
@@ -167,7 +167,7 @@ simuLogs logStatus t = do
-}
-}
-- f <- mapM (\status n -> simuTask logStatus status n t) task $ take t [1,2..]
-- f <- mapM (\status n -> simuTask logStatus status n t) task $ take t [1,2..]
_
<-
mapM
(
\
n
->
simuTask'
logStatus
n
t
)
$
take
t
[
1
,
2
..
]
_
<-
mapM
(
\
n
->
simuTask'
logStatus
n
t
)
$
take
t
[
1
,
2
..
]
pure
$
ScraperStatus
{
_scst_succeeded
=
Just
t
pure
$
JobLog
{
_scst_succeeded
=
Just
t
,
_scst_failed
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_events
=
Just
[]
,
_scst_events
=
Just
[]
...
@@ -176,17 +176,17 @@ simuLogs logStatus t = do
...
@@ -176,17 +176,17 @@ simuLogs logStatus t = do
{-
{-
simuTask :: MonadBase IO m
simuTask :: MonadBase IO m
=> (
ScraperStatus
-> m ())
=> (
JobLog
-> m ())
->
ScraperStatus
->
JobLog
-> Int
-> Int
-> Int
-> Int
-> m
ScraperStatus
-> m
JobLog
simuTask logStatus (
ScraperStatus
_s f _r e) n t = do
simuTask logStatus (
JobLog
_s f _r e) n t = do
let
let
m = (10 :: Int) ^ (6 :: Int)
m = (10 :: Int) ^ (6 :: Int)
_ <- liftBase $ threadDelay ( m * 10)
_ <- liftBase $ threadDelay ( m * 10)
let status =
ScraperStatus
{ _scst_succeeded = Just n
let status =
JobLog
{ _scst_succeeded = Just n
, _scst_failed = f
, _scst_failed = f
, _scst_remaining = (-) <$> Just t <*> Just n
, _scst_remaining = (-) <$> Just t <*> Just n
, _scst_events = e
, _scst_events = e
...
@@ -197,7 +197,7 @@ simuTask logStatus (ScraperStatus _s f _r e) n t = do
...
@@ -197,7 +197,7 @@ simuTask logStatus (ScraperStatus _s f _r e) n t = do
-}
-}
simuTask'
::
MonadBase
IO
m
simuTask'
::
MonadBase
IO
m
=>
(
ScraperStatus
->
m
()
)
=>
(
JobLog
->
m
()
)
->
Int
->
Int
->
Int
->
Int
->
m
()
->
m
()
...
@@ -206,7 +206,7 @@ simuTask' logStatus cur total = do
...
@@ -206,7 +206,7 @@ simuTask' logStatus cur total = do
m
=
(
10
::
Int
)
^
(
6
::
Int
)
m
=
(
10
::
Int
)
^
(
6
::
Int
)
_
<-
liftBase
$
threadDelay
(
m
*
10
)
_
<-
liftBase
$
threadDelay
(
m
*
10
)
let
status
=
ScraperStatus
{
_scst_succeeded
=
Just
cur
let
status
=
JobLog
{
_scst_succeeded
=
Just
cur
,
_scst_failed
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
(
-
)
<$>
Just
total
<*>
Just
cur
,
_scst_remaining
=
(
-
)
<$>
Just
total
<*>
Just
cur
,
_scst_events
=
Just
[]
,
_scst_events
=
Just
[]
...
...
src/Gargantext/Viz/Graph/API.hs
View file @
f63b5188
...
@@ -155,7 +155,7 @@ computeGraph cId nt repo = do
...
@@ -155,7 +155,7 @@ computeGraph cId nt repo = do
------------------------------------------------------------
------------------------------------------------------------
type
GraphAsyncAPI
=
Summary
"Update graph"
type
GraphAsyncAPI
=
Summary
"Update graph"
:>
"async"
:>
"async"
:>
AsyncJobsAPI
ScraperStatus
()
ScraperStatus
:>
AsyncJobsAPI
JobLog
()
JobLog
graphAsync
::
UserId
->
NodeId
->
GargServer
GraphAsyncAPI
graphAsync
::
UserId
->
NodeId
->
GargServer
GraphAsyncAPI
...
@@ -166,16 +166,16 @@ graphAsync u n =
...
@@ -166,16 +166,16 @@ graphAsync u n =
graphAsync'
::
UserId
graphAsync'
::
UserId
->
NodeId
->
NodeId
->
(
ScraperStatus
->
GargNoServer
()
)
->
(
JobLog
->
GargNoServer
()
)
->
GargNoServer
ScraperStatus
->
GargNoServer
JobLog
graphAsync'
u
n
logStatus
=
do
graphAsync'
u
n
logStatus
=
do
logStatus
ScraperStatus
{
_scst_succeeded
=
Just
0
logStatus
JobLog
{
_scst_succeeded
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
1
,
_scst_remaining
=
Just
1
,
_scst_events
=
Just
[]
,
_scst_events
=
Just
[]
}
}
_g
<-
trace
(
show
u
)
$
recomputeGraph
u
n
_g
<-
trace
(
show
u
)
$
recomputeGraph
u
n
pure
ScraperStatus
{
_scst_succeeded
=
Just
1
pure
JobLog
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_events
=
Just
[]
,
_scst_events
=
Just
[]
...
...
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