Commit dd00da1b authored by Karen Konou's avatar Karen Konou

[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
...@@ -36,8 +36,8 @@ instance ToSchema Value where declareNamedSchema _ = declareNamedSchema (Proxy : ...@@ -36,8 +36,8 @@ instance ToSchema Value where declareNamedSchema _ = declareNamedSchema (Proxy :
-- 'purescript-gargantext' package. -- 'purescript-gargantext' package.
data PhyloData = PhyloData { pd_corpusId :: NodeId data PhyloData = PhyloData { pd_corpusId :: NodeId
, pd_listId :: NodeId , pd_listId :: NodeId
, pd_data :: GraphData , pd_data :: Maybe GraphData
, pd_config :: PhyloConfig , pd_config :: Maybe PhyloConfig
} }
deriving (Generic, Show, Eq) deriving (Generic, Show, Eq)
......
...@@ -28,7 +28,6 @@ import Gargantext.Core.Types.Phylo (GraphData(..)) ...@@ -28,7 +28,6 @@ import Gargantext.Core.Types.Phylo (GraphData(..))
import Gargantext.Core.Viz.LegacyPhylo hiding (Phylo(..)) import Gargantext.Core.Viz.LegacyPhylo hiding (Phylo(..))
import Gargantext.Core.Viz.Phylo (PhyloConfig(..), defaultConfig, _phylo_param, _phyloParam_config) import Gargantext.Core.Viz.Phylo (PhyloConfig(..), defaultConfig, _phylo_param, _phyloParam_config)
import Gargantext.Core.Viz.Phylo.API.Tools 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.Hyperdata
import Gargantext.Database.Admin.Types.Node -- (PhyloId, ListId, CorpusId, UserId, NodeId(..)) import Gargantext.Database.Admin.Types.Node -- (PhyloId, ListId, CorpusId, UserId, NodeId(..))
import Gargantext.Database.Query.Table.Node (getClosestParentIdByType, defaultList) import Gargantext.Database.Query.Table.Node (getClosestParentIdByType, defaultList)
...@@ -58,21 +57,27 @@ getPhylo phyloId = Named.GetPhylo $ \lId _level _minSizeBranch -> do ...@@ -58,21 +57,27 @@ getPhylo phyloId = Named.GetPhylo $ \lId _level _minSizeBranch -> do
listId <- case lId of listId <- case lId of
Nothing -> defaultList corpusId Nothing -> defaultList corpusId
Just ld -> pure ld Just ld -> pure ld
(gd, phyloConfig) <- getPhyloDataJson phyloId pd <- getPhyloDataJson phyloId
-- printDebug "getPhylo" theData -- 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 getPhyloDataJson phyloId = do
maybePhyloData <- getPhyloData phyloId phyloData <- getPhyloData phyloId
let phyloData = fromMaybe phyloCleopatre maybePhyloData phyloJson <- liftBase $ maybePhylo2dot2json phyloData
let phyloConfig = _phyloParam_config $ _phylo_param phyloData case phyloJson of
phyloJson <- liftBase $ phylo2dot2json phyloData Nothing -> pure Nothing
case parseEither parseJSON phyloJson of Just pj ->
Left err -> panicTrace $ T.pack $ "[Gargantext.Core.Viz.Phylo.API] getPhyloDataJson: " <> err case parseEither parseJSON pj of
Right gd -> pure (gd, phyloConfig) Left err -> panicTrace $ T.pack $ "[Gargantext.Core.Viz.Phylo.API] getPhyloDataJson: " <> err
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 -- getPhyloDataSVG phId _lId l msb = do
......
...@@ -69,6 +69,10 @@ savePhylo :: PhyloId -> DBCmd err () ...@@ -69,6 +69,10 @@ savePhylo :: PhyloId -> DBCmd err ()
savePhylo = undefined savePhylo = undefined
-------------------------------------------------------------------- --------------------------------------------------------------------
maybePhylo2dot2json :: Maybe Phylo -> IO (Maybe Value)
maybePhylo2dot2json Nothing = pure Nothing
maybePhylo2dot2json (Just phylo) = Just <$> phylo2dot2json phylo
phylo2dot2json :: Phylo -> IO Value phylo2dot2json :: Phylo -> IO Value
phylo2dot2json phylo = do phylo2dot2json phylo = do
withTempDirectory "/tmp" "phylo" $ \dirPath -> do withTempDirectory "/tmp" "phylo" $ \dirPath -> do
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment