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
a2024298
Commit
a2024298
authored
Jul 29, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[API] Link Corpus -> Annuaire. Ok
parent
02ebf2fb
Changes
1
Show whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
27 additions
and
6 deletions
+27
-6
Update.hs
src/Gargantext/API/Node/Update.hs
+27
-6
No files found.
src/Gargantext/API/Node/Update.hs
View file @
a2024298
...
@@ -17,18 +17,20 @@ module Gargantext.API.Node.Update
...
@@ -17,18 +17,20 @@ module Gargantext.API.Node.Update
where
where
import
Data.Aeson
import
Data.Aeson
import
Data.Maybe
(
Maybe
(
..
))
import
Data.Swagger
import
Data.Swagger
import
GHC.Generics
(
Generic
)
import
GHC.Generics
(
Generic
)
import
Data.Maybe
(
Maybe
(
..
))
import
Gargantext.Prelude
import
Gargantext.API.Admin.Settings
(
HasSettings
)
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
(
..
))
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
(
..
))
import
Gargantext.API.Admin.Settings
(
HasSettings
)
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.Viz.Graph.Distances
(
GraphMetric
(
..
),
Distance
(
..
))
import
Gargantext.Database.Action.Flow.Pairing
(
pairing
)
import
Gargantext.Viz.Graph.API
(
recomputeGraph
)
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
,
(
.
),
printDebug
,
pure
)
import
Gargantext.Prelude
(
Ord
,
Eq
,
(
<$>
),
(
$
),
liftBase
,
(
.
),
printDebug
,
pure
)
import
Gargantext.Viz.Graph.API
(
recomputeGraph
)
import
Gargantext.Viz.Graph.Distances
(
GraphMetric
(
..
),
Distance
(
..
))
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
)
...
@@ -45,6 +47,7 @@ data UpdateNodeParams = UpdateNodeParamsList { methodList :: !Method }
...
@@ -45,6 +47,7 @@ data UpdateNodeParams = UpdateNodeParamsList { methodList :: !Method }
|
UpdateNodeParamsGraph
{
methodGraph
::
!
GraphMetric
}
|
UpdateNodeParamsGraph
{
methodGraph
::
!
GraphMetric
}
|
UpdateNodeParamsTexts
{
methodTexts
::
!
Granularity
}
|
UpdateNodeParamsTexts
{
methodTexts
::
!
Granularity
}
|
UpdateNodeParamsBoard
{
methodBoard
::
!
Charts
}
|
UpdateNodeParamsBoard
{
methodBoard
::
!
Charts
}
|
LinkNodeReq
{
nodeType
::
!
NodeType
,
id
::
!
NodeId
}
deriving
(
Generic
)
deriving
(
Generic
)
----------------------------------------------------------------------
----------------------------------------------------------------------
...
@@ -63,11 +66,11 @@ data Charts = Sources | Authors | Institutes | Ngrams | All
...
@@ -63,11 +66,11 @@ data Charts = Sources | Authors | Institutes | Ngrams | All
api
::
UserId
->
NodeId
->
GargServer
API
api
::
UserId
->
NodeId
->
GargServer
API
api
uId
nId
=
api
uId
nId
=
serveJobsAPI
$
serveJobsAPI
$
JobFunction
(
\
p
log
->
JobFunction
(
\
p
log
''
->
let
let
log'
x
=
do
log'
x
=
do
printDebug
"updateNode"
x
printDebug
"updateNode"
x
liftBase
$
log
x
liftBase
$
log
''
x
in
updateNode
uId
nId
p
(
liftBase
.
log'
)
in
updateNode
uId
nId
p
(
liftBase
.
log'
)
)
)
...
@@ -95,6 +98,24 @@ updateNode uId nId (UpdateNodeParamsGraph metric) logStatus = do
...
@@ -95,6 +98,24 @@ updateNode uId nId (UpdateNodeParamsGraph metric) logStatus = do
,
_scst_events
=
Just
[]
,
_scst_events
=
Just
[]
}
}
updateNode
_uId
nid1
(
LinkNodeReq
nt
nid2
)
logStatus
=
do
logStatus
JobLog
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
1
,
_scst_events
=
Just
[]
}
_
<-
case
nt
of
NodeAnnuaire
->
pairing
nid2
nid1
Nothing
-- defaultList
NodeCorpus
->
pairing
nid1
nid2
Nothing
-- defaultList
_
->
panic
$
"[G.API.N.Update.updateNode] NodeType not implemented"
<>
cs
(
show
nt
)
pure
JobLog
{
_scst_succeeded
=
Just
2
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_events
=
Just
[]
}
updateNode
_uId
_nId
_p
logStatus
=
do
updateNode
_uId
_nId
_p
logStatus
=
do
simuLogs
logStatus
10
simuLogs
logStatus
10
...
...
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