Commit 8873a848 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FEAT] Phylo update

parent eef7e439
...@@ -36,7 +36,8 @@ import Gargantext.Database.Action.Flow.Types (FlowCmdM) ...@@ -36,7 +36,8 @@ import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Action.Metrics (updateNgramsOccurrences, updateContextScore) import Gargantext.Database.Action.Metrics (updateNgramsOccurrences, updateContextScore)
import Gargantext.Database.Admin.Types.Hyperdata import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Query.Table.Node (defaultList, getNode, insertNodes, node) import Gargantext.Database.Query.Table.Node (defaultList, getNode)
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Schema.Ngrams (NgramsType(NgramsTerms)) import Gargantext.Database.Schema.Ngrams (NgramsType(NgramsTerms))
import Gargantext.Database.Schema.Node (node_parent_id) import Gargantext.Database.Schema.Node (node_parent_id)
import Gargantext.Prelude (Bool(..), Ord, Eq, (<$>), ($), liftBase, (.), printDebug, pure, show, cs, (<>), panic, (<*>)) import Gargantext.Prelude (Bool(..), Ord, Eq, (<$>), ($), liftBase, (.), printDebug, pure, show, cs, (<>), panic, (<*>))
...@@ -191,7 +192,7 @@ updateNode _uId lId (UpdateNodeParamsList _mode) logStatus = do ...@@ -191,7 +192,7 @@ updateNode _uId lId (UpdateNodeParamsList _mode) logStatus = do
, _scst_events = Just [] , _scst_events = Just []
} }
updateNode userId phyloId (UpdateNodePhylo config) logStatus = do updateNode _userId phyloId (UpdateNodePhylo config) logStatus = do
logStatus JobLog { _scst_succeeded = Just 1 logStatus JobLog { _scst_succeeded = Just 1
, _scst_failed = Just 0 , _scst_failed = Just 0
, _scst_remaining = Just 2 , _scst_remaining = Just 2
...@@ -210,7 +211,7 @@ updateNode userId phyloId (UpdateNodePhylo config) logStatus = do ...@@ -210,7 +211,7 @@ updateNode userId phyloId (UpdateNodePhylo config) logStatus = do
, _scst_events = Just [] , _scst_events = Just []
} }
_phyloId <- insertNodes [node NodePhylo "Phylo" (HyperdataPhylo Nothing (Just phy)) (Just corpusId) userId] _ <- updateHyperdata phyloId (HyperdataPhylo Nothing (Just phy))
pure JobLog { _scst_succeeded = Just 3 pure JobLog { _scst_succeeded = Just 3
, _scst_failed = Just 0 , _scst_failed = Just 0
......
...@@ -30,7 +30,8 @@ import Gargantext.Core.Viz.Phylo.Example (phyloExample) ...@@ -30,7 +30,8 @@ import Gargantext.Core.Viz.Phylo.Example (phyloExample)
import Gargantext.Core.Viz.Phylo.Legacy.LegacyMain import Gargantext.Core.Viz.Phylo.Legacy.LegacyMain
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 (insertNodes, node) import Gargantext.Database.Query.Table.Node (getClosestParentIdByType)
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Prelude import Gargantext.Prelude
import Network.HTTP.Media ((//), (/:)) import Network.HTTP.Media ((//), (/:))
import Servant import Servant
...@@ -90,7 +91,10 @@ type GetPhylo = QueryParam "listId" ListId ...@@ -90,7 +91,10 @@ type GetPhylo = QueryParam "listId" ListId
-- Fix Filter parameters -- Fix Filter parameters
-- TODO fix parameters to default config that should be in Node -- TODO fix parameters to default config that should be in Node
getPhylo :: PhyloId -> GargServer GetPhylo getPhylo :: PhyloId -> GargServer GetPhylo
getPhylo phyloId _lId _level _minSizeBranch = getPhyloDataJson phyloId getPhylo phyloId _lId _level _minSizeBranch = do
theData <- getPhyloDataJson phyloId
-- printDebug "getPhylo" theData
pure theData
getPhyloDataJson :: PhyloId -> GargNoServer Value getPhyloDataJson :: PhyloId -> GargNoServer Value
getPhyloDataJson phyloId = do getPhyloDataJson phyloId = do
...@@ -118,17 +122,19 @@ type PostPhylo = QueryParam "listId" ListId ...@@ -118,17 +122,19 @@ type PostPhylo = QueryParam "listId" ListId
-- :> ReqBody '[JSON] PhyloQueryBuild -- :> ReqBody '[JSON] PhyloQueryBuild
:> (Post '[JSON] NodeId) :> (Post '[JSON] NodeId)
postPhylo :: CorpusId -> UserId -> GargServer PostPhylo postPhylo :: PhyloId -> UserId -> GargServer PostPhylo
postPhylo corpusId userId _lId = do postPhylo phyloId _userId _lId = do
-- TODO get Reader settings -- TODO get Reader settings
-- s <- ask -- s <- ask
-- let -- let
-- _vrs = Just ("1" :: Text) -- _vrs = Just ("1" :: Text)
-- _sft = Just (Software "Gargantext" "4") -- _sft = Just (Software "Gargantext" "4")
-- _prm = initPhyloParam vrs sft (Just q) -- _prm = initPhyloParam vrs sft (Just q)
phy <- flowPhyloAPI defaultConfig corpusId -- params corpusId <- getClosestParentIdByType phyloId NodeCorpus
phyloId <- insertNodes [node NodePhylo "Phylo" (HyperdataPhylo Nothing (Just phy)) (Just corpusId) userId] phy <- flowPhyloAPI defaultConfig (fromMaybe (panic "[G.C.V.P.API] no corpus ID found") corpusId) -- params
pure $ NodeId (fromIntegral phyloId) -- 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 -- | DELETE Phylo == delete a node
......
...@@ -9,7 +9,6 @@ Portability : POSIX ...@@ -9,7 +9,6 @@ Portability : POSIX
-} -}
module Gargantext.Core.Viz.Phylo.API.Tools module Gargantext.Core.Viz.Phylo.API.Tools
where where
......
...@@ -208,8 +208,8 @@ exportToDot phylo export = ...@@ -208,8 +208,8 @@ exportToDot phylo export =
{- 1) init the dot graph -} {- 1) init the dot graph -}
graphAttrs ( [ Label (toDotLabel $ (phyloName $ getConfig phylo))] graphAttrs ( [ Label (toDotLabel $ (phyloName $ getConfig phylo))]
<> [ FontSize 30, LabelLoc VTop, NodeSep 1, RankSep [1], Rank SameRank, Splines SplineEdges, Overlap ScaleOverlaps <> [ FontSize 30, LabelLoc VTop, NodeSep 1, RankSep [1], Rank SameRank, Splines SplineEdges, Overlap ScaleOverlaps
-- , Ratio FillRatio , Ratio FillRatio
, Ratio AutoRatio -- , Ratio AutoRatio
, Style [SItem Filled []],Color [toWColor White]] , Style [SItem Filled []],Color [toWColor White]]
{-- home made attributes -} {-- home made attributes -}
<> [(toAttr (fromStrict "phyloFoundations") $ pack $ show (length $ Vector.toList $ getRoots phylo)) <> [(toAttr (fromStrict "phyloFoundations") $ pack $ show (length $ Vector.toList $ getRoots phylo))
......
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