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
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
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
Grégoire Locqueville
haskell-gargantext
Commits
7ab4eb24
Commit
7ab4eb24
authored
1 year ago
by
Alfredo Di Napoli
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Force toPhyloWithoutLink and toPhylo in WHNF
They were masking the real performance of `flowPhyloAPI`.
parent
821d9677
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
16 additions
and
7 deletions
+16
-7
Update.hs
src/Gargantext/API/Node/Update.hs
+9
-3
Tools.hs
src/Gargantext/Core/Viz/Phylo/API/Tools.hs
+7
-4
No files found.
src/Gargantext/API/Node/Update.hs
View file @
7ab4eb24
...
...
@@ -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)
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/Core/Viz/Phylo/API/Tools.hs
View file @
7ab4eb24
...
...
@@ -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
)
...
...
This diff is collapsed.
Click to expand it.
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