Merge branch 'dev-sigmajs-selector' into dev

.psc-package/local/.set/packages.json

@@ -3069,6 +3069,16 @@
     "repo": "https://github.com/purescript/purescript-tuples.git",
     "version": "v5.1.0"
   },
+  "tuples-native": {
+    "dependencies": [
+      "generics-rep",
+      "prelude",
+      "typelevel",
+      "unsafe-coerce"
+    ],
+    "repo": "https://github.com/athanclark/purescript-tuples-native",
+    "version": "v2.0.1"
+  },
   "type-equality": {
     "dependencies": [],
     "repo": "https://github.com/purescript/purescript-type-equality.git",

dist/styles/Graph.css

@@ -29,9 +29,10 @@
   overflow-y: scroll;
   top: 170px;
   z-index: 1;
-  left: 70%;
   border: 1px white solid;
   background-color: white;
+  left: 70%;
+  width: 30%;
 }
 #graph-explorer #sp-container #myTab {
   marginBottom: 18px;

dist/styles/Graph.sass

@@ -28,9 +28,10 @@
 
   #sp-container
     @include sidePanelCommon
-    left: 70%
     border: 1px white solid
     background-color: white
+    left: 70%
+    width: 30%
 
     #myTab
       marginBottom: 18px

package.json

@@ -7,6 +7,7 @@
         "build": "pulp --psc-package browserify -t dist/bundle.js",
         "sass": "sass dist/styles/",
         "dev": "webpack-dev-server --env dev --mode development",
+        "docs": "pulp docs -- --format html",
         "repl": "pulp --psc-package repl",
         "clean": "rm -Rf output",
         "test": "pulp test"

packages.dhall

@@ -204,6 +204,11 @@ let additions =
           ]
           "https://github.com/irresponsible/purescript-reactix"
           "v0.4.2"
+      , tuples-native =
+          mkPackage
+          [ "generics-rep", "prelude", "typelevel", "unsafe-coerce" ]
+          "https://github.com/athanclark/purescript-tuples-native"
+          "v2.0.1"
       , uint =
           mkPackage
           [ "maybe", "math", "generics-rep" ]

psc-package.json

@@ -33,6 +33,7 @@
     "string-parsers",
     "strings",
     "thermite",
+    "tuples-native",
     "uint",
     "uri",
     "web-html"

src/Gargantext/Components/Annotation/AnnotatedField.purs

@@ -27,7 +27,6 @@ import Gargantext.Types (CTabNgramType(..), TermList)
 import Gargantext.Components.Annotation.Utils ( termBootstrapClass )
 import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram)
 import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu, MenuType(..) )
-import Gargantext.Utils.Reactix as R2
 import Gargantext.Utils.Selection as Sel
 
 type Props =

src/Gargantext/Components/DocsTable.purs

@@ -55,7 +55,8 @@ favCategory _        = Favorite
 
 trashCategory :: Category -> Category
 trashCategory _     = Trash
-trashCategory Trash = UnRead
+-- TODO: ?
+--trashCategory Trash = UnRead
 
 decodeCategory :: Int -> Category
 decodeCategory 0 = Trash
@@ -81,17 +82,17 @@ caroussel session nodeId setLocalCategories r cat = H.div {className:"flex"} div
 
                         else
                           H.div { className : icon c (cat == c)
-                            , on: { click: onClick nodeId setLocalCategories r c}
+                            , on: { click: onClick c}
                              } []
                     ) (caroussel' cat)
 
     caroussel' :: Category -> Array Category
     caroussel' Trash = take 2 categories
-    caroussel' cat   = take 3 $ drop (cat2score cat - 1 ) categories
+    caroussel' c   = take 3 $ drop (cat2score c - 1 ) categories
 
-    onClick nodeId setLocalCategories r cat = \_-> do
-      setLocalCategories $ Map.insert r._id cat
-      void $ launchAff $ putCategories session nodeId $ CategoryQuery {nodeIds: [r._id], category: cat}
+    onClick c = \_-> do
+      setLocalCategories $ Map.insert r._id c
+      void $ launchAff $ putCategories session nodeId $ CategoryQuery {nodeIds: [r._id], category: c}
 
 
 icon :: Category -> Boolean -> String

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

@@ -6,7 +6,6 @@ import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Tuple.Nested ((/\))
 import Effect.Aff (Aff, launchAff)
 import Effect.Uncurried (mkEffectFn1)
-import FFI.Simple ((..))
 import Gargantext.Components.Forest.Tree.Node.Action (Action(..), ID, Name)
 import Gargantext.Components.Forest.Tree.Node (SettingsBox(..), settingsBox)
 import Gargantext.Types (NodeType(..), readNodeType)

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

@@ -8,7 +8,6 @@ import Data.Tuple.Nested ((/\))
 import Effect.Aff (Aff, launchAff)
 import Effect.Class (liftEffect)
 import Effect.Uncurried (mkEffectFn1)
-import FFI.Simple ((..))
 import Partial.Unsafe (unsafePartial)
 import React.SyntheticEvent as E
 import Reactix as R

src/Gargantext/Components/Graph.purs

@@ -41,7 +41,7 @@ graph :: forall s fa2. Record (Props s fa2) -> R.Element
 graph props = R.createElement graphCpt props []
 
 graphCpt :: forall s fa2. R.Component (Props s fa2)
-graphCpt = R.hooksComponent "Graph" cpt
+graphCpt = R.hooksComponent "G.C.Graph" cpt
   where
     cpt props _ = do
       stageHooks props
@@ -83,6 +83,8 @@ graphCpt = R.hooksComponent "Graph" cpt
 
                 Sigmax.setEdges sig false
                 Sigma.startForceAtlas2 sig props.forceAtlas2Settings
+
+                pure unit
           Just sig -> do
             pure unit
 
@@ -99,6 +101,7 @@ graphCpt = R.hooksComponent "Graph" cpt
       -- TODO Probably this can be optimized to re-mark selected nodes only when they changed
       R.useEffect' $ do
         Sigmax.dependOnSigma (R.readRef sigmaRef) "[graphCpt (Ready)] no sigma" $ \sigma -> do
+          Sigmax.performDiff sigma transformedGraph
           Sigmax.updateEdges sigma tEdgesMap
           Sigmax.updateNodes sigma tNodesMap
           Sigmax.setEdges sigma (not $ SigmaxTypes.edgeStateHidden showEdges)

src/Gargantext/Components/GraphExplorer/Controls.purs

@@ -24,7 +24,7 @@ import Gargantext.Components.GraphExplorer.Button (centerButton)
 import Gargantext.Components.GraphExplorer.RangeControl (edgeConfluenceControl, edgeWeightControl, nodeSizeControl)
 import Gargantext.Components.GraphExplorer.Search (nodeSearchControl)
 import Gargantext.Components.GraphExplorer.SlideButton (labelSizeButton, mouseSelectorSizeButton)
-import Gargantext.Components.GraphExplorer.ToggleButton (multiSelectEnabledButton, edgesToggleButton, pauseForceAtlasButton)
+import Gargantext.Components.GraphExplorer.ToggleButton (multiSelectEnabledButton, edgesToggleButton, louvainToggleButton, pauseForceAtlasButton)
 import Gargantext.Components.GraphExplorer.Types as GET
 import Gargantext.Hooks.Sigmax as Sigmax
 import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
@@ -42,6 +42,7 @@ type Controls =
   , selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds
   , showControls    :: R.State Boolean
   , showEdges       :: R.State SigmaxTypes.ShowEdgesState
+  , showLouvain     :: R.State Boolean
   , showSidePanel   :: R.State GET.SidePanelState
   , showTree        :: R.State Boolean
   , sigmaRef        :: R.Ref Sigmax.Sigma
@@ -134,6 +135,7 @@ controlsCpt = R.hooksComponent "GraphControls" cpt
                   RH.li {} [ centerButton props.sigmaRef ]
                 , RH.li {} [ pauseForceAtlasButton {state: props.forceAtlasState} ]
                 , RH.li {} [ edgesToggleButton {state: props.showEdges} ]
+                , RH.li {} [ louvainToggleButton props.showLouvain ]
                 , RH.li {} [ edgeConfluenceControl edgeConfluenceRange props.edgeConfluence ]
                 , RH.li {} [ edgeWeightControl edgeWeightRange props.edgeWeight ]
                   -- change level
@@ -147,6 +149,7 @@ controlsCpt = R.hooksComponent "GraphControls" cpt
                 , RH.li {} [ multiSelectEnabledButton props.multiSelectEnabled ]  -- toggle multi node selection
                   -- save button
                 , RH.li {} [ nodeSearchControl { graph: props.graph
+                                               , multiSelectEnabled: props.multiSelectEnabled
                                                , selectedNodeIds: props.selectedNodeIds } ]
                 , RH.li {} [ mouseSelectorSizeButton props.sigmaRef localControls.mouseSelectorSize ]
                 ]
@@ -161,11 +164,12 @@ useGraphControls graph = do
   graphStage      <- R.useState' Graph.Init
   multiSelectEnabled <- R.useState' false
   nodeSize <- R.useState' $ Range.Closed { min: 0.0, max: 100.0 }
-  showTree <- R.useState' false
   selectedNodeIds <- R.useState' $ Set.empty
   showControls    <- R.useState' false
   showEdges <- R.useState' SigmaxTypes.EShow
+  showLouvain <- R.useState' false
   showSidePanel   <- R.useState' GET.InitialClosed
+  showTree <- R.useState' false
   sigma <- Sigmax.initSigma
   sigmaRef <- R.useRef sigma
 
@@ -179,6 +183,7 @@ useGraphControls graph = do
        , selectedNodeIds
        , showControls
        , showEdges
+       , showLouvain
        , showSidePanel
        , showTree
        , sigmaRef

src/Gargantext/Components/GraphExplorer/Search.purs

@@ -18,6 +18,7 @@ import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
 
 type Props = (
     graph           :: SigmaxTypes.SGraph
+  , multiSelectEnabled :: R.State Boolean
   , selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds
   )
 
@@ -37,36 +38,38 @@ nodeSearchControl props = R.createElement sizeButtonCpt props []
 sizeButtonCpt :: R.Component Props
 sizeButtonCpt = R.hooksComponent "NodeSearchControl" cpt
   where
-    cpt {graph, selectedNodeIds} _ = do
+    cpt {graph, multiSelectEnabled, selectedNodeIds} _ = do
       search@(search' /\ setSearch) <- R.useState' ""
 
       pure $
         H.div { className: "form-group" }
           [ H.div { className: "input-group" }
             [ inputWithAutocomplete { autocompleteSearch: autocompleteSearch graph
-                                    , onAutocompleteClick: \s -> triggerSearch graph s selectedNodeIds
-                                    , onEnterPress: \s -> triggerSearch graph s selectedNodeIds
+                                    , onAutocompleteClick: \s -> triggerSearch graph s multiSelectEnabled selectedNodeIds
+                                    , onEnterPress: \s -> triggerSearch graph s multiSelectEnabled selectedNodeIds
                                     , state: search }
             , H.div { className: "btn input-group-addon"
-                    , on: { click: \_ -> triggerSearch graph search' selectedNodeIds }
+                    , on: { click: \_ -> triggerSearch graph search' multiSelectEnabled selectedNodeIds }
                     }
               [ H.span { className: "fa fa-search" } [] ]
             ]
           ]
 
-    autocompleteSearch :: SigmaxTypes.SGraph -> String -> Array String
-    autocompleteSearch graph s = Seq.toUnfoldable $ (_.label) <$> searchNodes s nodes
-      where
-        nodes = SigmaxTypes.graphNodes graph
+autocompleteSearch :: SigmaxTypes.SGraph -> String -> Array String
+autocompleteSearch graph s = Seq.toUnfoldable $ (_.label) <$> searchNodes s nodes
+  where
+    nodes = SigmaxTypes.graphNodes graph
 
-    triggerSearch :: SigmaxTypes.SGraph
-                  -> String
-                  -> R.State SigmaxTypes.SelectedNodeIds
-                  -> Effect Unit
-    triggerSearch graph search (_ /\ setSelectedNodeIds) = do
-      let nodes = SigmaxTypes.graphNodes graph
-      let matching = (_.id) <$> searchNodes search nodes
+triggerSearch :: SigmaxTypes.SGraph
+              -> String
+              -> R.State Boolean
+              -> R.State SigmaxTypes.SelectedNodeIds
+              -> Effect Unit
+triggerSearch graph search (multiSelectEnabled /\ _) (_ /\ setSelectedNodeIds) = do
+  let graphNodes = SigmaxTypes.graphNodes graph
+  let matching = Set.fromFoldable $ (_.id) <$> searchNodes search graphNodes
 
-      log2 "[triggerSearch] search" search
+  log2 "[triggerSearch] search" search
 
-      setSelectedNodeIds $ const $ Set.fromFoldable matching
+  setSelectedNodeIds $ \nodes ->
+    Set.union matching $ if multiSelectEnabled then nodes else Set.empty

src/Gargantext/Components/GraphExplorer/Sidebar.purs

@@ -3,6 +3,8 @@ module Gargantext.Components.GraphExplorer.Sidebar
   where
 
 import Prelude
+
+import DOM.Simple.Console (log2)
 import Data.Array (head)
 import Data.Int (fromString)
 import Data.Map as Map
@@ -10,23 +12,21 @@ import Data.Maybe (Maybe(..))
 import Data.Sequence as Seq
 import Data.Set as Set
 import Data.Traversable (traverse_)
-import Data.Tuple.Nested((/\))
-import DOM.Simple.Console (log2)
+import Data.Tuple.Nested ((/\))
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff_)
-import Reactix as R
-import Reactix.DOM.HTML as RH
-
-import Gargantext.Components.RandomText (words)
-import Gargantext.Components.Nodes.Corpus.Graph.Tabs as GT
 import Gargantext.Components.GraphExplorer.Types as GET
+import Gargantext.Components.Nodes.Corpus.Graph.Tabs as GT
+import Gargantext.Components.RandomText (words)
 import Gargantext.Data.Array (mapMaybe)
 import Gargantext.Ends (Frontends)
 import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
 import Gargantext.Routes (SessionRoute(NodeAPI))
 import Gargantext.Sessions (Session, delete)
-import Gargantext.Types (NodeType(..))
+import Gargantext.Types (NodeType(..), TermList(..))
 import Gargantext.Utils.Reactix as R2
+import Reactix as R
+import Reactix.DOM.HTML as RH
 
 type Props =
   ( frontends :: Frontends
@@ -51,7 +51,7 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
       let nodesMap = SigmaxTypes.nodesGraphMap props.graph
 
       pure $
-        RH.div { id: "sp-container", className: "col-md-3" }
+        RH.div { id: "sp-container" }
         [ RH.div {}
           [ R2.row
             [ R2.col12
@@ -63,8 +63,11 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
                 , RH.div { className: "tab-content" }
                   [
                     RH.button { className: "btn btn-danger"
-                              , on: { click: onClickRemove props.session props.selectedNodeIds }}
-                    [ RH.text "Remove" ]
+                              , on: { click: onClickRemove CandidateTerm props.session props.selectedNodeIds }}
+                    [ RH.text "Remove candidate" ]
+                  , RH.button { className: "btn btn-danger"
+                              , on: { click: onClickRemove StopTerm props.session props.selectedNodeIds }}
+                    [ RH.text "Remove stop" ]
                   ]
                 , RH.li { className: "nav-item" }
                   [ RH.a { id: "home-tab"
@@ -98,13 +101,6 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
             ]
           ]
         ]
-    badge (_ /\ setSelectedNodeIds) {id, label} =
-      RH.a { className: "badge badge-light"
-           , on: { click: onClick }
-           } [ RH.text label ]
-      where
-        onClick e = do
-          setSelectedNodeIds $ const $ Set.singleton id
     checkbox text =
       RH.li {}
       [ RH.span {} [ RH.text text ]
@@ -112,39 +108,52 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
                  , className: "checkbox"
                  , checked: true
                  , title: "Mark as completed" } ]
-    badges :: SigmaxTypes.SGraph -> R.State SigmaxTypes.SelectedNodeIds -> Seq.Seq (Record SigmaxTypes.Node)
-    badges graph (selectedNodeIds /\ _) = SigmaxTypes.nodesById graph selectedNodeIds
-    neighbourBadges :: SigmaxTypes.SGraph -> R.State SigmaxTypes.SelectedNodeIds -> Seq.Seq (Record SigmaxTypes.Node)
-    neighbourBadges graph (selectedNodeIds /\ _) = SigmaxTypes.neighbours graph selectedNodes
-      where
-        selectedNodes = SigmaxTypes.nodesById graph selectedNodeIds
-
-    onClickRemove session (selectedNodeIds /\ _) e = do
+
+    onClickRemove rType session (selectedNodeIds /\ _) e = do
       log2 "[onClickRemove] selectedNodeIds" selectedNodeIds
       let nodeIds = mapMaybe fromString $ Set.toUnfoldable selectedNodeIds
-      deleteNodes session nodeIds
-
-    deleteNodes :: Session -> Array Int -> Effect Unit
-    deleteNodes session nodeIds = do
-      traverse_ (launchAff_ <<< deleteNode session) nodeIds
-
-    deleteNode :: Session -> Int -> Aff Int
-    deleteNode session nodeId = delete session $ NodeAPI Node (Just nodeId) ""
-
-    query _ _ _ _ (selectedNodeIds /\ _) | Set.isEmpty selectedNodeIds = RH.div {} []
-    query frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _) =
-      query' (head metaData.corpusId)
-      where
-        query' Nothing = RH.div {} []
-        query' (Just corpusId) =
-          GT.tabs {frontends, session, query: q <$> Set.toUnfoldable selectedNodeIds, sides: [side corpusId]}
-        q id = case Map.lookup id nodesMap of
-          Nothing -> []
-          Just n -> words n.label
-        side corpusId = GET.GraphSideCorpus {
-             corpusId
-           , listId: metaData.listId
-           , corpusLabel: metaData.title
-           }
+      deleteNodes rType session nodeIds
+
+
 
+badge :: R.State SigmaxTypes.SelectedNodeIds -> Record SigmaxTypes.Node -> R.Element
+badge (_ /\ setSelectedNodeIds) {id, label} =
+  RH.a { className: "badge badge-light"
+        , on: { click: onClick }
+        } [ RH.text label ]
+  where
+    onClick e = do
+      setSelectedNodeIds $ const $ Set.singleton id
+
+badges :: SigmaxTypes.SGraph -> R.State SigmaxTypes.SelectedNodeIds -> Seq.Seq (Record SigmaxTypes.Node)
+badges graph (selectedNodeIds /\ _) = SigmaxTypes.graphNodes $ SigmaxTypes.nodesById graph selectedNodeIds
 
+neighbourBadges :: SigmaxTypes.SGraph -> R.State SigmaxTypes.SelectedNodeIds -> Seq.Seq (Record SigmaxTypes.Node)
+neighbourBadges graph (selectedNodeIds /\ _) = SigmaxTypes.neighbours graph selectedNodes
+  where
+    selectedNodes = SigmaxTypes.graphNodes $ SigmaxTypes.nodesById graph selectedNodeIds
+
+deleteNodes :: TermList -> Session -> Array Int -> Effect Unit
+deleteNodes termList session nodeIds = do
+  traverse_ (launchAff_ <<< deleteNode termList session) nodeIds
+
+deleteNode :: TermList -> Session -> Int -> Aff Int
+deleteNode termList session nodeId = delete session $ NodeAPI Node (Just nodeId) ""
+
+
+query :: Frontends -> GET.MetaData -> Session -> SigmaxTypes.NodesMap -> R.State SigmaxTypes.SelectedNodeIds -> R.Element
+query _ _ _ _ (selectedNodeIds /\ _) | Set.isEmpty selectedNodeIds = RH.div {} []
+query frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _) =
+  query' (head metaData.corpusId)
+  where
+    query' Nothing = RH.div {} []
+    query' (Just corpusId) =
+      GT.tabs {frontends, session, query: q <$> Set.toUnfoldable selectedNodeIds, sides: [side corpusId]}
+    q id = case Map.lookup id nodesMap of
+      Nothing -> []
+      Just n -> words n.label
+    side corpusId = GET.GraphSideCorpus {
+          corpusId
+        , listId: metaData.listId
+        , corpusLabel: metaData.title
+        }

src/Gargantext/Components/GraphExplorer/ToggleButton.purs

@@ -2,9 +2,10 @@ module Gargantext.Components.GraphExplorer.ToggleButton
   ( Props
   , toggleButton
   , toggleButtonCpt
-  , multiSelectEnabledButton
   , controlsToggleButton
   , edgesToggleButton
+  , louvainToggleButton
+  , multiSelectEnabledButton
   , sidebarToggleButton
   , pauseForceAtlasButton
   , treeToggleButton
@@ -78,6 +79,15 @@ edgesToggleButtonCpt = R.hooksComponent "EdgesToggleButton" cpt
     -- TODO: Move this to Graph.purs to the R.useEffect handler which renders nodes/edges
     onClick setState _ = setState SigmaxTypes.toggleShowEdgesState
 
+louvainToggleButton :: R.State Boolean -> R.Element
+louvainToggleButton state =
+  toggleButton {
+      state: state
+    , onMessage: "Louvain off"
+    , offMessage: "Louvain on"
+    , onClick: \_ -> snd state not
+    }
+
 multiSelectEnabledButton :: R.State Boolean -> R.Element
 multiSelectEnabledButton state =
   toggleButton {

src/Gargantext/Components/NgramsTable.purs

@@ -163,7 +163,7 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
                         , placeholder: "Search"
                         , type: "value"
                         , value: searchQuery
-                        , on: {input: \e -> setSearchQuery (R2.unsafeEventValue e)}}
+                        , on: {input: setSearchQuery <<< R2.unsafeEventValue}}
               , H.div {} (
                    if A.null props.tableBody && searchQuery /= "" then [
                      H.button { className: "btn btn-primary"
@@ -176,14 +176,14 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
                 [ R2.select { id: "picklistmenu"
                             , className: "form-control custom-select"
                             , value: (maybe "" show termListFilter)
-                            , on: {change: (\e -> setTermListFilter $ readTermList $ R2.unsafeEventValue e)}}
+                            , on: {change: setTermListFilter <<< readTermList <<< R2.unsafeEventValue}}
                   (map optps1 termLists)]]
             , H.div {className: "col-md-2", style: {marginTop : "6px"}}
               [ H.li {className: "list-group-item"}
                 [ R2.select {id: "picktermtype"
                             , className: "form-control custom-select"
                             , value: (maybe "" show termSizeFilter)
-                            , on: {change: (\e -> setTermSizeFilter $ readTermSize $ R2.unsafeEventValue e)}}
+                            , on: {change: setTermSizeFilter <<< readTermSize <<< R2.unsafeEventValue}}
                     (map optps1 termSizes)]]
             , H.div {className: "col-md-4", style: {marginTop : "6px", marginBottom : "1px"}}
               [ H.li {className: " list-group-item"}

src/Gargantext/Components/Nodes/Annuaire.purs

 module Gargantext.Components.Nodes.Annuaire where
 
-import Prelude (bind, identity, pure, const, discard, ($), (<$>), (<>))
+import Prelude (bind, const, identity, pure, ($), (<$>), (<>))
 import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
 import Data.Array (head)
 import Data.Maybe (Maybe(..), maybe)

src/Gargantext/Components/Nodes/Lists/Tabs.purs

@@ -13,22 +13,7 @@ import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
 import Gargantext.Components.Nodes.Corpus.Chart.Pie  (pie, bar)
 import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
 import Gargantext.Sessions (Session)
-import Gargantext.Types (CTabNgramType(..), TabType(..), TabSubType(..))
-
-data Mode = Authors | Sources | Institutes | Terms
-
-derive instance genericMode :: Generic Mode _
-
-instance showMode :: Show Mode where
-  show = genericShow
-
-derive instance eqMode :: Eq Mode
-
-modeTabType :: Mode -> CTabNgramType
-modeTabType Authors    = CTabAuthors
-modeTabType Sources    = CTabSources
-modeTabType Institutes = CTabInstitutes
-modeTabType Terms      = CTabTerms
+import Gargantext.Types (Mode(..), modeTabType, CTabNgramType(..), TabType(..), TabSubType(..))
 
 type Props =
   ( session :: Session

src/Gargantext/Components/Search/SearchBar.purs

@@ -2,19 +2,12 @@ module Gargantext.Components.Search.SearchBar
   ( Props, searchBar, searchBarCpt
   ) where
 
-import Prelude (Unit, bind, discard, pure, ($))
-import Data.Maybe (Maybe(..))
-import Data.Newtype (over)
+import Prelude (pure, ($))
 import Data.Tuple.Nested ((/\))
-import Effect.Aff (Aff, launchAff_)
-import Effect (Effect)
-import Effect.Class (liftEffect)
 import Reactix as R
-import DOM.Simple.Console (log2)
 import Reactix.DOM.HTML as H
 
 import Gargantext.Components.Search.Types -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..))
-import Gargantext.Components.Modals.Modal (modalShow)
 import Gargantext.Components.Search.SearchField (Search, searchField)
 import Gargantext.Sessions (Session)
 

src/Gargantext/Data/Louvain.purs

+module Gargantext.Data.Louvain where
+
+import Prelude (Unit, (<$>))
+import Data.Function.Uncurried (Fn1, runFn1, Fn3, runFn3)
+import Data.Map as Map
+import Data.Tuple (Tuple(..))
+import Data.Tuple.Native (T2, prj)
+import Data.Typelevel.Num (d0, d1)
+
+foreign import data Louvain :: Type
+
+type Node = String
+
+type Edge =
+  (
+    source :: Node
+  , target :: Node
+  , weight :: Number
+  )
+
+type Cluster = Int
+type LouvainCluster_ = T2 Node Cluster
+type LouvainCluster = Map.Map Node Cluster
+
+foreign import _jLouvain :: Fn1 Unit Louvain
+
+louvain :: Unit -> Louvain
+louvain unit = runFn1 _jLouvain unit
+
+foreign import _init :: Fn3 Louvain (Array Node) (Array (Record Edge)) (Array LouvainCluster_)
+
+init :: Louvain -> Array Node -> Array (Record Edge) -> LouvainCluster
+init l nds edgs = Map.fromFoldable clusterTuples
+  where
+    clusterArr = runFn3 _init l nds edgs
+    clusterTuples = (\t2 -> Tuple (prj d0 t2) (prj d1 t2)) <$> clusterArr

src/Gargantext/Hooks/Sigmax.purs

 module Gargantext.Hooks.Sigmax
   where
 
-import Prelude (Unit, bind, discard, flip, pure, unit, ($), (*>), (<<<), (<>), (>>=), not, const, map)
+import Prelude (Unit, bind, discard, flip, pure, unit, ($), (*>), (<<<), (<>), (>>=), (&&), not, const, map)
 
 import Data.Array as A
 import Data.Either (either)
@@ -74,11 +74,12 @@ cleanupSigma sigma context = traverse_ kill (readSigma sigma)
 refreshData :: forall n e. Sigma.Sigma -> Sigma.Graph n e -> Effect Unit
 refreshData sigma graph
   =   log clearingMsg
-  *>  Sigma.clear sigma
+  *>  Sigma.clear sigmaGraph
   *>  log readingMsg
-  *>  Sigma.graphRead sigma graph
+  *>  Sigma.graphRead sigmaGraph graph
   >>= either (log2 errorMsg) refresh
   where
+    sigmaGraph = Sigma.graph sigma
     refresh _ = log refreshingMsg *> Sigma.refresh sigma
     clearingMsg = "[refreshData] Clearing existing graph data"
     readingMsg = "[refreshData] Reading graph data"
@@ -116,7 +117,7 @@ handleForceAtlas2Pause sigmaRef (toggled /\ setToggled) mFAPauseRef = do
   dependOnSigma sigma "[handleForceAtlas2Pause] sigma: Nothing" $ \s -> do
     --log2 "[handleForceAtlas2Pause] mSigma: Just " s
     --log2 "[handleForceAtlas2Pause] toggled: " toggled
-    isFARunning <- Sigma.isForceAtlas2Running s
+    let isFARunning = Sigma.isForceAtlas2Running s
     --log2 "[handleForceAtlas2Pause] isFARunning: " isFARunning
     case Tuple toggled isFARunning of
       Tuple ST.InitialRunning false -> do
@@ -145,7 +146,7 @@ setEdges sigma val = do
 
 updateEdges :: Sigma.Sigma -> ST.EdgesMap -> Effect Unit
 updateEdges sigma edgesMap = do
-  Sigma.forEachEdge sigma \e -> do
+  Sigma.forEachEdge (Sigma.graph sigma) \e -> do
     let mTEdge = Map.lookup e.id edgesMap
     case mTEdge of
       Nothing -> error $ "Edge id " <> e.id <> " not found in edgesMap"
@@ -158,16 +159,18 @@ updateEdges sigma edgesMap = do
 
 updateNodes :: Sigma.Sigma -> ST.NodesMap -> Effect Unit
 updateNodes sigma nodesMap = do
-  Sigma.forEachNode sigma \n -> do
+  Sigma.forEachNode (Sigma.graph sigma) \n -> do
     let mTNode = Map.lookup n.id nodesMap
     case mTNode of
       Nothing -> error $ "Node id " <> n.id <> " not found in nodesMap"
       (Just { borderColor: tBorderColor
              , color: tColor
+             , equilateral: tEquilateral
              , hidden: tHidden
-             , type: tType}) -> do
+             , type: tType }) -> do
         _ <- pure $ (n .= "borderColor") tBorderColor
         _ <- pure $ (n .= "color") tColor
+        _ <- pure $ (n .= "equilateral") tEquilateral
         _ <- pure $ (n .= "hidden") tHidden
         _ <- pure $ (n .= "type") tType
         pure unit
@@ -209,11 +212,27 @@ selectorWithSize :: Sigma.Sigma -> Int -> Effect Unit
 selectorWithSize sigma size = do
   pure unit
 
+performDiff :: Sigma.Sigma -> ST.SGraph -> Effect Unit
+performDiff sigma g = do
+  if (Seq.null addEdges) && (Seq.null addNodes) && (Set.isEmpty removeEdges) && (Set.isEmpty removeNodes) then
+    pure unit
+  else do
+    traverse_ (Sigma.addNode sigmaGraph) addNodes
+    traverse_ (Sigma.addEdge sigmaGraph) addEdges
+    traverse_ (Sigma.removeEdge sigmaGraph) removeEdges
+    traverse_ (Sigma.removeNode sigmaGraph) removeNodes
+    Sigma.refresh sigma
+    Sigma.killForceAtlas2 sigma
+  where
+    sigmaGraph = Sigma.graph sigma
+    sigmaEdgeIds = Sigma.sigmaEdgeIds sigmaGraph
+    sigmaNodeIds = Sigma.sigmaNodeIds sigmaGraph
+    {add: Tuple addEdges addNodes, remove: Tuple removeEdges removeNodes} = ST.sigmaDiff sigmaEdgeIds sigmaNodeIds g
 -- DEPRECATED
 
 markSelectedEdges :: Sigma.Sigma -> ST.SelectedEdgeIds -> ST.EdgesMap -> Effect Unit
 markSelectedEdges sigma selectedEdgeIds graphEdges = do
-  Sigma.forEachEdge sigma \e -> do
+  Sigma.forEachEdge (Sigma.graph sigma) \e -> do
     case Map.lookup e.id graphEdges of
       Nothing -> error $ "Edge id " <> e.id <> " not found in graphEdges map"
       Just {color} -> do
@@ -228,7 +247,7 @@ markSelectedEdges sigma selectedEdgeIds graphEdges = do
 
 markSelectedNodes :: Sigma.Sigma -> ST.SelectedNodeIds -> ST.NodesMap -> Effect Unit
 markSelectedNodes sigma selectedNodeIds graphNodes = do
-  Sigma.forEachNode sigma \n -> do
+  Sigma.forEachNode (Sigma.graph sigma) \n -> do
     case Map.lookup n.id graphNodes of
       Nothing -> error $ "Node id " <> n.id <> " not found in graphNodes map"
       Just {color} -> do

src/Gargantext/Hooks/Sigmax/Sigma.js

@@ -9,6 +9,30 @@ if (typeof window !== 'undefined') {
 const CustomShapes = require('sigma/plugins/garg.js').init(sigma, window).customShapes;
 require('sigma/src/utils/sigma.utils.js').init(sigma);
 
+// Black circle around a node
+(function() {
+  var originalDef = sigma.canvas.nodes.def;
+
+  sigma.canvas.nodes.def = (node, context, settings) => {
+    var prefix = settings('prefix') || '';
+
+    originalDef(node, context, settings);
+
+    context.strokeStyle = '#000';
+    context.lineWidth = 1;
+    context.beginPath();
+    context.arc(
+      node[prefix + 'x'],
+      node[prefix + 'y'],
+      node[prefix + 'size'],
+      0,
+      Math.PI * 2,
+      true
+    );
+    context.stroke();
+  }
+})()
+
 sigma.canvas.nodes.selected = (node, context, settings) => {
   // hack
   // We need to temporarily set node.type to 'def'. This is for 2 reasons
@@ -148,14 +172,6 @@ function _sigma(left, right, opts) {
   }
 }
 
-function graphRead(left, right, sigma, data) {
-  try {
-    return right(sigma.graph.read(data));
-  } catch(e) {
-    return left(e);
-  }
-}
-function refresh(sigma) { sigma.refresh(); }
 function addRenderer(left, right, sigma, renderer) {
   try {
     return right(sigma.addRenderer(renderer));
@@ -171,66 +187,9 @@ function bindMouseSelectorPlugin(left, right, sig) {
     return left(e);
   }
 }
-function killRenderer(left, right, sigma, renderer) {
-  try {
-    sigma.killRenderer(renderer);
-    return right(sigma)
-  } catch(e) {
-    return left(e);
-  }
-}
-function getRendererContainer(sigma) {
-  return sigma.renderers[0].container;
-}
-function setRendererContainer(sigma, el) {
-  sigma.renderers[0].container = el;
-}
-function killSigma(left, right, sigma) {
-  try {
-    sigma.kill()
-    return right(null)
-  } catch(e) {
-    return left(e);
-  }
-}
-function clear(sigma) { sigma.graph.clear(); }
 function bind(sigma, event, handler) { sigma.bind(event, handler); }
-function unbind(sigma, event) { sigma.unbind(event); }
-function forEachNode(sigma, handler) { sigma.graph.nodes().forEach(handler); }
-function forEachEdge(sigma, handler) { sigma.graph.edges().forEach(handler); }
-function setSettings(sigma, settings) { sigma.settings(settings); }
-function startForceAtlas2(sigma, settings) { sigma.startForceAtlas2(settings); }
-function stopForceAtlas2(sigma) { sigma.stopForceAtlas2(); }
-function killForceAtlas2(sigma) { sigma.killForceAtlas2(); }
-function isForceAtlas2Running(sigma) { return sigma.isForceAtlas2Running(); }
-
-function getCameras(sigma) {
-  // For some reason, sigma.cameras is an object with integer keys
-  return Object.values(sigma.cameras);
-};
-
-function goTo(cam, props) {
-  return cam.goTo(props);
-};
 
 exports._sigma = _sigma;
-exports._graphRead = graphRead;
-exports._refresh = refresh;
 exports._addRenderer = addRenderer;
 exports._bindMouseSelectorPlugin = bindMouseSelectorPlugin;
-exports._killRenderer = killRenderer;
-exports._getRendererContainer = getRendererContainer;
-exports._setRendererContainer = setRendererContainer;
-exports._killSigma = killSigma
-exports._clear = clear;
 exports._bind = bind;
-exports._unbind = unbind;
-exports._forEachNode = forEachNode;
-exports._forEachEdge = forEachEdge;
-exports._setSettings = setSettings;
-exports._startForceAtlas2 = startForceAtlas2;
-exports._stopForceAtlas2 = stopForceAtlas2;
-exports._killForceAtlas2 = killForceAtlas2;
-exports._isForceAtlas2Running = isForceAtlas2Running;
-exports._getCameras = getCameras;
-exports._goTo = goTo;

src/Gargantext/Hooks/Sigmax/Types.purs

 module Gargantext.Hooks.Sigmax.Types where
 
 import DOM.Simple.Types (Element)
+import Data.Array as A
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Eq (genericEq)
 import Data.Generic.Rep.Show (genericShow)
 import Data.Map as Map
+import Data.Maybe (Maybe(..), fromJust)
 import Data.Sequence as Seq
 import Data.Set as Set
 import Data.Tuple (Tuple(..))
-import Prelude (map, ($), (&&), (||), (==), class Eq, class Ord, class Show, Ordering, compare)
+import Partial.Unsafe (unsafePartial)
+import Prelude (class Eq, class Show, map, ($), (&&), (==), (||), (<$>), mod, not)
 
-newtype Graph n e = Graph { nodes :: Seq.Seq {|n}, edges :: Seq.Seq {|e} }
+import Gargantext.Data.Louvain as Louvain
+import Gargantext.Types as GT
+
+newtype Graph n e = Graph { edges :: Seq.Seq {|e}, nodes :: Seq.Seq {|n} }
 
 --derive instance eqGraph :: Eq Graph
 
@@ -20,12 +26,16 @@ newtype Graph n e = Graph { nodes :: Seq.Seq {|n}, edges :: Seq.Seq {|e} }
 
 type Renderer = { "type" :: String, container :: Element }
 
+type NodeId = String
+type EdgeId = String
 
 type Node =
   ( borderColor :: String
   , color :: String
+  , equilateral :: { numPoints :: Int }
+  , gargType :: GT.Mode
   , hidden :: Boolean
-  , id    :: String
+  , id    :: NodeId
   , label :: String
   , size  :: Number
   , type  :: String  -- available types: circle, cross, def, diamond, equilateral, pacman, square, star
@@ -36,22 +46,31 @@ type Node =
 type Edge =
   ( color :: String
   , confluence :: Number
-  , id :: String
+  , id :: EdgeId
   , hidden :: Boolean
   , size :: Number
-  , source :: String
+  , source :: NodeId
   , sourceNode :: Record Node
-  , target :: String
+  , target :: NodeId
   , targetNode :: Record Node
   , weight :: Number )
 
-type SelectedNodeIds = Set.Set String
-type SelectedEdgeIds = Set.Set String
+type SelectedNodeIds = Set.Set NodeId
+type SelectedEdgeIds = Set.Set EdgeId
 type EdgesMap = Map.Map String (Record Edge)
 type NodesMap = Map.Map String (Record Node)
 
 type SGraph = Graph Node Edge
 
+-- Diff graph structure
+-- NOTE: "add" is NOT a graph. There can be edges which join nodes that are not
+-- in the SigmaDiff nodes array.
+type SigmaDiff =
+  (
+    add :: Tuple (Seq.Seq (Record Edge)) (Seq.Seq (Record Node))
+  , remove :: Tuple SelectedEdgeIds SelectedNodeIds
+  )
+
 graphEdges :: SGraph -> Seq.Seq (Record Edge)
 graphEdges (Graph {edges}) = edges
 
@@ -62,8 +81,8 @@ edgesGraphMap :: SGraph -> EdgesMap
 edgesGraphMap graph =
   Map.fromFoldable $ map (\e -> Tuple e.id e) $ graphEdges graph
 
-edgesById :: SGraph -> SelectedEdgeIds -> Seq.Seq (Record Edge)
-edgesById g edgeIds = Seq.filter (\e -> Set.member e.id edgeIds) $ graphEdges g
+edgesFilter :: (Record Edge -> Boolean) -> SGraph -> SGraph
+edgesFilter f (Graph {edges, nodes}) = Graph { edges: Seq.filter f edges, nodes }
 
 nodesMap :: Seq.Seq (Record Node) -> NodesMap
 nodesMap nodes = Map.fromFoldable $ map (\n -> Tuple n.id n) nodes
@@ -72,16 +91,45 @@ nodesGraphMap :: SGraph -> NodesMap
 nodesGraphMap graph =
   nodesMap $ graphNodes graph
 
-nodesById :: SGraph -> SelectedNodeIds -> Seq.Seq (Record Node)
-nodesById g nodeIds = Seq.filter (\n -> Set.member n.id nodeIds) $ graphNodes g
+nodesFilter :: (Record Node -> Boolean) -> SGraph -> SGraph
+nodesFilter f (Graph {edges, nodes}) = Graph { edges, nodes: Seq.filter f nodes }
+
+nodesById :: SGraph -> SelectedNodeIds -> SGraph
+nodesById g nodeIds = nodesFilter (\n -> Set.member n.id nodeIds) g
+
+-- | "Subtract" second graph from first one (only node/edge id's are compared, not other props)
+sub :: SGraph -> SGraph -> SGraph
+sub graph (Graph {nodes, edges}) = newGraph
+  where
+    edgeIds = Set.fromFoldable $ Seq.map _.id edges
+    nodeIds = Set.fromFoldable $ Seq.map _.id nodes
+    edgeFilterFunc e = (not $ Set.member e.id edgeIds)
+                    && (not $ Set.member e.source nodeIds)
+                    && (not $ Set.member e.target nodeIds)
+    filteredEdges = edgesFilter edgeFilterFunc graph
+    newGraph = nodesFilter (\n -> not (Set.member n.id nodeIds)) filteredEdges
+
+-- | Compute a diff between current sigma graph and whatever is set via customer controls
+sigmaDiff :: SelectedEdgeIds -> SelectedNodeIds -> SGraph -> Record SigmaDiff
+sigmaDiff sigmaEdges sigmaNodes g@(Graph {nodes, edges}) = {add, remove}
+  where
+    add = Tuple addEdges addNodes
+    remove = Tuple removeEdges removeNodes
+
+    addG = edgesFilter (\e -> not (Set.member e.id sigmaEdges)) $ nodesFilter (\n -> not (Set.member n.id sigmaNodes)) g
+    addEdges = graphEdges addG
+    addNodes = graphNodes addG
+
+    removeEdges = Set.difference sigmaEdges (Set.fromFoldable $ Seq.map _.id edges)
+    removeNodes = Set.difference sigmaNodes (Set.fromFoldable $ Seq.map _.id nodes)
 
 neighbours :: SGraph -> Seq.Seq (Record Node) -> Seq.Seq (Record Node)
 neighbours g nodes = Seq.fromFoldable $ Set.unions [Set.fromFoldable nodes, sources, targets]
   where
     nodeIds = Set.fromFoldable $ Seq.map _.id nodes
     selectedEdges = neighbouringEdges g nodeIds
-    sources = Set.fromFoldable $ nodesById g $ Set.fromFoldable $ Seq.map _.source selectedEdges
-    targets = Set.fromFoldable $ nodesById g $ Set.fromFoldable $ Seq.map _.target selectedEdges
+    sources = Set.fromFoldable $ graphNodes $ nodesById g $ Set.fromFoldable $ Seq.map _.source selectedEdges
+    targets = Set.fromFoldable $ graphNodes $ nodesById g $ Set.fromFoldable $ Seq.map _.target selectedEdges
 
 neighbouringEdges :: SGraph -> SelectedNodeIds -> Seq.Seq (Record Edge)
 neighbouringEdges g nodeIds = Seq.filter condition $ graphEdges g
@@ -155,3 +203,45 @@ forceAtlasEdgeState Running EShow = ETempHiddenThenShow
 forceAtlasEdgeState Running es = es
 forceAtlasEdgeState Paused ETempHiddenThenShow = EShow
 forceAtlasEdgeState Paused es = es
+
+
+louvainEdges :: SGraph -> Array (Record Louvain.Edge)
+louvainEdges g = Seq.toUnfoldable $ Seq.map (\{source, target, weight} -> {source, target, weight}) (graphEdges g)
+louvainNodes :: SGraph -> Array Louvain.Node
+louvainNodes g = Seq.toUnfoldable $ Seq.map _.id (graphNodes g)
+
+louvainGraph :: SGraph -> Louvain.LouvainCluster -> SGraph
+louvainGraph g cluster = Graph {nodes: newNodes, edges: newEdges}
+  where
+    nodes = graphNodes g
+    edges = graphEdges g
+
+    newNodes = (nodeClusterColor cluster) <$> nodes
+    nm = nodesMap newNodes
+    newEdges = (edgeClusterColor cluster nm) <$> edges
+
+edgeClusterColor cluster nm e = e { color = sourceNode.color, sourceNode = sourceNode, targetNode = targetNode }
+  where
+    sourceNode = case Map.lookup e.source nm of
+      Just sn -> sn
+      Nothing -> e.sourceNode
+    targetNode = case Map.lookup e.target nm of
+      Just tn -> tn
+      Nothing -> e.targetNode
+
+nodeClusterColor cluster n = n { color = newColor }
+  where
+    newColor = case Map.lookup n.id cluster of
+      Nothing -> n.color
+      Just c  -> do
+        let idx = c `mod` (A.length defaultPalette)
+        unsafePartial $ fromJust $ defaultPalette A.!! idx
+
+defaultPalette :: Array String
+defaultPalette = ["#5fa571","#ab9ba2","#da876d","#bdd3ff"
+                 ,"#b399df","#ffdfed","#33c8f3","#739e9a"
+                 ,"#caeca3","#f6f7e5","#f9bcca","#ccb069"
+                 ,"#c9ffde","#c58683","#6c9eb0","#ffd3cf"
+                 ,"#ccffc7","#52a1b0","#d2ecff","#99fffe"
+                 ,"#9295ae","#5ea38b","#fff0b3","#d99e68"
+                 ]

src/Gargantext/Types.purs

@@ -9,6 +9,7 @@ import Prim.Row (class Union)
 import URI.Query (Query)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Eq (genericEq)
+import Data.Generic.Rep.Ord (genericCompare)
 import Data.Generic.Rep.Show (genericShow)
 
 newtype SessionId = SessionId String
@@ -409,3 +410,27 @@ instance showTabType :: Show TabType where
 
 type TableResult a = {count :: Int, docs :: Array a}
 type AffTableResult a = Aff (TableResult a)
+
+data Mode = Authors | Sources | Institutes | Terms
+
+derive instance genericMode :: Generic Mode _
+
+instance showMode :: Show Mode where
+  show = genericShow
+
+derive instance eqMode :: Eq Mode
+instance ordMode :: Ord Mode where
+  compare = genericCompare
+
+modeTabType :: Mode -> CTabNgramType
+modeTabType Authors    = CTabAuthors
+modeTabType Sources    = CTabSources
+modeTabType Institutes = CTabInstitutes
+modeTabType Terms      = CTabTerms
+
+modeFromString :: String -> Maybe Mode
+modeFromString "Authors" = Just Authors
+modeFromString "Sources" = Just Sources
+modeFromString "Institutes" = Just Institutes
+modeFromString "Terms" = Just Terms
+modeFromString _ = Nothing