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
160
Issues
160
List
Board
Labels
Milestones
Merge Requests
14
Merge Requests
14
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
dd00da1b
Commit
dd00da1b
authored
Jul 22, 2024
by
Karen Konou
1
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[Phylo] Don't serve the 'cleopatre' phylo when no data is present
parent
3329c788
Pipeline
#6438
passed with stages
in 45 minutes and 12 seconds
Changes
3
Pipelines
1
Show whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
22 additions
and
13 deletions
+22
-13
Types.hs
src/Gargantext/API/Viz/Types.hs
+2
-2
API.hs
src/Gargantext/Core/Viz/Phylo/API.hs
+16
-11
Tools.hs
src/Gargantext/Core/Viz/Phylo/API/Tools.hs
+4
-0
No files found.
src/Gargantext/API/Viz/Types.hs
View file @
dd00da1b
...
...
@@ -36,8 +36,8 @@ instance ToSchema Value where declareNamedSchema _ = declareNamedSchema (Proxy :
-- 'purescript-gargantext' package.
data
PhyloData
=
PhyloData
{
pd_corpusId
::
NodeId
,
pd_listId
::
NodeId
,
pd_data
::
GraphData
,
pd_config
::
PhyloConfig
,
pd_data
::
Maybe
GraphData
,
pd_config
::
Maybe
PhyloConfig
}
deriving
(
Generic
,
Show
,
Eq
)
...
...
src/Gargantext/Core/Viz/Phylo/API.hs
View file @
dd00da1b
...
...
@@ -28,7 +28,6 @@ import Gargantext.Core.Types.Phylo (GraphData(..))
import
Gargantext.Core.Viz.LegacyPhylo
hiding
(
Phylo
(
..
))
import
Gargantext.Core.Viz.Phylo
(
PhyloConfig
(
..
),
defaultConfig
,
_phylo_param
,
_phyloParam_config
)
import
Gargantext.Core.Viz.Phylo.API.Tools
import
Gargantext.Core.Viz.Phylo.Example
(
phyloCleopatre
)
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Node
-- (PhyloId, ListId, CorpusId, UserId, NodeId(..))
import
Gargantext.Database.Query.Table.Node
(
getClosestParentIdByType
,
defaultList
)
...
...
@@ -58,21 +57,27 @@ getPhylo phyloId = Named.GetPhylo $ \lId _level _minSizeBranch -> do
listId
<-
case
lId
of
Nothing
->
defaultList
corpusId
Just
ld
->
pure
ld
(
gd
,
phyloConfig
)
<-
getPhyloDataJson
phyloId
pd
<-
getPhyloDataJson
phyloId
-- printDebug "getPhylo" theData
pure
$
PhyloData
corpusId
listId
gd
phyloConfig
case
pd
of
Nothing
->
pure
$
PhyloData
corpusId
listId
Nothing
Nothing
Just
(
gd
,
phyloConfig
)
->
pure
$
PhyloData
corpusId
listId
(
Just
gd
)
(
Just
phyloConfig
)
getPhyloDataJson
::
PhyloId
->
GargNoServer
(
GraphData
,
PhyloConfig
)
getPhyloDataJson
::
PhyloId
->
GargNoServer
(
Maybe
(
GraphData
,
PhyloConfig
)
)
getPhyloDataJson
phyloId
=
do
maybePhyloData
<-
getPhyloData
phyloId
let
phyloData
=
fromMaybe
phyloCleopatre
maybePhyloData
let
phyloConfig
=
_phyloParam_config
$
_phylo_param
phyloData
phyloJson
<-
liftBase
$
phylo2dot2json
phyloData
case
parseEither
parseJSON
phyloJson
of
phyloData
<-
getPhyloData
phyloId
phyloJson
<-
liftBase
$
maybePhylo2dot2json
phyloData
case
phyloJson
of
Nothing
->
pure
Nothing
Just
pj
->
case
parseEither
parseJSON
pj
of
Left
err
->
panicTrace
$
T
.
pack
$
"[Gargantext.Core.Viz.Phylo.API] getPhyloDataJson: "
<>
err
Right
gd
->
pure
(
gd
,
phyloConfig
)
Right
gd
->
pure
$
Just
(
gd
,
phyloConfig
phyloData
)
where
phyloConfig
phyloData
=
_phyloParam_config
.
_phylo_param
$
fromMaybe
(
panicTrace
"[Gargantext.Core.Viz.Phylo.API] getPhyloDataJson: no phylo data"
)
phyloData
-- getPhyloDataSVG phId _lId l msb = do
...
...
src/Gargantext/Core/Viz/Phylo/API/Tools.hs
View file @
dd00da1b
...
...
@@ -69,6 +69,10 @@ savePhylo :: PhyloId -> DBCmd err ()
savePhylo
=
undefined
--------------------------------------------------------------------
maybePhylo2dot2json
::
Maybe
Phylo
->
IO
(
Maybe
Value
)
maybePhylo2dot2json
Nothing
=
pure
Nothing
maybePhylo2dot2json
(
Just
phylo
)
=
Just
<$>
phylo2dot2json
phylo
phylo2dot2json
::
Phylo
->
IO
Value
phylo2dot2json
phylo
=
do
withTempDirectory
"/tmp"
"phylo"
$
\
dirPath
->
do
...
...
Przemyslaw Kaminski
@cgenie
mentioned in commit
5660aec0
·
Oct 08, 2024
mentioned in commit
5660aec0
mentioned in commit 5660aec07ec5a0a0a5468f440092c1a8f57a864e
Toggle commit list
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