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

src/Gargantext/Components/Forest/Tree/Node/Action/Update.purs

@@ -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

@@ -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

@@ -152,7 +152,8 @@ settingsBoxLens Calc =
               , ShareURL
               , Delete ]
 settingsBoxLens Corpus =
-  _buttons .~ [ Add [ Graph
+  _buttons .~ [ ReloadWithSettings
+              , Add [ Graph
                     , Notes
                     , Calc
                     , NodeTexts