Skip to content

P
purescript-gargantext
Commit 7c209a88 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

Merge remote-tracking branch 'christian_merten/cm/update-corpus-button' into dev

parents 9fefa432 324cc975
Hide whitespace changes
Inline Side-by-side
Showing with 97 additions and 23 deletions
src/Gargantext/Components/Forest/Tree/Node/Action/Update.purs
View file @ 7c209a88
......@@ -2,7 +2,7 @@ module Gargantext.Components.Forest.Tree.Node.Action.Update where
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action.Update.Types (Charts(..), Granularity(..), GraphMetric(..), Method(..), PartitionMethod(..), UpdateNodeParams(..), Strength(..), BridgenessMethod(..))
import Gargantext.Components.Forest.Tree.Node.Action.Update.Types (Charts(..), Granularity(..), GraphMetric(..), Method(..), PartitionMethod(..), UpdateNodeParams(..), Strength(..), BridgenessMethod(..), UpdateNodeConfigGraph(..))
import DOM.Simple.Console (log3)
import Data.Either (Either(..))
......@@ -52,6 +52,7 @@ updateCpt = here.component "update" cpt where
cpt props@{ nodeType: NodeList } _ = pure $ updateNodeList props []
cpt props@{ nodeType: NodeTexts } _ = pure $ updateTexts props []
cpt props@{ nodeType: Phylo } _ = pure $ updatePhylo props
cpt props@{ nodeType: Corpus } _ = pure $ updateCorpus props
cpt props@{ nodeType: _ } _ = pure $ updateOther props []
updateDashboard :: R2.Component UpdateProps
......@@ -100,13 +101,14 @@ updateGraphCpt = here.component "updateGraph" cpt where
callback :: Action -> Aff Unit
callback = dispatch >=> \_ -> dispatch CloseBox
let action = UpdateNode $ UpdateNodeParamsGraph { methodGraphMetric: methodGraphMetric'
, methodGraphClustering: methodGraphClustering'
, methodGraphBridgeness: methodGraphBridgeness'
, methodGraphEdgesStrength : methodGraphEdgesStrength'
, methodGraphNodeType1 : methodGraphNodeType1'
, methodGraphNodeType2 : methodGraphNodeType2'
}
let config = UpdateNodeConfigGraph { methodGraphMetric: methodGraphMetric'
, methodGraphClustering: methodGraphClustering'
, methodGraphBridgeness: methodGraphBridgeness'
, methodGraphEdgesStrength : methodGraphEdgesStrength'
, methodGraphNodeType1 : methodGraphNodeType1'
, methodGraphNodeType2 : methodGraphNodeType2'
}
let action = UpdateNode $ UpdateNodeParamsGraph { methodGraph: config }
pure $
Tools.panelWithSubmitButton { action
......@@ -211,6 +213,63 @@ updatePhyloCpt = here.component "updatePhylo" cpt where
, status: Enabled
} `merge` parser.toFormData defaultData
updateCorpus :: R2.Leaf UpdateProps
updateCorpus = R2.leaf updateCorpusCpt
updateCorpusCpt :: R.Component UpdateProps
updateCorpusCpt = here.component "updateTexts" cpt where
cpt { dispatch } _ = do
-- nodeList parameters
methodList <- T.useBox Basic
methodList' <- T.useLive T.unequal methodList
-- method for graph metric
methodGraphMetric <- T.useBox Order1
methodGraphMetric' <- T.useLive T.unequal methodGraphMetric
let graphConfig = UpdateNodeConfigGraph { methodGraphMetric: methodGraphMetric'
, methodGraphEdgesStrength: Strong
, methodGraphClustering: Spinglass
, methodGraphBridgeness: BridgenessMethod_Basic
, methodGraphNodeType1: GT.CTabTerms
, methodGraphNodeType2: GT.CTabTerms
}
let phyloConfig = Phylo.UpdateData { defaultMode: true
, proximity: 0.5
, synchrony: 0.5
, quality: 0.8
, exportFilter: 3.0
, timeUnit: Phylo.Year $ Phylo.TimeUnitCriteria
{ period: 3
, step: 1
, matchingFrame: 5
}
, clique: Phylo.MaxClique
{ size: 5
, threshold: 0.0001
, filter: Phylo.ByThreshold
}
}
let methodTexts = Both
pure $
Tools.panelWithSubmitButton { action: UpdateNode $ UpdateNodeParamsCorpus { methodGraph: graphConfig
, methodPhylo: phyloConfig
, methodTexts: methodTexts
, methodList: methodList' }
, dispatch
, mError: Nothing }
[ H.text "Term update mode"
, Tools.formChoiceSafe { items: [Basic, Advanced, WithModel]
, default: methodList'
, callback: \val -> T.write_ val methodList
, print: show } []
, H.text "Show subjects with Order1 or concepts with Order2 ?"
, Tools.formChoiceSafe { items: [Order1, Order2]
, default: methodGraphMetric'
, callback: \val -> T.write_ val methodGraphMetric
, print: show } []
]
updateNodeList :: R2.Component UpdateProps
updateNodeList = R.createElement updateNodeListCpt
updateNodeListCpt :: R.Component UpdateProps
......
src/Gargantext/Components/Forest/Tree/Node/Action/Update/Types.purs
View file @ 7c209a88
......@@ -10,20 +10,31 @@ import Gargantext.Types as GT
import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
newtype UpdateNodeConfigGraph = UpdateNodeConfigGraph { methodGraphMetric :: GraphMetric
, methodGraphEdgesStrength :: Strength
, methodGraphClustering :: PartitionMethod
, methodGraphBridgeness :: BridgenessMethod
, methodGraphNodeType1 :: GT.CTabNgramType
, methodGraphNodeType2 :: GT.CTabNgramType
}
derive instance Eq UpdateNodeConfigGraph
derive instance Generic UpdateNodeConfigGraph _
instance Show UpdateNodeConfigGraph where show = genericShow
derive newtype instance JSON.ReadForeign UpdateNodeConfigGraph
derive newtype instance JSON.WriteForeign UpdateNodeConfigGraph
data UpdateNodeParams
= UpdateNodeParamsList { methodList :: Method }
| UpdateNodeParamsGraph { methodGraphMetric :: GraphMetric
, methodGraphEdgesStrength :: Strength
, methodGraphClustering :: PartitionMethod
, methodGraphBridgeness :: BridgenessMethod
, methodGraphNodeType1 :: GT.CTabNgramType
, methodGraphNodeType2 :: GT.CTabNgramType
}
| UpdateNodeParamsTexts { methodTexts :: Granularity }
| UpdateNodeParamsBoard { methodBoard :: Charts }
| UpdateNodeParamsPhylo { methodPhylo :: Phylo.UpdateData }
| UpdateNodeParamsLink { methodLink :: LinkNodeReq }
= UpdateNodeParamsList { methodList :: Method }
| UpdateNodeParamsGraph { methodGraph :: UpdateNodeConfigGraph }
| UpdateNodeParamsTexts { methodTexts :: Granularity }
| UpdateNodeParamsCorpus { methodGraph :: UpdateNodeConfigGraph
, methodPhylo :: Phylo.UpdateData
, methodTexts :: Granularity
, methodList :: Method }
| UpdateNodeParamsBoard { methodBoard :: Charts }
| UpdateNodeParamsPhylo { methodPhylo :: Phylo.UpdateData }
| UpdateNodeParamsLink { methodLink :: LinkNodeReq }
derive instance Eq UpdateNodeParams
derive instance Generic UpdateNodeParams _
instance Show UpdateNodeParams where show = genericShow
......@@ -32,12 +43,15 @@ instance JSON.WriteForeign UpdateNodeParams where
writeImpl (UpdateNodeParamsList { methodList }) =
JSON.writeImpl { type: "UpdateNodeParamsList"
, methodList }
writeImpl (UpdateNodeParamsGraph { methodGraphMetric, methodGraphClustering, methodGraphBridgeness, methodGraphEdgesStrength, methodGraphNodeType1, methodGraphNodeType2}) =
writeImpl (UpdateNodeParamsGraph { methodGraph }) =
JSON.writeImpl { type: "UpdateNodeParamsGraph"
, methodGraphMetric, methodGraphClustering, methodGraphBridgeness, methodGraphEdgesStrength, methodGraphNodeType1, methodGraphNodeType2}
, methodGraph }
writeImpl (UpdateNodeParamsTexts { methodTexts }) =
JSON.writeImpl { type: "UpdateNodeParamsTexts"
, methodTexts }
writeImpl (UpdateNodeParamsCorpus { methodGraph, methodPhylo, methodTexts, methodList }) =
JSON.writeImpl { type: "UpdateNodeParamsCorpus"
, methodGraph, methodPhylo, methodTexts, methodList }
writeImpl (UpdateNodeParamsBoard { methodBoard }) =
JSON.writeImpl { type: "UpdateNodeParamsBoard"
, methodBoard }
......
src/Gargantext/Components/Forest/Tree/Node/Settings.purs
View file @ 7c209a88
......@@ -152,7 +152,8 @@ settingsBoxLens Calc =
, ShareURL
, Delete ]
settingsBoxLens Corpus =
_buttons .~ [ Add [ Graph
_buttons .~ [ ReloadWithSettings
, Add [ Graph
, Notes
, Calc
, NodeTexts
......
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