[DocAnnot] fix the addNewNgrams feature

src/Gargantext/Components/Annotation/AnnotatedField.purs

@@ -58,7 +58,7 @@ annotatedFieldComponent = R.hooksComponent "AnnotatedField" cpt
             let x = E.clientX event
                 y = E.clientY event
                 setList t = do
-                  setTermList (S.toLower text') (Just list) t
+                  setTermList text' (Just list) t
                   setMenu (const Nothing)
             setMenu (const $ Just {x, y, list: Just list, menuType: SetTermListItem, setList} )
 

src/Gargantext/Components/NgramsTable.purs

@@ -213,9 +213,8 @@ ngramsTableSpec = simpleSpec performAction render
     performAction (SetTermListItem n pl) {path: {nodeId, listIds, tabType}} {ngramsVersion} =
         commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
       where
-        listId = Just 10 -- List.head listIds
         pe = NgramsPatch { patch_list: pl, patch_children: mempty }
-        pt = PatchMap $ Map.singleton n pe
+        pt = singletonNgramsTablePatch n pe
     performAction AddTermChildren _ {ngramsParent: Nothing} =
         -- impossible but harmless
         pure unit
@@ -227,14 +226,13 @@ ngramsTableSpec = simpleSpec performAction render
         modifyState_ $ setParentResetChildren Nothing
         commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
       where
-        listId = Just 10 -- List.head listIds
         pc = patchSetFromMap ngramsChildren
         pe = NgramsPatch { patch_list: mempty, patch_children: pc }
-        pt = PatchMap $ Map.fromFoldable [Tuple parent pe]
-        -- TODO ROOT-UPDATE
-        -- patch the root of the child to be equal to the root of the parent.
-    performAction (AddNewNgram ngram) {path: params} _ =
-      lift $ addNewNgram ngram Nothing params
+        pt = singletonNgramsTablePatch parent pe
+    performAction (AddNewNgram ngram) {path: {listIds, nodeId, tabType}} {ngramsVersion} =
+        commitPatch {listIds, nodeId, tabType} (Versioned {version: ngramsVersion, data: pt})
+      where
+        pt = addNewNgram ngram CandidateTerm
 
     render :: Render State LoadedNgramsTableProps Action
     render dispatch { path: pageParams

src/Gargantext/Components/NgramsTable/Core.purs

@@ -7,6 +7,8 @@ module Gargantext.Components.NgramsTable.Core
   , NgramsPatch(..)
   , NgramsTable(..)
   , NgramsTablePatch
+  , NewElems
+  , NgramsPatches
   , _NgramsTable
   , NgramsTerm
   , Version
@@ -27,6 +29,9 @@ module Gargantext.Components.NgramsTable.Core
   , patchSetFromMap
   , applyPatchSet
   , applyNgramsTablePatch
+  , singletonPatchMap
+  , fromNgramsPatches
+  , singletonNgramsTablePatch
   , _list
   , _occurrences
   , _children
@@ -450,6 +455,9 @@ instance decodeJsonPatchMap :: DecodeJson p => DecodeJson (PatchMap String p) wh
     obj <- decodeJson json
     pure $ PatchMap $ Map.fromFoldableWithIndex (obj :: FO.Object p)
 
+singletonPatchMap :: forall k p. k -> p -> PatchMap k p
+singletonPatchMap k p = PatchMap (Map.singleton k p)
+
 isEmptyPatchMap :: forall k p. PatchMap k p -> Boolean
 isEmptyPatchMap (PatchMap p) = Map.isEmpty p
 
@@ -461,7 +469,20 @@ applyPatchMap applyPatchValue (PatchMap p) = mapWithIndex f
         Nothing -> v
         Just pv -> applyPatchValue pv v
 
-type NgramsTablePatch = PatchMap NgramsTerm NgramsPatch
+type NgramsPatches = PatchMap NgramsTerm NgramsPatch
+
+type NewElems = Map NgramsTerm TermList
+
+type NgramsTablePatch =
+  { ngramsNewElems :: NewElems
+  , ngramsPatches  :: NgramsPatches
+  }
+
+fromNgramsPatches :: NgramsPatches -> NgramsTablePatch
+fromNgramsPatches ngramsPatches = {ngramsNewElems: mempty, ngramsPatches}
+
+singletonNgramsTablePatch :: NgramsTerm -> NgramsPatch -> NgramsTablePatch
+singletonNgramsTablePatch n p = fromNgramsPatches $ singletonPatchMap (S.toLower n) p
 
 type RootParent = { root :: NgramsTerm, parent :: NgramsTerm }
 
@@ -494,13 +515,26 @@ reParentNgramsPatch parent (NgramsPatch {patch_children: PatchSet {rem, add}}) =
   traverse_ (reParent Nothing) rem
   traverse_ (reParent $ Just rp) add
 
-reParentNgramsTablePatch :: ReParent NgramsTablePatch
+reParentNgramsTablePatch :: ReParent NgramsPatches
 reParentNgramsTablePatch = void <<< traverseWithIndex reParentNgramsPatch
 
+newElemsTable :: NewElems -> Map NgramsTerm NgramsElement
+newElemsTable = mapWithIndex newElem
+  where
+    newElem ngrams list =
+      NgramsElement
+        { ngrams
+        , list
+        , occurrences: 1
+        , parent:      Nothing
+        , root:        Nothing
+        , children:    mempty
+        }
+
 applyNgramsTablePatch :: NgramsTablePatch -> NgramsTable -> NgramsTable
-applyNgramsTablePatch p (NgramsTable m) =
-  execState (reParentNgramsTablePatch p) $
-  NgramsTable $ applyPatchMap applyNgramsPatch p m
+applyNgramsTablePatch { ngramsPatches, ngramsNewElems: n } (NgramsTable m) =
+  execState (reParentNgramsTablePatch ngramsPatches) $
+  NgramsTable $ applyPatchMap applyNgramsPatch ngramsPatches (newElemsTable n <> m)
 
 -----------------------------------------------------------------------------------
 
@@ -510,17 +544,34 @@ type CoreState s =
   | s
   }
 
-putTable :: {nodeId :: Int, listIds :: Array Int, tabType :: TabType} -> Versioned NgramsTablePatch -> Aff (Versioned NgramsTablePatch)
-putTable {nodeId, listIds, tabType} =
+postNewNgrams :: forall s. Array NgramsTerm -> Maybe TermList -> CoreParams s -> Aff Unit
+postNewNgrams newNgrams mayList {nodeId, listIds, tabType} =
+  when (not (A.null newNgrams)) $ do
+    (_ :: Array Unit) <- post (toUrl Back (PutNgrams tabType (head listIds) mayList) $ Just nodeId) newNgrams
+    pure unit
+
+postNewElems :: forall s. NewElems -> CoreParams s -> Aff Unit
+postNewElems newElems params = void $ traverseWithIndex postNewElem newElems
+  where
+    postNewElem ngrams list = postNewNgrams [ngrams] (Just list) params
+
+addNewNgram :: NgramsTerm -> TermList -> NgramsTablePatch
+addNewNgram ngrams list = { ngramsPatches: mempty
+                          , ngramsNewElems: Map.singleton (S.toLower ngrams) list }
+
+putNgramsPatches :: {nodeId :: Int, listIds :: Array Int, tabType :: TabType} -> Versioned NgramsPatches -> Aff (Versioned NgramsPatches)
+putNgramsPatches {nodeId, listIds, tabType} =
   put (toUrl Back (PutNgrams tabType (head listIds) Nothing) $ Just nodeId)
 
 commitPatch :: forall s. {nodeId :: Int, listIds :: Array Int, tabType :: TabType}
             -> Versioned NgramsTablePatch -> StateCoTransformer (CoreState s) Unit
-commitPatch props pt@(Versioned {data: tablePatch}) = do
-  Versioned {version: newVersion, data: newPatch} <- lift $ putTable props pt
+commitPatch props (Versioned {version, data: tablePatch@{ngramsPatches, ngramsNewElems}}) = do
+  let pt = Versioned { version, data: ngramsPatches }
+  lift $ postNewElems ngramsNewElems props
+  Versioned {version: newVersion, data: newPatch} <- lift $ putNgramsPatches props pt
   modifyState_ $ \s ->
     s { ngramsVersion    = newVersion
-      , ngramsTablePatch = newPatch <> tablePatch <> s.ngramsTablePatch
+      , ngramsTablePatch = fromNgramsPatches newPatch <> tablePatch <> s.ngramsTablePatch
       }
     -- TODO: check that pt.version == s.ngramsTablePatch.version
 
@@ -540,11 +591,6 @@ convOrderBy (T.DESC (T.ColumnName "Score (Occurrences)")) = ScoreDesc
 convOrderBy (T.ASC  _) = TermAsc
 convOrderBy (T.DESC _) = TermDesc
 
-addNewNgram :: forall s. NgramsTerm -> Maybe TermList -> CoreParams s -> Aff Unit
-addNewNgram ngram mayList {nodeId, listIds, tabType} = do
-  (_ :: Array Unit) <- post (toUrl Back (PutNgrams tabType (head listIds) mayList) $ Just nodeId) [ngram]
-  pure unit
-
 ngramsLoaderClass :: Loader.LoaderClass PageParams VersionedNgramsTable
 ngramsLoaderClass = Loader.createLoaderClass "NgramsTableLoader" loadNgramsTable
 

src/Gargantext/Pages/Annuaire/User/Contacts.purs

@@ -4,4 +4,4 @@ module Gargantext.Pages.Annuaire.User.Contacts
        where
 
 import Gargantext.Pages.Annuaire.User.Contacts.Types
-import Gargantext.Pages.Annuaire.User.Contacts.Specs
+import Gargantext.Pages.Annuaire.User.Contacts.Specs (layoutUser)

src/Gargantext/Pages/Corpus/Document.purs

@@ -3,7 +3,6 @@ module Gargantext.Pages.Corpus.Document where
 import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
-import Data.Map as Map
 import Data.Maybe (Maybe(..), maybe)
 import Effect.Aff (Aff)
 import React (ReactClass, Children)
@@ -11,7 +10,6 @@ import React.DOM (div, h4, li, p, span, text, ul)
 import React.DOM.Props (className)
 import Reactix as R
 import Thermite (PerformAction, Render, Spec, simpleSpec, cmapProps, createClass)
-import Control.Monad.Trans.Class (lift)
 
 import Gargantext.Prelude
 import Gargantext.Config          (toUrl, NodeType(..), End(..), TabSubType(..), TabType(..), CTabNgramType(..))
@@ -286,9 +284,11 @@ docViewSpec = simpleSpec performAction render
         commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
       where
         pe = NgramsPatch { patch_list: pl, patch_children: mempty }
-        pt = PatchMap $ Map.singleton n pe
-    performAction (AddNewNgram ngram termList) {path: params} _ =
-      lift $ addNewNgram ngram (Just termList) params
+        pt = singletonNgramsTablePatch n pe
+    performAction (AddNewNgram ngram termList) {path: {nodeId, listIds, tabType}} {ngramsVersion} =
+        commitPatch {nodeId, listIds, tabType} (Versioned {version: ngramsVersion, data: pt})
+      where
+        pt = addNewNgram ngram termList
 
     render :: Render State Props Action
     render dispatch { loaded: { ngramsTable: Versioned { data: initTable }, document } }