Commit 7ab4eb24 authored by Alfredo Di Napoli's avatar Alfredo Di Napoli

Force toPhyloWithoutLink and toPhylo in WHNF

They were masking the real performance of `flowPhyloAPI`.
parent 821d9677
......@@ -50,6 +50,8 @@ import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
import Gargantext.Utils.UTCTime (timeMeasured)
import Gargantext.System.Logging
------------------------------------------------------------------------
type API = Summary " Update node according to NodeType params"
......@@ -94,7 +96,11 @@ api nId =
serveJobsAPI UpdateNodeJob $ \jHandle p ->
updateNode nId p jHandle
updateNode :: (HasNodeStory env err m, HasSettings env, MonadJobStatus m)
updateNode :: (HasNodeStory env err m
, HasSettings env
, MonadJobStatus m
, MonadLogger m
)
=> NodeId
-> UpdateNodeParams
-> JobHandle m
......@@ -156,7 +162,7 @@ updateNode phyloId (UpdateNodePhylo config) jobHandle = do
let corpusId = fromMaybe (panicTrace "no corpus id") corpusId'
phy <- flowPhyloAPI (subConfigAPI2config config) corpusId
phy <- timeMeasured "updateNode.flowPhyloAPI" $ flowPhyloAPI (subConfigAPI2config config) corpusId
markProgress 2 jobHandle
{-
......@@ -166,7 +172,7 @@ updateNode phyloId (UpdateNodePhylo config) jobHandle = do
, _scst_events = Just []
}
-}
_ <- updateHyperdata phyloId (HyperdataPhylo Nothing (Just phy))
_ <- timeMeasured "updateNode.updateHyperdataPhylo" $ updateHyperdata phyloId (HyperdataPhylo Nothing (Just phy))
-- TODO: catch the error of sendMail if userId is not found, then debug
-- sendMail (UserDBId userId)
......
......@@ -12,6 +12,8 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-deprecations #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BangPatterns #-}
module Gargantext.Core.Viz.Phylo.API.Tools
where
......@@ -47,6 +49,7 @@ import Gargantext.Database.Schema.Context
import Gargantext.Database.Schema.Ngrams (NgramsType(..))
import Gargantext.Database.Schema.Node
import Gargantext.Prelude hiding (to)
import Gargantext.System.Logging
import Prelude qualified
import System.FilePath ((</>))
import System.IO.Temp (withTempDirectory)
......@@ -88,15 +91,15 @@ phylo2dot2json phylo = do
Just v -> pure v
flowPhyloAPI :: (HasNodeStory env err m, HasNodeError err)
flowPhyloAPI :: (HasNodeStory env err m, HasNodeError err, MonadLogger m)
=> PhyloConfig -> CorpusId -> m Phylo
flowPhyloAPI config cId = do
corpus <- corpusIdtoDocuments (timeUnit config) cId
let phyloWithCliques = toPhyloWithoutLink corpus config
let !phyloWithCliques = toPhyloWithoutLink corpus config
-- writePhylo phyloWithCliquesFile phyloWithCliques
printDebug "PhyloConfig old: " config
$(logLocM) DEBUG $ "PhyloConfig old: " <> show config
pure $ toPhylo $ setConfig config phyloWithCliques
pure $! toPhylo $! setConfig config phyloWithCliques
--------------------------------------------------------------------
corpusIdtoDocuments :: (HasNodeStory env err m, HasNodeError err)
......
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