{-| Module : Gargantext.Core.Viz.Phylo.API Description : Phylo API Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 Maintainer : team@gargantext.org Stability : experimental Portability : POSIX -} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE OverloadedLists #-} -- allows to write Map and HashMap as lists {-# LANGUAGE TypeOperators #-} module Gargantext.Core.Viz.Phylo.API where import Data.Aeson import Data.Aeson.Types (parseEither) import Data.Swagger import Data.Text qualified as T import Gargantext.API.Prelude import Gargantext.API.Routes.Named.Viz qualified as Named import Gargantext.API.Viz.Types 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.Database.Admin.Types.Hyperdata 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.Error import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata) import Gargantext.Prelude import Servant import Servant.Server.Generic (AsServerT) import Web.HttpApiData (readTextData) phyloAPI :: IsGargServer err env m => PhyloId -> Named.PhyloAPI (AsServerT m) phyloAPI n = Named.PhyloAPI { getPhyloEp = getPhylo n , postPhyloEp = postPhylo n } -- :<|> putPhylo n -- :<|> deletePhylo n -- | TODO -- Add real text processing -- Fix Filter parameters -- TODO fix parameters to default config that should be in Node getPhylo :: IsGargServer err env m => PhyloId -> Named.GetPhylo (AsServerT m) getPhylo phyloId = Named.GetPhylo $ \lId _level _minSizeBranch -> do corpusId <- maybe (nodeLookupError $ NodeParentDoesNotExist phyloId) pure =<< getClosestParentIdByType phyloId (Just NodeCorpus) listId <- case lId of Nothing -> defaultList corpusId Just ld -> pure ld pd <- getPhyloDataJson phyloId -- printDebug "getPhylo" theData case pd of Nothing -> pure $ PhyloData corpusId listId Nothing Nothing Just (gd, phyloConfig) -> pure $ PhyloData corpusId listId (Just gd) (Just phyloConfig) getPhyloDataJson :: PhyloId -> GargNoServer (Maybe (GraphData, PhyloConfig)) getPhyloDataJson phyloId = do 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 $ 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 -- let -- level = fromMaybe 2 l -- branc = fromMaybe 2 msb -- maybePhylo = phNode ^. (node_hyperdata . hp_data) -- p <- liftBase $ viewPhylo2Svg -- $ viewPhylo level branc -- $ fromMaybe phyloFromQuery maybePhylo -- pure (SVG p) postPhylo :: IsGargServer err env m => PhyloId -> Named.PostPhylo (AsServerT m) postPhylo phyloId = Named.PostPhylo $ \_lId -> do -- TODO get Reader settings -- s <- ask -- let -- _vrs = Just ("1" :: Text) -- _sft = Just (Software "Gargantext" "4") -- _prm = initPhyloParam vrs sft (Just q) corpusId <- getClosestParentIdByType phyloId (Just NodeCorpus) -- Being the first time we ask for the Phylo, there is no historical data -- available about computing time, so we pass 'Nothing'. phy <- flowPhyloAPI defaultConfig Nothing (fromMaybe (panicTrace "[G.C.V.P.API] no corpus ID found") corpusId) -- params -- phyloId <- insertNodes [node NodePhylo "Phylo" (HyperdataPhylo Nothing (Just phy)) (Just corpusId) userId] _ <- updateHyperdata phyloId (HyperdataPhylo Nothing (Just phy)) pure phyloId ------------------------------------------------------------------------ -- | DELETE Phylo == delete a node ------------------------------------------------------------------------ ------------------------------------------------------------------------ {- type PutPhylo = (Put '[JSON] Phylo ) --putPhylo :: PhyloId -> Maybe ListId -> PhyloQueryBuild -> Phylo putPhylo :: PhyloId -> GargServer PutPhylo putPhylo = undefined -} -- | Instances instance FromHttpApiData DisplayMode where parseUrlPiece = readTextData instance FromHttpApiData ExportMode where parseUrlPiece = readTextData instance FromHttpApiData Filiation where parseUrlPiece = readTextData instance FromHttpApiData Metric where parseUrlPiece = readTextData instance FromHttpApiData Order where parseUrlPiece = readTextData instance FromHttpApiData Sort where parseUrlPiece = readTextData instance FromHttpApiData Tagger where parseUrlPiece = readTextData instance FromHttpApiData [Metric] where parseUrlPiece = readTextData instance FromHttpApiData [Tagger] where parseUrlPiece = readTextData instance ToParamSchema DisplayMode instance ToParamSchema ExportMode instance ToParamSchema Filiation instance ToParamSchema Tagger instance ToParamSchema Metric instance ToParamSchema Order instance ToParamSchema Sort instance ToSchema Order