[Graph] node removal works now

However, graph still needs to be refreshed after this is done.

src/Gargantext/Components/GraphExplorer/Sidebar.purs

@@ -8,14 +8,19 @@ import DOM.Simple.Console (log2)
 import Data.Array (head)
 import Data.Int (fromString)
 import Data.Map as Map
-import Data.Maybe (Maybe(..))
+import Data.Maybe (Maybe(..), fromJust)
 import Data.Sequence as Seq
 import Data.Set as Set
 import Data.Traversable (traverse_)
 import Data.Tuple.Nested ((/\))
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff_)
+import Partial.Unsafe (unsafePartial)
+import Reactix as R
+import Reactix.DOM.HTML as RH
+
 import Gargantext.Components.GraphExplorer.Types as GET
+import Gargantext.Components.NgramsTable.Core as NTC
 import Gargantext.Components.Nodes.Corpus.Graph.Tabs as GT
 import Gargantext.Components.RandomText (words)
 import Gargantext.Data.Array (mapMaybe)
@@ -23,10 +28,8 @@ 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(..), TermList(..))
+import Gargantext.Types (CTabNgramType(..), NodeType(..), TabSubType(..), TabType(..), TermList(..), modeTabType)
 import Gargantext.Utils.Reactix as R2
-import Reactix as R
-import Reactix.DOM.HTML as RH
 
 type Props =
   ( frontends :: Frontends
@@ -63,10 +66,10 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
                 , RH.div { className: "tab-content" }
                   [
                     RH.button { className: "btn btn-danger"
-                              , on: { click: onClickRemove CandidateTerm props.session props.selectedNodeIds }}
+                              , on: { click: onClickRemove CandidateTerm props.session props.metaData nodesMap props.selectedNodeIds }}
                     [ RH.text "Remove candidate" ]
                   , RH.button { className: "btn btn-danger"
-                              , on: { click: onClickRemove StopTerm props.session props.selectedNodeIds }}
+                              , on: { click: onClickRemove StopTerm props.session props.metaData nodesMap props.selectedNodeIds }}
                     [ RH.text "Remove stop" ]
                   ]
                 , RH.li { className: "nav-item" }
@@ -109,10 +112,10 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
                  , checked: true
                  , title: "Mark as completed" } ]
 
-    onClickRemove rType session (selectedNodeIds /\ _) e = do
+    onClickRemove rType session metaData nodesMap (selectedNodeIds /\ _) e = do
       log2 "[onClickRemove] selectedNodeIds" selectedNodeIds
-      let nodeIds = mapMaybe fromString $ Set.toUnfoldable selectedNodeIds
-      deleteNodes rType session nodeIds
+      let nodes = mapMaybe (\id -> Map.lookup id nodesMap) $ Set.toUnfoldable selectedNodeIds
+      deleteNodes rType session metaData nodes
 
 
 
@@ -133,12 +136,31 @@ neighbourBadges graph (selectedNodeIds /\ _) = SigmaxTypes.neighbours graph sele
   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
+deleteNodes :: TermList -> Session -> GET.MetaData -> Array (Record SigmaxTypes.Node) -> Effect Unit
+deleteNodes termList session metaData nodes = do
+  traverse_ (launchAff_ <<< deleteNode termList session metaData) nodes
 
-deleteNode :: TermList -> Session -> Int -> Aff Int
-deleteNode termList session nodeId = delete session $ NodeAPI Node (Just nodeId) ""
+deleteNode :: TermList -> Session -> GET.MetaData -> Record SigmaxTypes.Node -> Aff NTC.VersionedNgramsPatches
+deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches coreParams versioned
+  where
+    nodeId :: Int
+    nodeId = unsafePartial $ fromJust $ fromString node.id
+    versioned :: NTC.VersionedNgramsPatches
+    versioned = NTC.Versioned {version: metaData.list.version, data: np}
+    coreParams :: NTC.CoreParams ()
+    coreParams = {session, nodeId: nodeId, listIds: [metaData.list.listId], tabType}
+    tabNgramType :: CTabNgramType
+    tabNgramType = modeTabType node.gargType
+    tabType :: TabType
+    tabType = TabCorpus (TabNgramType tabNgramType)
+    term :: NTC.NgramsTerm
+    term = NTC.normNgram tabNgramType node.label
+    pt :: NTC.NgramsTablePatch
+    pt = NTC.fromNgramsPatches np
+    np :: NTC.NgramsPatches
+    np = NTC.singletonPatchMap term $ NTC.NgramsPatch { patch_children: mempty, patch_list }
+    patch_list :: NTC.Replace TermList
+    patch_list = NTC.Replace { new: termList, old: GraphTerm }
 
 
 query :: Frontends -> GET.MetaData -> Session -> SigmaxTypes.NodesMap -> R.State SigmaxTypes.SelectedNodeIds -> R.Element
@@ -154,6 +176,6 @@ query frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _)
       Just n -> words n.label
     side corpusId = GET.GraphSideCorpus {
           corpusId
-        , listId: metaData.listId
+        , listId: metaData.list.listId
         , corpusLabel: metaData.title
         }

src/Gargantext/Components/GraphExplorer/Types.purs

@@ -37,6 +37,7 @@ derive instance newtypeEdge :: Newtype Edge _
 type InclusiveRange t = { min :: t, max :: t }
 
 type ListId      = Int
+type Version     = Int
 type CorpusId    = Int
 type CorpusLabel = String
 
@@ -61,8 +62,10 @@ newtype MetaData = MetaData
     title :: String
   , legend :: Array Legend
   , corpusId :: Array Int
-  , listId   :: ListId
-  , version  :: Int
+  , list :: {
+      listId   :: ListId
+    , version  :: Version
+    }
   }
 
 getLegend :: GraphData -> Maybe (Array Legend)
@@ -97,7 +100,7 @@ initialGraphData = GraphData {
     nodes: []
   , edges: []
   , sides: []
-  , metaData : Just $ MetaData {title : "", legend : [], corpusId : [], listId : 0, version : 0}
+  , metaData : Just $ MetaData {title : "", legend : [], corpusId : [], list: {listId : 0, version : 0}}
   }
 
 instance decodeJsonGraphData :: DecodeJson GraphData where
@@ -108,7 +111,8 @@ instance decodeJsonGraphData :: DecodeJson GraphData where
     -- TODO: sides
     metadata <- obj .: "metadata"
     corpusIds <- metadata .: "corpusId"
-    listId'   <- metadata .: "listId"
+    list      <- metadata .: "list"
+    listId'   <- list .: "listId"
     metaData <- obj .: "metadata"
     let side x = GraphSideCorpus { corpusId: x, corpusLabel: "Publications", listId : listId'}
     let sides = side <$> corpusIds
@@ -133,9 +137,10 @@ instance decodeJsonMetaData :: DecodeJson MetaData where
     title <- obj .: "title"
     legend <- obj .: "legend"
     corpusId <- obj .: "corpusId"
-    listId <- obj .: "listId"
-    version <- obj .: "version"
-    pure $ MetaData { title, legend, corpusId, listId, version}
+    list <- obj .: "list"
+    listId <- list .: "listId"
+    version <- list .: "version"
+    pure $ MetaData { title, legend, corpusId, list: {listId, version}}
 
 
 instance decodeJsonLegend :: DecodeJson Legend where

src/Gargantext/Components/NgramsTable/Core.purs

@@ -15,6 +15,7 @@ module Gargantext.Components.NgramsTable.Core
   , findNgramTermList
   , Version
   , Versioned(..)
+  , VersionedNgramsPatches
   , VersionedNgramsTable
   , CoreState
   , highlightNgrams
@@ -42,6 +43,7 @@ module Gargantext.Components.NgramsTable.Core
   , _parent
   , _root
   , commitPatch
+  , putNgramsPatches
   , syncPatches
   , addNewNgram
   )
@@ -507,6 +509,7 @@ applyPatchMap applyPatchValue (PatchMap p) = mapWithIndex f
         Just pv -> applyPatchValue pv v
 
 type NgramsPatches = PatchMap NgramsTerm NgramsPatch
+type VersionedNgramsPatches = Versioned NgramsPatches
 
 type NewElems = Map NgramsTerm TermList
 
@@ -618,7 +621,7 @@ addNewNgram ngrams list =
   { ngramsPatches: mempty
   , ngramsNewElems: Map.singleton ngrams list }
 
-putNgramsPatches :: forall s. CoreParams s -> Versioned NgramsPatches -> Aff (Versioned NgramsPatches)
+putNgramsPatches :: forall s. CoreParams s -> VersionedNgramsPatches -> Aff VersionedNgramsPatches
 putNgramsPatches {session, nodeId, listIds, tabType} = put session putNgrams
   where putNgrams = PutNgrams tabType (head listIds) Nothing (Just nodeId)