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
142
Issues
142
List
Board
Labels
Milestones
Merge Requests
7
Merge Requests
7
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
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
Pipeline
#892
canceled with stage
Changes
11
Pipelines
2
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
import
Control.Lens
hiding
(
elements
)
import
Data.Aeson
import
qualified
Data.ByteString.Lazy.Char8
as
LBS
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.Job.Async
import
Servant.Job.Client
import
Servant.Job.Server
import
Servant.Job.Utils
(
extendBaseUrl
)
import
Gargantext.Prelude
import
Gargantext.API.Admin.Settings
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Admin.Orchestrator.Scrapy.Schedule
import
qualified
Data.ByteString.Lazy.Char8
as
LBS
callJobScrapy
::
(
ToJSON
e
,
FromJSON
e
,
FromJSON
o
,
MonadClientJob
m
)
=>
JobServerURL
e
Schedule
o
...
...
@@ -44,7 +43,7 @@ callJobScrapy jurl schedule = do
logConsole
::
ToJSON
a
=>
a
->
IO
()
logConsole
=
LBS
.
putStrLn
.
encode
callScraper
::
MonadClientJob
m
=>
URL
->
ScraperInput
->
m
ScraperStatus
callScraper
::
MonadClientJob
m
=>
URL
->
ScraperInput
->
m
JobLog
callScraper
url
input
=
callJobScrapy
jurl
$
\
cb
->
Schedule
...
...
@@ -64,11 +63,11 @@ callScraper url input =
,(
"callback"
,
[
toUrlPiece
cb
])]
}
where
jurl
::
JobServerURL
ScraperStatus
Schedule
ScraperStatus
jurl
::
JobServerURL
JobLog
Schedule
JobLog
jurl
=
JobServerURL
url
Callback
pipeline
::
FromJSON
e
=>
URL
->
ClientEnv
->
ScraperInput
->
(
e
->
IO
()
)
->
IO
ScraperStatus
->
(
e
->
IO
()
)
->
IO
JobLog
pipeline
scrapyurl
client_env
input
log_status
=
do
e
<-
runJobMLog
client_env
log_status
$
callScraper
scrapyurl
input
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)
import
Test.QuickCheck.Arbitrary
------------------------------------------------------------------------
instance
Arbitrary
a
=>
Arbitrary
(
JobStatus
'S
a
fe
a
)
where
arbitrary
=
panic
"TODO"
...
...
@@ -90,7 +89,9 @@ instance ToJSON ScraperEvent where
instance
FromJSON
ScraperEvent
where
parseJSON
=
genericParseJSON
$
jsonOptions
"_scev_"
data
ScraperStatus
=
ScraperStatus
data
JobLog
=
JobLog
{
_scst_succeeded
::
!
(
Maybe
Int
)
,
_scst_failed
::
!
(
Maybe
Int
)
,
_scst_remaining
::
!
(
Maybe
Int
)
...
...
@@ -98,20 +99,20 @@ data ScraperStatus = ScraperStatus
}
deriving
(
Show
,
Generic
)
instance
Arbitrary
ScraperStatus
where
arbitrary
=
ScraperStatus
instance
Arbitrary
JobLog
where
arbitrary
=
JobLog
<$>
arbitrary
<*>
arbitrary
<*>
arbitrary
<*>
arbitrary
instance
ToJSON
ScraperStatus
where
instance
ToJSON
JobLog
where
toJSON
=
genericToJSON
$
jsonOptions
"_scst_"
instance
FromJSON
ScraperStatus
where
instance
FromJSON
JobLog
where
parseJSON
=
genericParseJSON
$
jsonOptions
"_scst_"
instance
ToSchema
ScraperStatus
-- TODO _scst_ prefix
instance
ToSchema
JobLog
-- TODO _scst_ prefix
instance
ToSchema
ScraperInput
-- TODO _scin_ prefix
instance
ToSchema
ScraperEvent
-- TODO _scev_ prefix
...
...
@@ -122,6 +123,6 @@ instance ToParamSchema Offset -- where
instance
ToParamSchema
Limit
-- where
-- 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
instance
HasSettings
Env
where
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
instance
HasJobEnv
Env
ScraperStatus
ScraperStatus
where
instance
HasJobEnv
Env
JobLog
JobLog
where
job_env
=
env_scrapers
data
MockEnv
=
MockEnv
...
...
src/Gargantext/API/Ngrams/List.hs
View file @
f63b5188
...
...
@@ -93,7 +93,7 @@ type PostAPI = Summary "Update List"
:>
"add"
:>
"form"
:>
"async"
:>
AsyncJobs
ScraperStatus
'[
F
ormUrlEncoded
]
WithFile
ScraperStatus
:>
AsyncJobs
JobLog
'[
F
ormUrlEncoded
]
WithFile
JobLog
postAsync
::
ListId
->
GargServer
PostAPI
postAsync
lId
=
...
...
@@ -103,18 +103,18 @@ postAsync lId =
postAsync'
::
FlowCmdM
env
err
m
=>
ListId
->
WithFile
->
(
ScraperStatus
->
m
()
)
->
m
ScraperStatus
->
(
JobLog
->
m
()
)
->
m
JobLog
postAsync'
l
(
WithFile
_
m
_
)
logStatus
=
do
logStatus
ScraperStatus
{
_scst_succeeded
=
Just
0
logStatus
JobLog
{
_scst_succeeded
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
1
,
_scst_events
=
Just
[]
}
_r
<-
post
l
m
pure
ScraperStatus
{
_scst_succeeded
=
Just
1
pure
JobLog
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
0
,
_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)
->
Cmd
err
Int
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"
:>
"add"
:>
"form"
:>
"async"
:>
AsyncJobs
ScraperStatus
'[
F
ormUrlEncoded
]
AnnuaireWithForm
ScraperStatus
:>
AsyncJobs
JobLog
'[
F
ormUrlEncoded
]
AnnuaireWithForm
JobLog
------------------------------------------------------------------------
addToAnnuaireWithForm
::
FlowCmdM
env
err
m
=>
AnnuaireId
->
AnnuaireWithForm
->
(
ScraperStatus
->
m
()
)
->
m
ScraperStatus
->
(
JobLog
->
m
()
)
->
m
JobLog
addToAnnuaireWithForm
_cid
(
AnnuaireWithForm
ft
_d
_l
)
logStatus
=
do
printDebug
"ft"
ft
...
...
@@ -86,7 +86,7 @@ addToAnnuaireWithForm _cid (AnnuaireWithForm ft _d _l) logStatus = do
-- <$> take 1000000
-- <$> parse (cs d)
logStatus
ScraperStatus
{
_scst_succeeded
=
Just
1
logStatus
JobLog
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
1
,
_scst_events
=
Just
[]
...
...
@@ -98,7 +98,7 @@ addToAnnuaireWithForm _cid (AnnuaireWithForm ft _d _l) logStatus = do
-- printDebug "cid'" cid'
pure
ScraperStatus
{
_scst_succeeded
=
Just
2
pure
JobLog
{
_scst_succeeded
=
Just
2
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_events
=
Just
[]
...
...
src/Gargantext/API/Node/Corpus/New.hs
View file @
f63b5188
...
...
@@ -27,7 +27,7 @@ import Data.Maybe (fromMaybe)
import
Data.Swagger
import
Data.Text
(
Text
)
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
Gargantext.API.Node.Corpus.New.File
import
Gargantext.Core
(
Lang
(
..
)
{-, allLangs-}
)
...
...
@@ -173,7 +173,7 @@ type AddWithQuery = Summary "Add with Query to corpus endpoint"
:>
"corpus"
:>
Capture
"corpus_id"
CorpusId
:>
"query"
:>
AsyncJobs
ScraperStatus
'[
J
SON
]
WithQuery
ScraperStatus
:>
AsyncJobs
JobLog
'[
J
SON
]
WithQuery
JobLog
{-
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)
:> QueryParam "fileType" FileType
:> "async"
:> AsyncJobs
ScraperStatus '[JSON] () ScraperStatus
:> AsyncJobs
JobLog '[JSON] () JobLog
-}
type
AddWithForm
=
Summary
"Add with FormUrlEncoded to corpus endpoint"
...
...
@@ -193,7 +193,7 @@ type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint"
:>
"add"
:>
"form"
:>
"async"
:>
AsyncJobs
ScraperStatus
'[
F
ormUrlEncoded
]
NewWithForm
ScraperStatus
:>
AsyncJobs
JobLog
'[
F
ormUrlEncoded
]
NewWithForm
JobLog
------------------------------------------------------------------------
...
...
@@ -202,13 +202,13 @@ addToCorpusWithQuery :: FlowCmdM env err m
=>
User
->
CorpusId
->
WithQuery
->
(
ScraperStatus
->
m
()
)
->
m
ScraperStatus
->
(
JobLog
->
m
()
)
->
m
JobLog
addToCorpusWithQuery
u
cid
(
WithQuery
q
dbs
l
_nid
)
logStatus
=
do
-- TODO ...
logStatus
ScraperStatus
{
_scst_succeeded
=
Just
1
0
,
_scst_failed
=
Just
2
,
_scst_remaining
=
Just
138
logStatus
JobLog
{
_scst_succeeded
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
5
,
_scst_events
=
Just
[]
}
printDebug
"addToCorpusWithQuery"
cid
...
...
@@ -217,11 +217,18 @@ addToCorpusWithQuery u cid (WithQuery q dbs l _nid) logStatus = do
-- if cid is corpus -> add to corpus
-- if cid is root -> create corpus in Private
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
printDebug
"corpus id"
cids
-- TODO ...
pure
ScraperStatus
{
_scst_succeeded
=
Just
137
,
_scst_failed
=
Just
13
pure
JobLog
{
_scst_succeeded
=
Just
3
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_events
=
Just
[]
}
...
...
@@ -230,10 +237,16 @@ addToCorpusWithForm :: FlowCmdM env err m
=>
User
->
CorpusId
->
NewWithForm
->
(
ScraperStatus
->
m
()
)
->
m
ScraperStatus
->
(
JobLog
->
m
()
)
->
m
JobLog
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
parse
=
case
ft
of
CSV_HAL
->
Parser
.
parseFormat
Parser
.
CsvHal
...
...
@@ -241,22 +254,20 @@ addToCorpusWithForm user cid (NewWithForm ft d l _n) logStatus = do
WOS
->
Parser
.
parseFormat
Parser
.
WOS
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
docs
<-
liftBase
$
splitEvery
500
<$>
take
1000000
<$>
parse
(
cs
d
)
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
_cid'
<-
flowCorpus
user
(
Right
[
cid
])
...
...
@@ -264,8 +275,7 @@ addToCorpusWithForm user cid (NewWithForm ft d l _n) logStatus = do
(
map
(
map
toHyperdataDocument
)
docs
)
printDebug
"Extraction finished : "
cid
pure
ScraperStatus
{
_scst_succeeded
=
Just
2
pure
JobLog
{
_scst_succeeded
=
Just
2
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_events
=
Just
[]
...
...
@@ -276,10 +286,10 @@ addToCorpusWithFile :: FlowCmdM env err m
=> CorpusId
-> MultipartData Mem
-> Maybe FileType
-> (
ScraperStatus
-> m ())
-> m
ScraperStatus
-> (
JobLog
-> m ())
-> m
JobLog
addToCorpusWithFile cid input filetype logStatus = do
logStatus
ScraperStatus
{ _scst_succeeded = Just 10
logStatus
JobLog
{ _scst_succeeded = Just 10
, _scst_failed = Just 2
, _scst_remaining = Just 138
, _scst_events = Just []
...
...
@@ -287,7 +297,7 @@ addToCorpusWithFile cid input filetype logStatus = do
printDebug "addToCorpusWithFile" cid
_h <- postUpload cid filetype input
pure
ScraperStatus
{ _scst_succeeded = Just 137
pure
JobLog
{ _scst_succeeded = Just 137
, _scst_failed = Just 13
, _scst_remaining = Just 0
, _scst_events = Just []
...
...
src/Gargantext/API/Node/New.hs
View file @
f63b5188
...
...
@@ -24,7 +24,7 @@ import Data.Aeson
import
Data.Swagger
import
Data.Text
(
Text
)
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.Prelude
import
Gargantext.Database.Action.Flow.Types
...
...
@@ -68,7 +68,7 @@ postNode uId pId (PostNode nodeName nt) = do
------------------------------------------------------------------------
type
PostNodeAsync
=
Summary
"Post Node"
:>
"async"
:>
AsyncJobs
ScraperStatus
'[
F
ormUrlEncoded
]
PostNode
ScraperStatus
:>
AsyncJobs
JobLog
'[
F
ormUrlEncoded
]
PostNode
JobLog
postNodeAsyncAPI
::
UserId
->
NodeId
->
GargServer
PostNodeAsync
...
...
@@ -81,12 +81,12 @@ postNodeAsync :: FlowCmdM env err m
=>
UserId
->
NodeId
->
PostNode
->
(
ScraperStatus
->
m
()
)
->
m
ScraperStatus
->
(
JobLog
->
m
()
)
->
m
JobLog
postNodeAsync
uId
nId
(
PostNode
nodeName
tn
)
logStatus
=
do
printDebug
"postNodeAsync"
nId
logStatus
ScraperStatus
{
_scst_succeeded
=
Just
1
logStatus
JobLog
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
2
,
_scst_events
=
Just
[]
...
...
@@ -95,7 +95,7 @@ postNodeAsync uId nId (PostNode nodeName tn) logStatus = do
nodeUser
<-
getNodeUser
(
NodeId
uId
)
-- _ <- threadDelay 1000
logStatus
ScraperStatus
{
_scst_succeeded
=
Just
1
logStatus
JobLog
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
2
,
_scst_events
=
Just
[]
...
...
@@ -104,7 +104,7 @@ postNodeAsync uId nId (PostNode nodeName tn) logStatus = do
let
uId'
=
nodeUser
^.
node_userId
_
<-
mkNodeWithParent
tn
(
Just
nId
)
uId'
nodeName
pure
ScraperStatus
{
_scst_succeeded
=
Just
3
pure
JobLog
{
_scst_succeeded
=
Just
3
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_events
=
Just
[]
...
...
src/Gargantext/API/Node/Update.hs
View file @
f63b5188
...
...
@@ -19,12 +19,12 @@ module Gargantext.API.Node.Update
import
Data.Aeson
import
Data.Swagger
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.Prelude
(
GargServer
{-, simuLogs-}
)
import
Gargantext.Database.Action.Flow.Types
(
FlowCmdM
)
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
Servant
import
Servant.Job.Async
(
JobFunction
(
..
),
serveJobsAPI
)
...
...
@@ -97,57 +97,68 @@ instance Arbitrary Charts where
arbitrary
=
elements
[
minBound
..
maxBound
]
------------------------------------------------------------------------
api
::
UserId
->
NodeId
->
GargServer
API
api
uId
nId
=
serveJobsAPI
$
JobFunction
(
\
p
logs
->
updateNode
uId
nId
p
(
liftBase
.
logs
))
serveJobsAPI
$
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
=>
UserId
->
NodeId
->
UpdateNodeParams
->
(
ScraperStatus
->
m
()
)
->
m
ScraperStatus
updateNode
_uId
_nId
_
logStatus
=
do
->
(
JobLog
->
m
()
)
->
m
JobLog
updateNode
uId
nId
_p
logStatus
=
do
-- Why this does not work ?
-- simuLogs logStatus 100
logStatus
$
ScraperStatus
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
10
,
_scst_events
=
Just
[]
}
let
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
_
<-
liftBase
$
threadDelay
(
m
*
100
)
let
s
=
ScraperStatus
{
_scst_succeeded
=
Just
n
_ <- liftBase $ threadDelay ( m * 100
0
)
let s =
JobLog
{ _scst_succeeded = Just n
, _scst_failed = Just 0
, _scst_remaining = Just (t - n)
, _scst_events = Just []
}
printDebug "status " s
pure s
-}
s1
<-
status
10
2
logStatus
s1
s2
<-
status
10
5
logStatus
s2
s3
<-
status
10
7
logStatus
s3
status
10
10
printDebug
"updateNode yyyyyyyyyyyyyyyyyyyy"
uId
--liftBase $ threadDelay ( m * 10)
logStatus
$
JobLog
{
_scst_succeeded
=
Just
6
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
4
,
_scst_events
=
Just
[]
}
printDebug
"updateNode zzzzzzzzzzzzzzzzzzzz"
nId
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
"
:>
AsyncJobs
ScraperStatus
'[
J
SON
]
UpdateNodeParams
ScraperStatus
type
API
=
Summary
"
Update node according to NodeType params
"
:>
AsyncJobs
JobLog
'[
J
SON
]
UpdateNodeParams
JobLog
src/Gargantext/API/Prelude.hs
View file @
f63b5188
...
...
@@ -82,7 +82,7 @@ type GargServerC env err m =
,
Exception
err
,
HasRepo
env
,
HasSettings
env
,
HasJobEnv
env
ScraperStatus
ScraperStatus
,
HasJobEnv
env
JobLog
JobLog
)
type
GargServerT
env
err
m
api
=
GargServerC
env
err
m
=>
ServerT
api
m
...
...
@@ -98,7 +98,7 @@ type EnvC env =
(
HasConnectionPool
env
,
HasRepo
env
,
HasSettings
env
,
HasJobEnv
env
ScraperStatus
ScraperStatus
,
HasJobEnv
env
JobLog
JobLog
)
-------------------------------------------------------------------
...
...
@@ -154,12 +154,12 @@ instance HasJoseError GargError where
-- | Simulate logs
simuLogs
::
MonadBase
IO
m
=>
(
ScraperStatus
->
m
()
)
=>
(
JobLog
->
m
()
)
->
Int
->
m
ScraperStatus
->
m
JobLog
simuLogs
logStatus
t
=
do
{-
let task =
ScraperStatus
{ _scst_succeeded = Just 0
let task =
JobLog
{ _scst_succeeded = Just 0
, _scst_failed = Just 0
, _scst_remaining = Just 0
, _scst_events = Just []
...
...
@@ -167,7 +167,7 @@ simuLogs logStatus t = do
-}
-- f <- mapM (\status n -> simuTask logStatus status n t) task $ 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_remaining
=
Just
0
,
_scst_events
=
Just
[]
...
...
@@ -176,17 +176,17 @@ simuLogs logStatus t = do
{-
simuTask :: MonadBase IO m
=> (
ScraperStatus
-> m ())
->
ScraperStatus
=> (
JobLog
-> m ())
->
JobLog
-> Int
-> Int
-> m
ScraperStatus
simuTask logStatus (
ScraperStatus
_s f _r e) n t = do
-> m
JobLog
simuTask logStatus (
JobLog
_s f _r e) n t = do
let
m = (10 :: Int) ^ (6 :: Int)
_ <- liftBase $ threadDelay ( m * 10)
let status =
ScraperStatus
{ _scst_succeeded = Just n
let status =
JobLog
{ _scst_succeeded = Just n
, _scst_failed = f
, _scst_remaining = (-) <$> Just t <*> Just n
, _scst_events = e
...
...
@@ -197,7 +197,7 @@ simuTask logStatus (ScraperStatus _s f _r e) n t = do
-}
simuTask'
::
MonadBase
IO
m
=>
(
ScraperStatus
->
m
()
)
=>
(
JobLog
->
m
()
)
->
Int
->
Int
->
m
()
...
...
@@ -206,7 +206,7 @@ simuTask' logStatus cur total = do
m
=
(
10
::
Int
)
^
(
6
::
Int
)
_
<-
liftBase
$
threadDelay
(
m
*
10
)
let
status
=
ScraperStatus
{
_scst_succeeded
=
Just
cur
let
status
=
JobLog
{
_scst_succeeded
=
Just
cur
,
_scst_failed
=
Just
0
,
_scst_remaining
=
(
-
)
<$>
Just
total
<*>
Just
cur
,
_scst_events
=
Just
[]
...
...
src/Gargantext/Viz/Graph/API.hs
View file @
f63b5188
...
...
@@ -155,7 +155,7 @@ computeGraph cId nt repo = do
------------------------------------------------------------
type
GraphAsyncAPI
=
Summary
"Update graph"
:>
"async"
:>
AsyncJobsAPI
ScraperStatus
()
ScraperStatus
:>
AsyncJobsAPI
JobLog
()
JobLog
graphAsync
::
UserId
->
NodeId
->
GargServer
GraphAsyncAPI
...
...
@@ -166,16 +166,16 @@ graphAsync u n =
graphAsync'
::
UserId
->
NodeId
->
(
ScraperStatus
->
GargNoServer
()
)
->
GargNoServer
ScraperStatus
->
(
JobLog
->
GargNoServer
()
)
->
GargNoServer
JobLog
graphAsync'
u
n
logStatus
=
do
logStatus
ScraperStatus
{
_scst_succeeded
=
Just
0
logStatus
JobLog
{
_scst_succeeded
=
Just
0
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
1
,
_scst_events
=
Just
[]
}
_g
<-
trace
(
show
u
)
$
recomputeGraph
u
n
pure
ScraperStatus
{
_scst_succeeded
=
Just
1
pure
JobLog
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
0
,
_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