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
195
Issues
195
List
Board
Labels
Milestones
Merge Requests
12
Merge Requests
12
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
gargantext
haskell-gargantext
Commits
8873a848
Commit
8873a848
authored
Mar 08, 2022
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FEAT] Phylo update
parent
eef7e439
Pipeline
#2548
failed with stage
in 43 minutes and 7 seconds
Changes
4
Pipelines
1
Show whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
19 additions
and
13 deletions
+19
-13
Update.hs
src/Gargantext/API/Node/Update.hs
+4
-3
API.hs
src/Gargantext/Core/Viz/Phylo/API.hs
+13
-7
Tools.hs
src/Gargantext/Core/Viz/Phylo/API/Tools.hs
+0
-1
PhyloExport.hs
src/Gargantext/Core/Viz/Phylo/PhyloExport.hs
+2
-2
No files found.
src/Gargantext/API/Node/Update.hs
View file @
8873a848
...
...
@@ -36,7 +36,8 @@ import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import
Gargantext.Database.Action.Metrics
(
updateNgramsOccurrences
,
updateContextScore
)
import
Gargantext.Database.Admin.Types.Hyperdata
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.Node
(
node_parent_id
)
import
Gargantext.Prelude
(
Bool
(
..
),
Ord
,
Eq
,
(
<$>
),
(
$
),
liftBase
,
(
.
),
printDebug
,
pure
,
show
,
cs
,
(
<>
),
panic
,
(
<*>
))
...
...
@@ -191,7 +192,7 @@ updateNode _uId lId (UpdateNodeParamsList _mode) logStatus = do
,
_scst_events
=
Just
[]
}
updateNode
userId
phyloId
(
UpdateNodePhylo
config
)
logStatus
=
do
updateNode
_
userId
phyloId
(
UpdateNodePhylo
config
)
logStatus
=
do
logStatus
JobLog
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
2
...
...
@@ -210,7 +211,7 @@ updateNode userId phyloId (UpdateNodePhylo config) logStatus = do
,
_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
,
_scst_failed
=
Just
0
...
...
src/Gargantext/Core/Viz/Phylo/API.hs
View file @
8873a848
...
...
@@ -30,7 +30,8 @@ import Gargantext.Core.Viz.Phylo.Example (phyloExample)
import
Gargantext.Core.Viz.Phylo.Legacy.LegacyMain
import
Gargantext.Database.Admin.Types.Hyperdata
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
Network.HTTP.Media
((
//
),
(
/:
))
import
Servant
...
...
@@ -90,7 +91,10 @@ type GetPhylo = QueryParam "listId" ListId
-- Fix Filter parameters
-- TODO fix parameters to default config that should be in Node
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
=
do
...
...
@@ -118,17 +122,19 @@ type PostPhylo = QueryParam "listId" ListId
-- :> ReqBody '[JSON] PhyloQueryBuild
:>
(
Post
'[
J
SON
]
NodeId
)
postPhylo
::
Corpus
Id
->
UserId
->
GargServer
PostPhylo
postPhylo
corpusId
userId
_lId
=
do
postPhylo
::
Phylo
Id
->
UserId
->
GargServer
PostPhylo
postPhylo
phyloId
_
userId
_lId
=
do
-- TODO get Reader settings
-- s <- ask
-- let
-- _vrs = Just ("1" :: Text)
-- _sft = Just (Software "Gargantext" "4")
-- _prm = initPhyloParam vrs sft (Just q)
phy
<-
flowPhyloAPI
defaultConfig
corpusId
-- params
phyloId
<-
insertNodes
[
node
NodePhylo
"Phylo"
(
HyperdataPhylo
Nothing
(
Just
phy
))
(
Just
corpusId
)
userId
]
pure
$
NodeId
(
fromIntegral
phyloId
)
corpusId
<-
getClosestParentIdByType
phyloId
NodeCorpus
phy
<-
flowPhyloAPI
defaultConfig
(
fromMaybe
(
panic
"[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
...
...
src/Gargantext/Core/Viz/Phylo/API/Tools.hs
View file @
8873a848
...
...
@@ -9,7 +9,6 @@ Portability : POSIX
-}
module
Gargantext.Core.Viz.Phylo.API.Tools
where
...
...
src/Gargantext/Core/Viz/Phylo/PhyloExport.hs
View file @
8873a848
...
...
@@ -208,8 +208,8 @@ exportToDot phylo export =
{- 1) init the dot graph -}
graphAttrs
(
[
Label
(
toDotLabel
$
(
phyloName
$
getConfig
phylo
))]
<>
[
FontSize
30
,
LabelLoc
VTop
,
NodeSep
1
,
RankSep
[
1
],
Rank
SameRank
,
Splines
SplineEdges
,
Overlap
ScaleOverlaps
--
, Ratio FillRatio
,
Ratio
AutoRatio
,
Ratio
FillRatio
--
, Ratio AutoRatio
,
Style
[
SItem
Filled
[]
],
Color
[
toWColor
White
]]
{-- home made attributes -}
<>
[(
toAttr
(
fromStrict
"phyloFoundations"
)
$
pack
$
show
(
length
$
Vector
.
toList
$
getRoots
phylo
))
...
...
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