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
1ba814c7
Commit
1ba814c7
authored
Nov 17, 2021
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[GraphQL] implement joblog query
parent
8430a0ea
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
29 additions
and
10 deletions
+29
-10
GraphQL.hs
src/Gargantext/API/GraphQL.hs
+2
-1
AsyncTask.hs
src/Gargantext/API/GraphQL/AsyncTask.hs
+27
-9
No files found.
src/Gargantext/API/GraphQL.hs
View file @
1ba814c7
...
...
@@ -10,6 +10,7 @@ import Data.ByteString.Lazy.Char8
(
ByteString
)
import
Data.List.NonEmpty
(
NonEmpty
((
:|
)))
import
Data.Map
(
Map
)
import
Data.Morpheus
(
App
,
deriveApp
)
...
...
@@ -59,7 +60,7 @@ import qualified Servant.Auth.Server as SAS
-- | Represents possible GraphQL queries.
data
Query
m
=
Query
{
job_logs
::
GQLAT
.
JobLogArgs
->
m
[
JobLog
]
{
job_logs
::
GQLAT
.
JobLogArgs
->
m
(
Map
Int
JobLog
)
,
nodes
::
GQLNode
.
NodeArgs
->
m
[
GQLNode
.
Node
]
,
node_parent
::
GQLNode
.
NodeParentArgs
->
m
[
GQLNode
.
Node
]
,
user_infos
::
GQLUserInfo
.
UserInfoArgs
->
m
[
GQLUserInfo
.
UserInfo
]
...
...
src/Gargantext/API/GraphQL/AsyncTask.hs
View file @
1ba814c7
...
...
@@ -4,10 +4,16 @@
module
Gargantext.API.GraphQL.AsyncTask
where
import
Control.Concurrent.Async
(
poll
)
import
Control.Concurrent.MVar
(
readMVar
)
import
Control.Lens
import
Data.Map
(
Map
)
import
qualified
Data.Map
as
Map
import
Control.Monad.Base
(
liftBase
)
import
Control.Monad.Reader
(
ask
,
liftIO
)
import
Data.Either
(
Either
(
..
))
import
qualified
Data.IntMap.Strict
as
IntMap
import
Data.Maybe
(
Maybe
(
..
),
catMaybes
)
import
Data.Morpheus.Types
(
GQLType
,
Resolver
...
...
@@ -24,8 +30,8 @@ import Gargantext.Database.Admin.Types.Node (NodeId(..))
import
Gargantext.Database.Prelude
(
HasConnectionPool
,
HasConfig
)
import
Gargantext.Prelude
import
GHC.Generics
(
Generic
)
import
Servant.Job.Async
(
HasJobEnv
(
job_env
),
jenv_jobs
)
import
Servant.Job.Core
(
env_map
,
env_state_mvar
)
import
Servant.Job.Async
(
HasJobEnv
(
job_env
),
jenv_jobs
,
job_async
)
import
Servant.Job.Core
(
env_
item
,
env_
map
,
env_state_mvar
)
data
JobLogArgs
=
JobLogArgs
...
...
@@ -36,18 +42,30 @@ type GqlM e env = Resolver QUERY e (GargM env GargError)
resolveJobLogs
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasJobEnv'
env
)
=>
JobLogArgs
->
GqlM
e
env
[
JobLog
]
=>
JobLogArgs
->
GqlM
e
env
(
Map
Int
JobLog
)
resolveJobLogs
JobLogArgs
{
job_log_id
}
=
dbJobLogs
job_log_id
dbJobLogs
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasJobEnv'
env
)
=>
Int
->
GqlM
e
env
[
JobLog
]
=>
Int
->
GqlM
e
env
(
Map
Int
JobLog
)
dbJobLogs
job_log_id
=
do
--getJobLogs job_log_id
env
<-
ask
_
<-
lift
$
do
lift
$
do
env
<-
ask
--val <- liftBase $ readMVar $ env ^. job_env . jenv_jobs . env_state_mvar
let
val
=
env
printDebug
"[dbJobLogs] env ^. job_env ^. jenv_jobs"
val
var
<-
liftIO
$
readMVar
(
env
^.
job_env
.
jenv_jobs
.
env_state_mvar
)
let
envItems
=
var
^.
env_map
printDebug
"[dbJobLogs] env ^. job_env ^. jenv_jobs"
$
length
$
IntMap
.
keys
envItems
printDebug
"[dbJobLogs] job_log_id"
job_log_id
pure
[]
--pure $ IntMap.elems val
liftIO
$
do
let
jobsList
=
IntMap
.
toList
$
IntMap
.
map
(
\
e
->
e
^.
env_item
.
job_async
)
envItems
results
<-
mapM
(
\
(
k
,
v
)
->
do
p
<-
poll
v
let
kv
=
case
p
of
Nothing
->
Nothing
Just
p'
->
case
p'
of
Left
_
->
Nothing
Right
p''
->
Just
(
k
,
p''
)
pure
kv
)
jobsList
pure
$
Map
.
fromList
$
catMaybes
results
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