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
Julien Moutinho
haskell-gargantext
Commits
ad208ffc
Commit
ad208ffc
authored
May 20, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FIX] Multiple graph fixed, needs cleaning and refactoring
parent
7bc490a3
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
22 additions
and
41 deletions
+22
-41
API.hs
src/Gargantext/Viz/Graph/API.hs
+22
-41
No files found.
src/Gargantext/Viz/Graph/API.hs
View file @
ad208ffc
...
...
@@ -27,47 +27,43 @@ module Gargantext.Viz.Graph.API
import
Control.Lens
(
set
,
(
^.
),
_Just
,
(
^?
))
import
Data.Aeson
import
Debug.Trace
(
trace
)
import
qualified
Data.Map
as
Map
import
Data.Maybe
(
Maybe
(
..
))
import
Data.Swagger
import
Data.Text
import
Debug.Trace
(
trace
)
import
GHC.Generics
(
Generic
)
import
Servant
import
Servant.XML
import
Servant.Job.Async
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Ngrams
(
NgramsRepo
,
r_version
)
import
Gargantext.API.Ngrams.Tools
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Prelude
import
Gargantext.Core.Types.Main
import
Gargantext.Database.Admin.Config
import
Gargantext.Database.Action.Metrics.NgramsByNode
(
getNodesByNgramsOnlyUser
)
import
Gargantext.Database.
Schema.Node
(
node_userId
,
node_parentId
,
node_hyperdata
)
import
Gargantext.Database.
Schema.Ngrams
import
Gargantext.Database.
Query.Table.Node.Select
import
Gargantext.Database.
Admin.Config
import
Gargantext.Database.
Admin.Types.Node
import
Gargantext.Database.
Prelude
(
Cmd
)
import
Gargantext.Database.Query.Table.Node
import
Gargantext.Database.Query.Table.Node.User
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.
Admin.Types.Node
import
Gargantext.Database.
Query.Table.Node.Select
import
Gargantext.Database.Query.Table.Node.UpdateOpaleye
(
updateHyperdata
)
import
Gargantext.Database.Prelude
(
Cmd
)
import
Gargantext.Database.Schema.Ngrams
import
Gargantext.Database.Schema.Node
(
node_parentId
,
node_hyperdata
)
import
Gargantext.Prelude
import
Gargantext.Viz.Graph
import
Gargantext.Viz.Graph.Tools
-- (cooc2graph)
import
Gargantext.Viz.Graph.GEXF
()
import
Gargantext.Viz.Graph.Tools
-- (cooc2graph)
import
Servant
import
Servant.Job.Async
import
Servant.XML
import
qualified
Data.Map
as
Map
------------------------------------------------------------------------
-- | There is no Delete specific API for Graph since it can be deleted
-- as simple Node.
type
GraphAPI
=
Get
'[
J
SON
]
Graph
:<|>
Post
'[
J
SON
]
[
GraphId
]
:<|>
Put
'[
J
SON
]
Int
:<|>
"gexf"
:>
Get
'[
X
ML
]
(
Headers
'[
S
ervant
.
Header
"Content-Disposition"
Text
]
Graph
)
:<|>
GraphAsyncAPI
:<|>
"versions"
:>
GraphVersionsAPI
data
GraphVersions
=
GraphVersions
{
gv_graph
::
Maybe
Int
,
gv_repo
::
Int
}
...
...
@@ -78,16 +74,13 @@ instance ToSchema GraphVersions
graphAPI
::
UserId
->
NodeId
->
GargServer
GraphAPI
graphAPI
u
n
=
getGraph
u
n
:<|>
postGraph
n
:<|>
putGraph
n
:<|>
getGraphGexf
u
n
:<|>
graphAsync
u
n
:<|>
graphVersionsAPI
u
n
------------------------------------------------------------------------
getGraph
::
UserId
->
NodeId
->
GargNoServer
Graph
getGraph
uId
nId
=
do
getGraph
_
uId
nId
=
do
nodeGraph
<-
getNodeWith
nId
HyperdataGraph
let
graph
=
nodeGraph
^.
node_hyperdata
.
hyperdataGraph
-- let listVersion = graph ^? _Just
...
...
@@ -98,9 +91,8 @@ getGraph uId nId = do
repo
<-
getRepo
-- let v = repo ^. r_version
nodeUser
<-
getNodeUser
(
NodeId
uId
)
let
uId'
=
nodeUser
^.
node_userId
-- nodeUser <- getNodeUser (NodeId uId)
-- let uId' = nodeUser ^. node_userId
let
cId
=
maybe
(
panic
"[ERR:G.V.G.API] Node has no parent"
)
identity
...
...
@@ -109,7 +101,7 @@ getGraph uId nId = do
g
<-
case
graph
of
Nothing
->
do
graph'
<-
computeGraph
cId
NgramsTerms
repo
_
<-
insertGraph
cId
uId'
(
HyperdataGraph
$
Just
graph'
)
_
<-
updateHyperdata
nId
(
HyperdataGraph
$
Just
graph'
)
pure
$
trace
"Graph empty, computing"
$
graph'
Just
graph'
->
pure
$
trace
"Graph exists, returning"
$
graph'
...
...
@@ -120,12 +112,11 @@ getGraph uId nId = do
-- graph'' <- computeGraph cId NgramsTerms repo
-- _ <- updateHyperdata nId (HyperdataGraph $ Just graph'')
-- pure graph''
pure
g
recomputeGraph
::
UserId
->
NodeId
->
GargNoServer
Graph
recomputeGraph
uId
nId
=
do
recomputeGraph
_
uId
nId
=
do
nodeGraph
<-
getNodeWith
nId
HyperdataGraph
let
graph
=
nodeGraph
^.
node_hyperdata
.
hyperdataGraph
let
listVersion
=
graph
^?
_Just
...
...
@@ -136,9 +127,9 @@ recomputeGraph uId nId = do
repo
<-
getRepo
let
v
=
repo
^.
r_version
nodeUser
<-
getNodeUser
(
NodeId
uId
)
--
nodeUser <- getNodeUser (NodeId uId)
let
uId'
=
nodeUser
^.
node_userId
--
let uId' = nodeUser ^. node_userId
let
cId
=
maybe
(
panic
"[ERR:G.V.G.API] Node has no parent"
)
identity
...
...
@@ -147,8 +138,8 @@ recomputeGraph uId nId = do
g
<-
case
graph
of
Nothing
->
do
graph'
<-
computeGraph
cId
NgramsTerms
repo
_
<-
insertGraph
cId
uId'
(
HyperdataGraph
$
Just
graph'
)
pure
$
trace
"[recomputeGraph] Graph empty, comput
ing
"
$
graph'
_
<-
updateHyperdata
nId
(
HyperdataGraph
$
Just
graph'
)
pure
$
trace
"[recomputeGraph] Graph empty, comput
ed
"
$
graph'
Just
graph'
->
if
listVersion
==
Just
v
then
pure
graph'
...
...
@@ -187,15 +178,6 @@ computeGraph cId nt repo = do
let
graph'
=
set
graph_metadata
(
Just
metadata
)
graph
pure
graph'
postGraph
::
NodeId
->
GargServer
(
Post
'[
J
SON
]
[
NodeId
])
postGraph
=
undefined
putGraph
::
NodeId
->
GargServer
(
Put
'[
J
SON
]
Int
)
putGraph
=
undefined
------------------------------------------------------------
getGraphGexf
::
UserId
->
NodeId
->
GargNoServer
(
Headers
'[
S
ervant
.
Header
"Content-Disposition"
Text
]
Graph
)
...
...
@@ -204,7 +186,6 @@ getGraphGexf uId nId = do
pure
$
addHeader
(
concat
[
"attachment; filename=graph.gexf"
])
graph
------------------------------------------------------------
type
GraphAsyncAPI
=
Summary
"Update graph"
:>
"async"
:>
AsyncJobsAPI
ScraperStatus
()
ScraperStatus
...
...
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